干货第二波，Haskell实现的Parser, 支持运算语句和备注等，输出可以作为Interpreter的输入
Parser combinator 选用的是 ReadP.
module Parser.Impl where
import SubsAst
import Text.ParserCombinators.ReadP as P
import Data.Char
import Control.Applicative
data ParseError = ParseError String
deriving (Show, Eq)
-- allowed chars which should be allowed in pString
allowedChars :: ReadP Char
allowedChars = do
_ <- char '\\'
c <- satisfy (`elem` "\'nt\\")
case c of
'n' -> return '\n'
't' -> return '\t'
x -> return x
-- keywords which should not be used as a var name no when assign or get var
reserved :: [String]
reserved = ["if", "for", "of", "true","false","undefined"]
-- helper function for read chars of variable name
checkChar :: Char -> Char -> Bool
checkChar sym x = x == sym
-- return Var
pIdent :: ReadP Expr
pIdent = token $ do
fist <- satisfy isLetter
send <- munch (\x -> isLetter x || isDigit x || checkChar '_' x)
let idt = fist : send
if idt `notElem` reserved then return $ Var idt
else fail "keyword can not be used as ident"
-- doing get Ident for assign
pIdget :: ReadP Ident
pIdget = do
fist <- satisfy isLetter
send <- munch (\x -> isLetter x || isDigit x || checkChar '_' x)
let idt = fist : send
if idt `notElem` reserved then return idt
else fail "keyword can not be used as ident"
-- for readin number
pNumber :: ReadP Expr
pNumber = do
sym <- option ' ' (char '-')
number <- munch1 isDigit
if length number <= 8 then
return (Number (read (sym : number) :: Int))
else fail "invalid number"
-- for readin string
pString :: ReadP Expr
pString = do
_ <- char '\''
s <- P.many (allowedChars
<|> satisfy (\x -> isPrint x && notElem x "\t\'\\'")
<|> (do
_ <- char '\\'
_ <- char '\n'
return '\0'))
_ <- char '\''
return (String s)
-- comment
pComment :: ReadP String
pComment = between (string "//") (char '\n') (munch ( /= '\n'))
-- token
-- we keep the skipMany1 pComment for skip comments before token but
-- it might cause time out sometimes
token :: ReadP a -> ReadP a
token p = do
skipSpaces <|> skipMany1 pComment
a <- p
skipSpaces <|> skipMany1 pComment
return a
-- symbol is using for read in a symbol or keyword such as "for" and "if"
symbol :: String -> ReadP String
symbol s = token $ string s
-- read true
pTrue :: ReadP Expr
pTrue = do
_ <- token $ string "true"
return TrueConst
-- read false
pFalse :: ReadP Expr
pFalse = do
_ <- token $ string "false"
return FalseConst
-- read Undefined
pUndefined :: ReadP Expr
pUndefined = do
_ <- token $ string "undefined"
return Undefined
-- stands for the Eq of our grammar tree
pAssign :: ReadP Expr
pAssign = do
idt <- token pIdget
_ <- symbol "="
val <- token pExpr0
return (Assign idt val)
-- array
pArray :: ReadP Expr
pArray = (do
_ <- symbol "["
exps <- pExprs
_ <- symbol "]"
return (Array exps))
<++ (do
_ <- symbol "["
_ <- symbol "]"
return (Array [Undefined]))
-- stands for the Expr of root of grammar tree
pExpr :: ReadP Expr
pExpr = (do
a <- token pExpr1
b <- token pouterComma
return (Comma a b))
<++ token pAssign
<++ token pExpr1
-- stands for the Expr0 of grammar tree,with precidence of 0
pExpr0 :: ReadP Expr
pExpr0 = (do
_ <- symbol "="
token pExpr0)
<++ token pExpr1
-- stands for the Expr1 of grammar tree,with precidence of 1
pExpr1 :: ReadP Expr
pExpr1 = (do
exp2 <- token pExpr2
_ <- symbol "==="
exp1 <- token pExpr2
pOpExpr1 (Call "===" [exp2,exp1])) <++
(do
exp2 <- token pExpr2
_ <- symbol "<"
exp1 <- token pExpr2
pOpExpr1 (Call "<" [exp2,exp1])) <++
token pAssign <++
token pExpr2
-- to help pExpr1 deal with left associativity
pOpExpr1 :: Expr -> ReadP Expr
pOpExpr1 a = (do
_ <- symbol "==="
exp2 <- token pExpr1
return (Call "===" [a,exp2])) <++
(do
_ <- symbol "<"
exp2 <- token pExpr1
return (Call "<" [a,exp2])) <++
return a
-- stands for the Expr2 of grammar tree,with precidence of 2
pExpr2 :: ReadP Expr
pExpr2 = (do
a <- token pExpr3
_ <- symbol "+"
b <- token pExpr3
pOpExpr2 (Call "+" [a,b])) <++
(do
a <- token pExpr3
_ <- symbol "-"
b <- token pExpr3
pOpExpr2 (Call "-" [a,b])) <++
token pExpr3
-- to help pExpr2 deal with left associativity
pOpExpr2 :: Expr -> ReadP Expr
pOpExpr2 a = (do
_ <- symbol "+"
exp2 <- token pExpr2
return (Call "+" [a,exp2])) <++
(do
_ <- symbol "-"
exp2 <- token pExpr2
return (Call "-" [a,exp2])) <++
return a
-- stands for the Expr3 of grammar tree,with precidence of 3
pExpr3 :: ReadP Expr
pExpr3 = (do
a <- token pExpr4
_ <- symbol "*"
b <- token pExpr4
pOpExpr3 (Call "*" [a,b])) <++
(do
a <- token pExpr4
_ <- symbol "%"
b <- token pExpr4
pOpExpr3 (Call "%" [a,b])) <++
token pExpr4
-- to help pExpr3 deal with left associativity
pOpExpr3 :: Expr -> ReadP Expr
pOpExpr3 a = (do
_ <- symbol "*"
exp2 <- token pExpr3
return (Call "*" [a,exp2])) <++
(do
_ <- symbol "%"
exp2 <- token pExpr3
return (Call "%" [a,exp2])) <++
return a
-- stands for the Expr4 of grammar tree,with precidence of 4
pExpr4 :: ReadP Expr
pExpr4 = (do
_ <- symbol "("
e <- token pExpr
_ <- symbol ")"
return e)
<++ pArray
<++(do
_ <- symbol "["
e <- token pComprFor
_ <- symbol "]"
return e)
<++ (do
idt <- token pIdget
_ <- symbol "("
e <- token pExprs
_ <- symbol ")"
return $ Call idt e)
<++ pNumber
<++ pIdent
<++ pString
<++ pTrue
<++ pFalse
<++ pUndefined
-- stands for the OuterComma of the grammar tree
pouterComma :: ReadP Expr
pouterComma = do
_ <- symbol ","
token pExpr
-- helpfunction for pcommaExprs and pExprs
commaHelper :: ReadP [Expr]
commaHelper = do
exp1 <- token pExpr1
com <- token pcommaExprs
return (exp1:com)
-- stands for the commaExprs of the grammar tree
pcommaExprs :: ReadP [Expr]
pcommaExprs = (do
_ <- symbol ","
commaHelper)
<++ (do
_ <- symbol ","
exp1 <- token pExpr1
return [exp1])
-- stands for the Exprs of the grammar tree
pExprs :: ReadP [Expr]
pExprs = (do
exp1 <- token pExpr1
return [exp1])
<++ commaHelper
-- stands for ArrayFor of the grammar tree
pArrayFor :: ReadP ArrayCompr
pArrayFor = do
_ <- symbol "for"
_ <- symbol "("
id' <- token pIdget
_ <- symbol "of"
exp1 <- token pExpr1
_ <- symbol ")"
ac <- token pArrayCompr
return (ACFor id' exp1 ac)
-- stands for the ArrayIf of the grammar tree
pArrayIf :: ReadP ArrayCompr
pArrayIf = do
_ <- symbol "if"
_ <- symbol "("
exp1 <- token pExpr1
_ <- symbol ")"
ac <- token pArrayCompr
return (ACIf exp1 ac)
-- organize the ACIf ,ACFor and ACBody
pArrayCompr :: ReadP ArrayCompr
pArrayCompr = token pArrayIf
<++ token pArrayFor
<++ (do
ex <- token pExpr1
return (ACBody ex))
-- stands for the ArrayCompr of grammar tree
pComprFor :: ReadP Expr
pComprFor = do
ar <- pArrayFor
return (Compr ar)
-- out put the parse result
parseString :: String -> Either ParseError Expr
parseString str = if null (readP_to_S pExpr str) then
Left(ParseError "Invalid expression") else
(do
let legalstr = [x | x <- readP_to_S pExpr str,snd x == ""]
if null legalstr then Left( ParseError "Invalid expression") else
(do
let stri = fst (head legalstr)
case stri of
String s -> Right (String [x | x <- s, x `notElem` "\NUL"])
a -> Right a))