86 lines
2.1 KiB
Haskell
86 lines
2.1 KiB
Haskell
|
module Parser where
|
||
|
|
|
||
|
|
import Text.Parsec
|
||
|
|
import Text.Parsec.String
|
||
|
|
import Lexer
|
||
|
|
import TokenType
|
||
|
|
import ExprType
|
||
|
|
|
||
|
|
parseExpression :: String -> Either ParseError Expr
|
||
|
|
parseExpression s = do
|
||
|
|
tokns <- parse parseTokens "lexical error" s
|
||
|
|
expr <- parse expressionFromTokensEOF "parsing error" tokns
|
||
|
|
return expr
|
||
|
|
|
||
|
|
expressionFromTokensEOF :: GenParser Token st Expr
|
||
|
|
expressionFromTokensEOF = do
|
||
|
|
expr <- expressionFromTokens
|
||
|
|
_ <- eof
|
||
|
|
return expr
|
||
|
|
|
||
|
|
expressionFromTokens :: GenParser Token st Expr
|
||
|
|
expressionFromTokens = do
|
||
|
|
expr <- intE <|> try defineE <|> try nilE <|> varE <|> procedureE
|
||
|
|
return expr
|
||
|
|
|
||
|
|
intE :: GenParser Token st Expr
|
||
|
|
intE = do
|
||
|
|
(IntT num) <- parseIntT
|
||
|
|
return $ IntE num
|
||
|
|
|
||
|
|
procedureE :: GenParser Token st Expr
|
||
|
|
procedureE = do
|
||
|
|
_ <- parseLeftParenT
|
||
|
|
(VarT p) <- parseVarT
|
||
|
|
args <- many expressionFromTokens
|
||
|
|
_ <- parseRightParenT
|
||
|
|
return $ ProcedureE p args
|
||
|
|
|
||
|
|
varE :: GenParser Token st Expr
|
||
|
|
varE = do
|
||
|
|
(VarT var) <- parseVarT
|
||
|
|
return $ VarE var
|
||
|
|
|
||
|
|
nilE :: GenParser Token st Expr
|
||
|
|
nilE = do
|
||
|
|
_ <- parseNilT
|
||
|
|
return NilE
|
||
|
|
|
||
|
|
defineE :: GenParser Token st Expr
|
||
|
|
defineE = do
|
||
|
|
_ <- parseLeftParenT
|
||
|
|
_ <- parseSetT
|
||
|
|
(VarT var) <- parseVarT
|
||
|
|
expr <- expressionFromTokens
|
||
|
|
_ <- parseRightParenT
|
||
|
|
return $ SetE var expr
|
||
|
|
|
||
|
|
------------------------------------------------------------
|
||
|
|
|
||
|
|
satisfyT :: (Stream s m a, Show a) => (a -> Bool) -> ParsecT s u m a
|
||
|
|
satisfyT f = tokenPrim show
|
||
|
|
(\pos _ _ -> incSourceColumn pos 1)
|
||
|
|
(\t -> if f t then Just t else Nothing)
|
||
|
|
|
||
|
|
parseLeftParenT :: GenParser Token st Token
|
||
|
|
parseLeftParenT = satisfyT (== LeftParenT)
|
||
|
|
|
||
|
|
parseRightParenT :: GenParser Token st Token
|
||
|
|
parseRightParenT = satisfyT (== RightParenT)
|
||
|
|
|
||
|
|
parseSetT :: GenParser Token st Token
|
||
|
|
parseSetT = satisfyT (== SetT)
|
||
|
|
|
||
|
|
parseNilT :: GenParser Token st Token
|
||
|
|
parseNilT = satisfyT (== NilT)
|
||
|
|
|
||
|
|
parseVarT :: GenParser Token st Token
|
||
|
|
parseVarT = satisfyT isVarT
|
||
|
|
where isVarT (VarT _) = True
|
||
|
|
isVarT _ = False
|
||
|
|
|
||
|
|
parseIntT :: GenParser Token st Token
|
||
|
|
parseIntT = satisfyT isIntT
|
||
|
|
where isIntT (IntT _) = True
|
||
|
|
isIntT _ = False
|