diff options
Diffstat (limited to 'src/Language/SimpleShell/Parser/Expr.hs')
-rw-r--r-- | src/Language/SimpleShell/Parser/Expr.hs | 55 |
1 files changed, 48 insertions, 7 deletions
diff --git a/src/Language/SimpleShell/Parser/Expr.hs b/src/Language/SimpleShell/Parser/Expr.hs index 06d6624..db8a493 100644 --- a/src/Language/SimpleShell/Parser/Expr.hs +++ b/src/Language/SimpleShell/Parser/Expr.hs @@ -2,22 +2,23 @@ {-# LANGUAGE TupleSections #-} module Language.SimpleShell.Parser.Expr - ( exprP + ( ExprParser + , runExprParser + , exprP , strongTermP - , strongTermP_ -- TODO: Unused. + , strongTermP_ ) where import Language.SimpleShell.AST.Expr (Expr(..), TypedExpr) -import Language.SimpleShell.AST.SimpleType (SimpleType(..)) +import Language.SimpleShell.AST.Name (FunName, VarName) +import Language.SimpleShell.AST.SimpleType (SimpleType(..), Typed, FunSig) import Language.SimpleShell.Parser - ( Parser + ( MainParser , lexeme , symbol , commentFirstChars - , lookupVar - , lookupFun ) import Language.SimpleShell.Parser.Name (nameP, keyword) import Language.SimpleShell.Parser.SimpleType (forceType) @@ -29,14 +30,54 @@ import Control.Monad.Combinators.FailExpr import Control.Applicative ((<|>)) import Control.Monad (void) +import Control.Monad.Reader (ask, ReaderT, runReaderT) import Control.Monad.Combinators (manyTill) import Data.Foldable (asum) -import Data.Text (Text) +import Data.List (nub) +import Data.Map (Map) +import qualified Data.Map as Map (empty, lookup, fromList) +import Data.Text (Text, unpack) +import Data.Tuple (swap) import Text.Megaparsec (takeWhile1P, oneOf, many) import Text.Megaparsec.Char (char) import qualified Text.Megaparsec.Char.Lexer as L (charLiteral, decimal) +type ExprParser = ReaderT ExprContext MainParser +type Parser = ExprParser + + +data ExprContext = ExprContext + { ctxVars :: Map VarName SimpleType + , ctxFuns :: Map FunName FunSig + } + + +runExprParser :: [Typed VarName] -> ExprParser a -> MainParser a +runExprParser decls p = + if length (nub names) == length names -- TODO: inefficient + then runReaderT p (ExprContext vars Map.empty) + else fail "Duplicate variable name." + where + names = map snd decls + vars = Map.fromList $ map swap decls + + +lookupVar :: VarName -> Parser SimpleType +lookupVar varname = do + mt <- Map.lookup varname . ctxVars <$> ask + case mt of + Just t -> return t + Nothing -> fail $ "Undeclared variable $" ++ unpack varname + +lookupFun :: FunName -> Parser FunSig +lookupFun fname = do + msig <- Map.lookup fname . ctxFuns <$> ask + case msig of + Just sig -> return sig + Nothing -> fail $ "Undefined function " ++ unpack fname + + exprP :: Parser TypedExpr exprP = makeExprParser weakTermP binaryOperatorTable |