From 7f5656c1b1493a258d373a3fcfac1a455d264406 Mon Sep 17 00:00:00 2001
From: Einhard Leichtfuß <alguien@respiranto.de>
Date: Wed, 21 May 2025 02:01:55 +0200
Subject: Split up parser types

To be continued.
---
 src/Language/SimpleShell/Parser/Expr.hs | 55 ++++++++++++++++++++++++++++-----
 1 file changed, 48 insertions(+), 7 deletions(-)

(limited to 'src/Language/SimpleShell/Parser/Expr.hs')

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
-- 
cgit v1.2.3