Skip to content

Embed URL

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Happy example: attempt to add error handling 3
-- Calc.y
-- Based on http://www.haskell.org/happy/doc/html/sec-using.html
{
module Main (main) where
import Data.Char
}
%name calc
%tokentype { Token }
%error { parseError }
%token
let { TokenLet }
in { TokenIn }
int { TokenInt $$ }
var { TokenVar $$ }
'=' { TokenEq }
'+' { TokenPlus }
'-' { TokenMinus }
'*' { TokenTimes }
'/' { TokenDiv }
'(' { TokenOB }
')' { TokenCB }
%%
Exp :: { P Int }
: let var '=' Exp in Exp { $4 `thenP` \v p -> $6 (($2, v) : p) }
| Exp1 { $1 }
Exp1 :: { P Int }
: Exp1 '+' Term { $1 `thenP` \v1 -> $3 `thenP` \v2 -> returnP $ v1 + v2 }
| Exp1 '-' Term { $1 `thenP` \v1 -> $3 `thenP` \v2 -> returnP $ v1 - v2 }
| Term { $1 }
Term :: { P Int }
: Term '*' Factor { $1 `thenP` \v1 -> $3 `thenP` \v2 -> returnP $ v1 * v2 }
| Term '/' Factor { $1 `thenP` \v1 -> $3 `thenP` \v2 -> returnP $ v1 `div` v2 }
| Factor { $1 }
Factor :: { P Int }
: int { returnP $1 }
| var { \p -> case lookup $1 p of
Nothing -> failE "no var"
Just i -> returnE i }
| '(' Exp ')' { $2 }
{
type P a = [(String, Int)] -> E a
thenP :: P a -> (a -> P b) -> P b
m `thenP` k = \r ->
m r `thenE` flip k r
returnP :: a -> P a
returnP = const . returnE
failP :: String -> P a
failP = const . failE
data E a = Ok a | Failed String
thenE :: E a -> (a -> E b) -> E b
m `thenE` k =
case m of
Ok a -> k a
Failed e -> Failed e
returnE :: a -> E a
returnE a = Ok a
failE :: String -> E a
failE err = Failed err
parseError :: [Token] -> P a
-- OOPS: Happy expects that parseError has type [Token] -> a
parseError _ = failP "Parse error"
data Token
= TokenLet
| TokenIn
| TokenInt Int
| TokenVar String
| TokenEq
| TokenPlus
| TokenMinus
| TokenTimes
| TokenDiv
| TokenOB
| TokenCB
deriving Show
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) = TokenPlus : lexer cs
lexer ('-':cs) = TokenMinus : lexer cs
lexer ('*':cs) = TokenTimes : lexer cs
lexer ('/':cs) = TokenDiv : lexer cs
lexer ('(':cs) = TokenOB : lexer cs
lexer (')':cs) = TokenCB : lexer cs
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
(var, rest) -> TokenVar var : lexer rest
main :: IO ()
main = do
cs <- getContents
case calc (lexer cs) [] of
Ok res -> print res
Failed err -> putStrLn err
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Something went wrong with that request. Please try again.