A small parser for a simple exercise functional language. Example: `(fix fact . \x . ifzero x 1 (mul x (fact (minus x 1)))) 10`.

Parser.y

{
module Parser where

import Data.Char


-- | Built-in functions in our language:
data BuiltFn
    = Nat Integer   -- ^ Natural number
  deriving (Eq, Ord, Read, Show)

-- | Data type for expressions (terms) of our language. Type parametr `v` is the type
-- of variable names, it will be usually `String`.
data LTerm v
    = Abstract v (LTerm v)      -- ^ Lambda abstraction
    | LTerm v :$ LTerm v        -- ^ Function application.
    | LVar v                    -- ^ Variable.
    | Let v (LTerm v) (LTerm v) -- ^ let ... in ...
    | Fix v (LTerm v)           -- ^ fix x.M
    | BuiltIn BuiltFn           -- ^ A built-in function.
  deriving (Eq, Show)

infixl 4 :$

}

%name lambda
%tokentype { Token }
%error { parseError }

%token 
      let             { TokenLet }
      in              { TokenIn }
      var             { TokenVar $$ }
      fix             { TokenFix }
      '='             { TokenEq }
      '\\'            { TokenLambda }
      '.'             { TokenDot }
      '('             { TokenOB }
      ')'             { TokenCB }
      int             { TokenInt $$ }

%%

Exp : NoAppExp              { $1 }
    | Exp NoAppExp          { $1 :$ $2 }

NoAppExp   : let var '=' Exp in Exp     { Let $2 $4 $6 }
      | '(' Exp ')'                     { $2 }
      | int                             { BuiltIn (Nat $1) }
      | var                             { LVar $1 }
      | '\\' var '.' Exp                { Abstract $2 $4 }
      | fix var '.' Exp                 { Fix $2 $4 }

{
parseError :: [Token] -> a
parseError _ = error "Parse error"

type Var = String

type Exp = LTerm Var
{-
data Exp
    = Let Var Exp Exp
    | App Exp Exp
    | Abs Var Exp
    | Fix Var Exp
    | Var Var
    | NumLit Integer
  deriving (Show, Eq, Ord)
-}

data Token
    = TokenLet
    | TokenIn
    | TokenFix
    | TokenEq
    | TokenLambda
    | TokenDot
    | TokenOB
    | TokenCB
    | TokenInt Integer
    | TokenVar String
  deriving (Show, Eq, Ord)

lexer :: String -> [Token]
lexer [] = []
lexer (c:cs) 
      | isSpace c = lexer cs
      | isAlpha c = lexVar (c:cs)
      | isDigit c = lexNum (c:cs)
lexer ('=':cs) = TokenEq : lexer cs
lexer ('\\':cs) = TokenLambda : lexer cs
lexer ('.':cs) = TokenDot : lexer cs
lexer ('(':cs) = TokenOB : lexer cs
lexer (')':cs) = TokenCB : lexer cs
lexer (c:_)    = error $ "Unexpected character: " ++ [c]


lexNum cs = TokenInt (read num) : lexer rest
      where (num,rest) = span isDigit cs

lexVar cs =
   case span isAlpha cs of
      ("let",rest) -> TokenLet : lexer rest
      ("in",rest)  -> TokenIn : lexer rest
      ("fix",rest) -> TokenFix : lexer rest
      (var,rest)   -> TokenVar var : lexer rest


main = getContents >>= print . lambda . lexer
}