Alexer.x

{
module Alexer (scan, test, Token(..), AlexPosn(..), PosToken(..)) where

import Syntax
}

%wrapper "posn"

$digit = 0-9			-- digits
$alpha = [a-zA-Z]		-- alphabetic characters

tokens :-

  $white+				;
  "--".*				;
  "."                                   { tok (\s -> Dot) }
  "lambda"                              { tok (\s -> Lambda) }
  $digit+				{ tok (\s -> Int (read s)) }
  [\=\+\-\*\/\(\)]			{ tok (\s -> Sym (head s)) }
  [a-z]+		                { tok (\s -> Id s) }
{

-- Each right-hand side has type :: AlexPosn -> String -> Token
-- Some action helpers:

tok :: (String -> Token) -> AlexPosn -> String -> PosToken
tok f (AlexPn abs line col) s =
  PosToken (f s) (Position line col)

scan s = alexScanTokens s


-- return tokens without their positions. Good for testing
test s = fmap pickToken (alexScanTokens s)
  where pickToken (PosToken token position) = token

}
 

MainSpec.hs

module MainSpec (spec) where

import Test.Hspec
import Test.QuickCheck
import Alexer
import HParser
import Syntax

spec :: Spec
spec = do
  describe "Lexer" $ do
    it "lexes single lambda" $ do
      test "lambda x. x" `shouldBe`
        [Lambda,Id "x",Dot,Id "x"]
    it "lexes two lambdas" $ do
      test "lambda y. lambda x. x y" `shouldBe`
        [Lambda,Id "y",Dot,Lambda,Id "x",Dot,Id "x",Id "y"]
    it "lexes lambdas in parens" $ do
      test "(lambda x. x) (lambda x. x x)" `shouldBe`
        [Sym '(',Lambda,Id "x",Dot,Id "x",Sym ')',Sym '(',Lambda,Id "x",Dot,Id "x",Id "x",Sym ')']

  describe "Parser" $ do
    it "parses a variable eval" $ do
      parse (scan "x") `shouldBe` [Eval (Info (Position 1 1)) (Var (Info (Position 1 1)) "x")]
    it "parses a lambda" $ do
      parse (scan "lambda x.x") `shouldBe` [Eval (Info (Position 1 1)) (Abs (Info (Position 1 1)) "x" (Var (Info (Position 1 10)) "x"))] 
    it "deals with parens and application" $ do
      parse (scan "(lambda x. x) (lambda y. y)") `shouldBe` [Eval (Info (Position 1 2)) (App (Info (Position 1 2)) (Abs (Info (Position 1 2)) "x" (Var (Info (Position 1 12)) "x")) (Abs (Info (Position 1 16)) "y" (Var (Info (Position 1 26)) "y")))]
    it "deals with empty input" $ do
      parse (scan "") `shouldBe` []
        

Parser.y

{
module HParser (parse) where

import Syntax
import Alexer


}

%name toplevel
%tokentype { Context -> PosToken }

%token
    LAMBDA { PosToken (Lambda) _ }
    '.' { PosToken Dot _ }
    '(' { PosToken (Sym '(') _ }
    ')' { PosToken (Sym ')') _ }
    ';' { PosToken (Sym ';') _ }
    IDENTIFIER { PosToken _ _}

%%

TopLevel :
    Command { \ctx -> [$1] } |
    TopLevel ';' Command { \ctx -> $3:$1 } |
    {- empty -} { [] }

Command : Term { \ctx -> Eval (termInfo $1) $1 }

Term :
    AppTerm { \ctx -> $1 } |
    LAMBDA IDENTIFIER '.' Term { \ctx -> Abs (info $1) (getId $2) $4 }

AppTerm :
    ATerm {\ctx ->  $1 } |
    AppTerm ATerm {\ctx ->  App (termInfo $1) $1 $2 }

ATerm :
    '(' Term ')' { \ctx -> $2 } |
    IDENTIFIER {\ctx ->  Var (info $1) (getId $1) }
{
info (PosToken _ pos) = Info pos
token (PosToken tok _) = tok
  
getId (PosToken (Id s) _) = s

happyError x = error ("Parse Error at line " ++ show x)

parse = toplevel
}

Syntax.hs

module Syntax where

data Command =
  Eval Info Term |
  Bind Info String String deriving (Eq, Show)

data Term =
  Var Info String     |
  Abs Info String Term |
  App Info Term Term deriving (Eq, Show)

data Info = Info Position deriving (Eq, Show)

termInfo :: Term -> Info
termInfo (Var info _) = info
termInfo (Abs info _ _) = info
termInfo (App info _ _) = info

-- The token type:
data Token =
    Sym Char        	|
    Id String	        |
    Int Int             |
    Lambda              |
    Dot 
    deriving (Eq, Show)


data Position = Position Int Int deriving (Eq, Show)

data PosToken = PosToken Token Position deriving (Eq, Show)