diff options
Diffstat (limited to 'src/Language/SimpleShell/Parser/Expr.hs')
| -rw-r--r-- | src/Language/SimpleShell/Parser/Expr.hs | 75 |
1 files changed, 37 insertions, 38 deletions
diff --git a/src/Language/SimpleShell/Parser/Expr.hs b/src/Language/SimpleShell/Parser/Expr.hs index ac6c340..05120ce 100644 --- a/src/Language/SimpleShell/Parser/Expr.hs +++ b/src/Language/SimpleShell/Parser/Expr.hs @@ -3,14 +3,22 @@ module Language.SimpleShell.Parser.Expr ( exprP + , strongTermP ) where -import Language.SimpleShell.Parser (Parser, lexeme, lookupVar, lookupFun) import Language.SimpleShell.AST.Expr (Expr(..), TypedExpr) -import Language.SimpleShell.AST.Name (FunName, VarName) import Language.SimpleShell.AST.SimpleType (SimpleType(..)) +import Language.SimpleShell.Parser + ( Parser + , lexeme + , symbol + , lookupVar + , lookupFun + ) +import Language.SimpleShell.Parser.Name (funNameP, varNameP, keyword) +import Language.SimpleShell.Parser.SimpleType (forceType) import Control.Monad.Combinators.FailExpr ( Associativity(..) , makeExprParser @@ -19,11 +27,9 @@ import Control.Monad.Combinators.FailExpr import Control.Applicative ((<|>)) import Control.Monad.Combinators (manyTill) -import Data.Char (isAlpha) import Data.Foldable (asum) import Data.Text (Text) -import Text.Megaparsec (takeWhile1P) -import Text.Megaparsec.Char (string, char) +import Text.Megaparsec.Char (char) import qualified Text.Megaparsec.Char.Lexer as L (charLiteral, decimal) @@ -42,31 +48,27 @@ strongTermP :: Parser TypedExpr strongTermP = literalP <|> varP - <|> lexeme (char '(') *> exprP <* lexeme (char ')') + <|> symbol "(" *> exprP <* symbol ")" -- | Parse "strong" term with fixed type. strongTermP' :: String -> SimpleType -> Parser Expr -strongTermP' errMsg t = do - (t', e) <- strongTermP - if t == t' - then return e - else fail errMsg +strongTermP' errMsg t = forceType t strongTermP <|> fail errMsg literalP :: Parser TypedExpr literalP = (IntType,) . IntLiteral <$> lexeme L.decimal - <|> (StrType,) . StrLiteral <$> lexeme strLitP - <|> (BoolType,) . BoolLiteral <$> lexeme boolLitP + <|> (StrType,) . StrLiteral <$> strLitP + <|> (BoolType,) . BoolLiteral <$> boolLitP where - strLitP = char '"' *> manyTill L.charLiteral (char '"') + strLitP = lexeme $ char '"' *> manyTill L.charLiteral (char '"') boolLitP - = True <$ string "true" - <|> False <$ string "false" + = True <$ keyword "true" + <|> False <$ keyword "false" varP :: Parser TypedExpr -varP = lexeme $ do +varP = do _ <- char '$' x <- varNameP t <- lookupVar x @@ -74,21 +76,12 @@ varP = lexeme $ do funP :: Parser TypedExpr funP = do - fname <- lexeme funNameP + fname <- funNameP (t', ts) <- lookupFun fname args <- mapM (strongTermP' "Type mismatch with function signature.") ts return (t', FunCall fname args) --- TODO -varNameP :: Parser VarName -varNameP = takeWhile1P Nothing isAlpha - --- TODO -funNameP :: Parser FunName -funNameP = takeWhile1P Nothing isAlpha - - -- Binary operators. type BinaryFun = Expr -> Expr -> Expr @@ -127,7 +120,7 @@ binaryOperatorTable = addP :: Parser (TypedExpr -> TypedExpr -> Maybe TypedExpr) addP = do - _ <- lexeme $ char '+' + symbol "+" return $ \(t1, x1) (t2, x2) -> if t1 == t2 then @@ -140,8 +133,8 @@ binaryOperatorTable = binary :: Associativity -> Text -> BinaryFun -> BinarySig -> Operator Parser TypedExpr - binary assoc symbol op sig = Binary assoc $ do - _ <- lexeme $ string symbol + binary assoc symb op sig = Binary assoc $ do + symbol symb return $ \(t1, e1) (t2, e2) -> fmap (, op e1 e2) $ sig t1 t2 @@ -153,12 +146,12 @@ type UnaryParser = Parser (TypedExpr -> Maybe TypedExpr) unaryOperators, builtinUnaryFuns :: [UnaryParser] (unaryOperators, builtinUnaryFuns) = - ( [ unary "!" Not $ uniqueSig BoolType BoolType - , unary "-" UMinus $ uniqueSig IntType IntType + ( [ unaryOp "!" Not $ uniqueSig BoolType BoolType + , unaryOp "-" UMinus $ uniqueSig IntType IntType ] - , [ unary "length" Length $ uniqueSig StrType IntType - , unary "int" IntCast $ uniqueSig StrType IntType - , unary "str" StrCast $ uniqueSig IntType StrType + , [ unaryFun "length" Length $ uniqueSig StrType IntType + , unaryFun "int" IntCast $ uniqueSig StrType IntType + , unaryFun "str" StrCast $ uniqueSig IntType StrType ] ) where @@ -167,9 +160,15 @@ unaryOperators, builtinUnaryFuns :: [UnaryParser] | t1 == t1' = Just t2 | otherwise = Nothing - unary :: Text -> UnaryFun -> UnarySig -> UnaryParser - unary symbol op sig = do - _ <- lexeme $ string symbol + unaryOp :: Text -> UnaryFun -> UnarySig -> UnaryParser + unaryOp = unary symbol + + unaryFun :: Text -> UnaryFun -> UnarySig -> UnaryParser + unaryFun = unary keyword + + unary :: (Text -> Parser ()) -> Text -> UnaryFun -> UnarySig -> UnaryParser + unary symbPF symb op sig = do + symbPF symb return $ \(t, e) -> fmap (, op e) $ sig t unaryOpP, builtinUnaryFunP :: Parser TypedExpr |