Skip to content

Instantly share code, notes, and snippets.

@ppetr ppetr/Parser.y forked from anonymous/Parser.y
Last active Dec 10, 2015

Embed
What would you like to do?
A small parser for a simple exercise functional language. Example: `(fix fact . \x . ifzero x 1 (mul x (fact (minus x 1)))) 10`.
{
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
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.