ParseError

Show

Data Aquisition

data Expr = CInt Integer | CBool Bool | CVar String | Add Expr Expr | Sub Expr Expr | Mul Expr Expr | Div Expr Expr | Mod Expr Expr | And Expr Expr | Or Expr Expr | Not Expr | Equal Expr Expr | Less Expr Expr | LessEq Expr Expr | Great Expr Expr | GreatEq Expr Expr | Empty -- [] | Cons Expr Expr | If Expr Expr Expr | Function String Expr | Appl Expr Expr | Let String [String] Expr Expr -- Let String String String ... = Expr In Expr | Semi Expr Expr -- Expr; Expr | Case Expr Expr String String Expr -- Case Expr Of [] -> Expr | (String, String) -> Expr deriving Show

names = words "True False Function If Then Else Let In Case Of" -- reserved names opNames = words "-> && || ! + - * / % = ; < <= > >= :" -- reserved operations lexerConfig = emptyDef { Token.commentStart = "/*" -- adding comments is easy , Token.commentEnd = "*/" , Token.commentLine = "#" , Token.identStart = letter -- identifiers must start with a letter , Token.identLetter = alphaNum char '_' char '\'' , Token.reservedNames = names , Token.reservedOpNames = opNames } lexer = Token.makeTokenParser lexerConfig

letter

alphaNum

char

()

identifier = Token.identifier lexer -- parses a valid identifier in our language symbol = Token.symbol lexer -- parses a symbol like "]" reserved = Token.reserved lexer -- parses a reserved word like "If" reservedOp = Token.reservedOp lexer -- parses a reserved operation like "<=" parens = Token.parens lexer -- parses parenthesis surrounding the parser passed to it brackets = Token.brackets lexer -- parses brackets surrounding the parser passed to it commaSep = Token.commaSep lexer -- parses some or no comma separated instances of -- the argument parser integer = Token.integer lexer -- parses an integer whiteSpace = Token.whiteSpace lexer -- parses whitespace

Expressions and an Appl

prefix

binary

import Control.Applicative ((*>)) -- the opposite of ( return (\x -> label x))

opTable = [ [ prefix "!" Not ] , [ appl ] , [ binary "*" Mul AssocLeft , binary "/" Div AssocLeft , binary "%" Mod AssocLeft ] , [ binary "+" Add AssocLeft , binary "-" Sub AssocLeft ] , [ binary "=" Equal AssocLeft , binary "" Great AssocLeft , binary ">=" GreatEq AssocLeft ] , [ binary "&&" And AssocLeft ] , [ binary "||" Or AssocLeft ] , [ binary ":" Cons AssocRight ] , [ binary ";" Semi AssocLeft ] ]

appl

(Function x -> x + 1) 3

appl

appl = Infix space AssocLeft where space = whiteSpace *> notFollowedBy (choice . map reservedOp $ opNames) *> return (\x y -> Appl x y)

appl

reservedOp

notFollowedBy

opExpr :: Parser Expr opExpr = buildExpressionParser opTable term

Terms of Service

import Control.Applicative ( () -- This takes an argument on its right, -- in this case the value inside the -- monadic parser, and applies it to the function to -- the left (if the parser does not fail) , ( integer cbool :: Parser Expr cbool = CBool True CBool False identifier

list :: Parser Expr list = toCons brackets (commaSep expr) where toCons [] = Empty toCons (x:xs) = Cons x (toCons xs)

expr

toCons

term

opExpr

term :: Parser Expr term = cint cbool cvar list parens expr -- parentheses surrounded expression

Let 's, Case 's, Function 's, and If 's

Let

letExpr :: Parser Expr letExpr = reserved "Let" *> do -- parse the reserved word Let; return the do block s return $ Let x xs e e' -- we must have at least one

sepBy1

identifier

do

Case

caseExpr :: Parser Expr caseExpr = reserved "Case" *> do p symbol "[]" *> reservedOp "->" -- parse an "Of", a "[]", then a "->" x " y

Function

import Control.Applicative (()) -- Adds an extra argument to () function :: Parser Expr function = reserved "Function" *> ((\x y -> Function x y) identifier (reservedOp "->" *> expr)

Function

identifier

->

Expr

If

ifExpr :: Parser Expr ifExpr = reserved "If" *> ((\x y z -> If x y z) expr (reserved "Then" *> expr) (reserved "Else" *> expr))

Expr

expr :: Parser Expr expr = function letExpr ifExpr caseExpr opExpr term

parseString

parseFile

Afterword

Expr

Expr a

Fix

data Expr a = Num Integer | ... newtype Fix f = Fx (f (Fix f)) type NewExpr = Fix Expr

Please enable JavaScript to view the comments powered by Disqus.

Disqus