Correctly parse expressions
This commit is contained in:
parent
2220c48f6c
commit
d473c8443f
1 changed files with 27 additions and 11 deletions
|
|
@ -37,7 +37,7 @@ parens = between (symbol "(") (symbol ")")
|
||||||
brackets :: Parser a -> Parser a
|
brackets :: Parser a -> Parser a
|
||||||
brackets = between (symbol "[") (symbol "]")
|
brackets = between (symbol "[") (symbol "]")
|
||||||
|
|
||||||
-- Building blocks
|
-- Names
|
||||||
|
|
||||||
pName :: Parser T.Text
|
pName :: Parser T.Text
|
||||||
pName = lexeme $ unquotedName <|> quotedName
|
pName = lexeme $ unquotedName <|> quotedName
|
||||||
|
|
@ -48,6 +48,29 @@ pName = lexeme $ unquotedName <|> quotedName
|
||||||
pVarName :: Parser T.Text
|
pVarName :: Parser T.Text
|
||||||
pVarName = lexeme $ takeWhile1P (Just "uppercase character") isUpper
|
pVarName = lexeme $ takeWhile1P (Just "uppercase character") isUpper
|
||||||
|
|
||||||
|
-- Statements
|
||||||
|
|
||||||
|
pTermToStat :: Parser (Term T.Text) -> Parser (Stat T.Text)
|
||||||
|
pTermToStat p = do
|
||||||
|
term <- p
|
||||||
|
case term of
|
||||||
|
(TVar _) -> fail "expected term, not variable"
|
||||||
|
(TStat s) -> pure s
|
||||||
|
|
||||||
|
pPlainStat :: Parser (Stat T.Text)
|
||||||
|
pPlainStat = do
|
||||||
|
name <- pName
|
||||||
|
terms <- parens (pTerm `sepBy1` symbol ",") <|> pure []
|
||||||
|
pure $ Stat name terms
|
||||||
|
|
||||||
|
pStat :: Parser (Stat T.Text)
|
||||||
|
pStat = pPlainStat <|> pTermToStat pExpr
|
||||||
|
|
||||||
|
pStats :: Parser [Stat T.Text]
|
||||||
|
pStats = (pStat `sepBy1` symbol ",") <* symbol "."
|
||||||
|
|
||||||
|
-- Terms
|
||||||
|
|
||||||
pCons :: Parser (Term T.Text)
|
pCons :: Parser (Term T.Text)
|
||||||
pCons = brackets $ do
|
pCons = brackets $ do
|
||||||
elems <- pTerm `sepBy1` symbol ","
|
elems <- pTerm `sepBy1` symbol ","
|
||||||
|
|
@ -60,19 +83,10 @@ pList = do
|
||||||
elems <- brackets $ pTerm `sepBy` symbol ","
|
elems <- brackets $ pTerm `sepBy` symbol ","
|
||||||
pure $ foldr (\a b -> TStat $ Stat "[|]" [a, b]) (TStat $ Stat "[]" []) elems
|
pure $ foldr (\a b -> TStat $ Stat "[|]" [a, b]) (TStat $ Stat "[]" []) elems
|
||||||
|
|
||||||
pStat :: Parser (Stat T.Text)
|
|
||||||
pStat = do
|
|
||||||
name <- pName
|
|
||||||
terms <- parens (pTerm `sepBy1` symbol ",") <|> pure []
|
|
||||||
pure $ Stat name terms
|
|
||||||
|
|
||||||
pStats :: Parser [Stat T.Text]
|
|
||||||
pStats = (pStat `sepBy1` symbol ",") <* symbol "."
|
|
||||||
|
|
||||||
pTerm :: Parser (Term T.Text)
|
pTerm :: Parser (Term T.Text)
|
||||||
pTerm
|
pTerm
|
||||||
= (TVar <$> pVarName)
|
= (TVar <$> pVarName)
|
||||||
<|> (TStat <$> pStat)
|
<|> (TStat <$> pPlainStat)
|
||||||
<|> try pCons
|
<|> try pCons
|
||||||
<|> pList
|
<|> pList
|
||||||
<|> parens pExpr
|
<|> parens pExpr
|
||||||
|
|
@ -84,6 +98,8 @@ pExpr = makeExprParser pTerm
|
||||||
where
|
where
|
||||||
binary name = InfixL $ (\a b -> TStat $ Stat name [a, b]) <$ symbol name
|
binary name = InfixL $ (\a b -> TStat $ Stat name [a, b]) <$ symbol name
|
||||||
|
|
||||||
|
-- Definitions
|
||||||
|
|
||||||
pDef :: Parser (Def T.Text)
|
pDef :: Parser (Def T.Text)
|
||||||
pDef = do
|
pDef = do
|
||||||
stat <- pStat
|
stat <- pStat
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue