aboutsummaryrefslogtreecommitdiff
path: root/src/Language/SimpleShell/Parser.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/SimpleShell/Parser.hs')
-rw-r--r--src/Language/SimpleShell/Parser.hs22
1 files changed, 19 insertions, 3 deletions
diff --git a/src/Language/SimpleShell/Parser.hs b/src/Language/SimpleShell/Parser.hs
index dd65ffe..d75602b 100644
--- a/src/Language/SimpleShell/Parser.hs
+++ b/src/Language/SimpleShell/Parser.hs
@@ -3,8 +3,10 @@
module Language.SimpleShell.Parser
( Parser
, lexeme
+ , symbol
, lookupVar
, lookupFun
+ , declareVars
, initContext
, parseTest
)
@@ -12,18 +14,22 @@ where
import Language.SimpleShell.AST.Name (FunName, VarName)
-import Language.SimpleShell.AST.SimpleType (SimpleType, FunSig)
+import Language.SimpleShell.AST.SimpleType (SimpleType, FunSig, Typed)
-import Control.Monad.Reader (ask, ReaderT, runReaderT)
+import Control.Monad (void)
+import Control.Monad.Reader (ask, local, ReaderT, runReaderT)
+import Data.List (nub)
import Data.Map (Map)
-import qualified Data.Map as Map (empty, lookup)
+import qualified Data.Map as Map (empty, lookup, fromList)
import Data.Text (Text, unpack)
+import Data.Tuple (swap)
import Data.Void (Void)
import Text.Megaparsec (Parsec)
import qualified Text.Megaparsec as MP (parseTest)
import Text.Megaparsec.Char (space1)
import qualified Text.Megaparsec.Char.Lexer as L
( lexeme
+ , symbol
, space
, skipLineComment
, skipBlockComment
@@ -53,6 +59,9 @@ sc = L.space
lexeme :: Parser a -> Parser a
lexeme = L.lexeme sc
+symbol :: Text -> Parser ()
+symbol = void . L.symbol sc
+
lookupVar :: VarName -> Parser SimpleType
lookupVar varname = do
@@ -68,6 +77,13 @@ lookupFun fname = do
Just sig -> return sig
Nothing -> fail $ "Undefined function " ++ unpack fname
+declareVars :: [Typed VarName] -> Parser a -> Parser a
+declareVars decls p = do
+ let names = map snd decls
+ if length (nub names) == length names -- TODO: inefficient
+ then local (\ctx -> ctx { ctxVars = Map.fromList $ map swap decls }) p
+ else fail "Duplicate variable name."
+
parseTest :: Show a => Parser a -> Text -> IO ()
parseTest p = MP.parseTest (runReaderT p initContext)