aboutsummaryrefslogtreecommitdiff
path: root/src/Language/SimpleShell
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/SimpleShell')
-rw-r--r--src/Language/SimpleShell/Parser/Expr.hs24
-rw-r--r--src/Language/SimpleShell/Parser/Function.hs40
2 files changed, 37 insertions, 27 deletions
diff --git a/src/Language/SimpleShell/Parser/Expr.hs b/src/Language/SimpleShell/Parser/Expr.hs
index 441e890..7687fb0 100644
--- a/src/Language/SimpleShell/Parser/Expr.hs
+++ b/src/Language/SimpleShell/Parser/Expr.hs
@@ -4,7 +4,7 @@
module Language.SimpleShell.Parser.Expr
( ExprParser
- , runExprParser
+ , ExprContext(..)
, exprP
, strongTermP
, strongTermP0_
@@ -14,7 +14,7 @@ where
import Language.SimpleShell.AST.Expr (Expr(..), TypedExpr)
import Language.SimpleShell.AST.Name (FunName, VarName)
-import Language.SimpleShell.AST.SimpleType (SimpleType(..), Typed, FunSig)
+import Language.SimpleShell.AST.SimpleType (SimpleType(..), FunSig)
import Language.SimpleShell.Parser.Common.Lexeme
( lexeme
, symbol
@@ -31,14 +31,12 @@ import Control.Monad.Combinators.FailExpr
import Control.Applicative ((<|>))
import Control.Monad (void)
-import Control.Monad.Reader (ask, ReaderT, runReaderT)
+import Control.Monad.Reader (ask, ReaderT)
import Control.Monad.Combinators (manyTill)
import Data.Foldable (asum)
-import Data.List (nub)
import Data.Map (Map)
-import qualified Data.Map as Map (empty, lookup, fromList)
+import qualified Data.Map as Map (lookup)
import Data.Text (Text, unpack)
-import Data.Tuple (swap)
import Text.Megaparsec (MonadParsec, takeWhile1P, oneOf, many)
import Text.Megaparsec.Char (char)
import qualified Text.Megaparsec.Char.Lexer as L (charLiteral, decimal)
@@ -49,21 +47,11 @@ type ExprParser = ReaderT ExprContext RootParser
data ExprContext = ExprContext
- { ctxVars :: Map VarName SimpleType
- , ctxFuns :: Map FunName FunSig
+ { ctxFuns :: Map FunName FunSig
+ , ctxVars :: Map VarName SimpleType
}
-runExprParser :: [Typed VarName] -> ExprParser a -> RootParser 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 -> ExprParser SimpleType
lookupVar varname = do
mt <- Map.lookup varname . ctxVars <$> ask
diff --git a/src/Language/SimpleShell/Parser/Function.hs b/src/Language/SimpleShell/Parser/Function.hs
index be3f424..5bc2007 100644
--- a/src/Language/SimpleShell/Parser/Function.hs
+++ b/src/Language/SimpleShell/Parser/Function.hs
@@ -1,4 +1,5 @@
{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts #-}
module Language.SimpleShell.Parser.Function
( functionP
@@ -14,7 +15,7 @@ import Language.SimpleShell.AST.SimpleType (SimpleType, FunSig, Typed)
import Language.SimpleShell.Parser.Common.Lexeme (symbol)
import Language.SimpleShell.Parser.Common.Root (RootParser)
import Language.SimpleShell.Parser.Expr
- ( runExprParser
+ ( ExprContext(ExprContext)
, strongTermP
, strongTermP0_
)
@@ -22,10 +23,22 @@ import Language.SimpleShell.Parser.Name (nameP, keyword)
import Language.SimpleShell.Parser.SimpleType (simpleTypeP, forceType)
import Control.Applicative ((<|>))
-import Text.Megaparsec (sepBy)
+import Control.Monad (guard)
+import Control.Monad.Reader (ReaderT, withReaderT)
+import Data.List (nub)
+import Data.Map (Map)
+import qualified Data.Map as Map (fromList)
+import Data.Text (Text)
+import Data.Tuple (swap)
+import Text.Megaparsec (MonadParsec, sepBy)
-functionPrefixP :: RootParser (SimpleType, FunName, [Typed VarName])
+type FunctionParser0 = RootParser
+type FunctionParser = ReaderT (Map FunName FunSig) RootParser
+
+
+functionPrefixP
+ :: (MonadParsec e Text m) => m (SimpleType, FunName, [Typed VarName])
functionPrefixP = do
keyword "function"
t' <- simpleTypeP
@@ -34,15 +47,16 @@ functionPrefixP = do
symbol "="
return (t', fname, params)
-functionP :: RootParser Function
+functionP :: FunctionParser Function
functionP = do
(t', fname, params) <- functionPrefixP
let vars = map snd params
+ checkNoDupVarNames vars
body <- forceType t' (bodyP params) <|> fail "Function return type mismatch."
return $ Function fname vars body
-- | First-pass function parser.
-functionP0 :: RootParser (FunName, FunSig)
+functionP0 :: FunctionParser0 (FunName, FunSig)
functionP0 = do
(t', fname, params) <- functionPrefixP
let ts = map fst params
@@ -50,11 +64,19 @@ functionP0 = do
return (fname, (t', ts))
-paramP :: RootParser (Typed VarName)
+checkNoDupVarNames :: [VarName] -> FunctionParser ()
+checkNoDupVarNames vars =
+ guard (length (nub vars) == length vars) -- TODO: inefficient
+ <|> fail "Duplicate variable name."
+
+
+paramP :: (MonadParsec e Text m) => m (Typed VarName)
paramP = (,) <$> simpleTypeP <*> nameP
-bodyP :: [Typed VarName] -> RootParser (Typed Expr)
-bodyP params = runExprParser params strongTermP
+bodyP :: [Typed VarName] -> FunctionParser (Typed Expr)
+bodyP params = withReaderT f strongTermP
+ where
+ f funs = ExprContext funs (Map.fromList $ map swap params)
-bodyP_ :: RootParser ()
+bodyP_ :: FunctionParser0 ()
bodyP_ = strongTermP0_