aboutsummaryrefslogtreecommitdiff
path: root/src/Language/SimpleShell/Parser/Expr.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/SimpleShell/Parser/Expr.hs')
-rw-r--r--src/Language/SimpleShell/Parser/Expr.hs55
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