aboutsummaryrefslogtreecommitdiff
path: root/src/Language/SimpleShell
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/SimpleShell')
-rw-r--r--src/Language/SimpleShell/Parser/Function.hs32
1 files changed, 25 insertions, 7 deletions
diff --git a/src/Language/SimpleShell/Parser/Function.hs b/src/Language/SimpleShell/Parser/Function.hs
index a0c5a9b..f7a63f8 100644
--- a/src/Language/SimpleShell/Parser/Function.hs
+++ b/src/Language/SimpleShell/Parser/Function.hs
@@ -2,16 +2,17 @@
module Language.SimpleShell.Parser.Function
( functionP
+ , functionP0
)
where
import Language.SimpleShell.AST.Expr (Expr)
import Language.SimpleShell.AST.Function (Function(..))
-import Language.SimpleShell.AST.Name (VarName)
-import Language.SimpleShell.AST.SimpleType (FunSig, Typed)
+import Language.SimpleShell.AST.Name (FunName, VarName)
+import Language.SimpleShell.AST.SimpleType (SimpleType, FunSig, Typed)
import Language.SimpleShell.Parser (Parser, symbol, declareVars)
-import Language.SimpleShell.Parser.Expr (strongTermP)
+import Language.SimpleShell.Parser.Expr (strongTermP, strongTermP_)
import Language.SimpleShell.Parser.Name (nameP, keyword)
import Language.SimpleShell.Parser.SimpleType (simpleTypeP, forceType)
@@ -19,19 +20,36 @@ import Control.Applicative ((<|>))
import Text.Megaparsec (sepBy)
-functionP :: Parser (FunSig, Function)
-functionP = do
+functionPrefixP :: Parser (SimpleType, FunName, [Typed VarName])
+functionPrefixP = do
keyword "function"
t' <- simpleTypeP
fname <- nameP
params <- symbol "(" *> paramP `sepBy` symbol "," <* symbol ")"
symbol "="
- let (ts, vars) = unzip params
+ return (t', fname, params)
+
+functionP :: Parser Function
+functionP = do
+ (t', fname, params) <- functionPrefixP
+ let vars = map snd params
body <- forceType t' (bodyP params) <|> fail "Function return type mismatch."
- return ((t', ts), Function fname vars body)
+ return $ Function fname vars body
+
+-- | First-pass function parser.
+functionP0 :: Parser (FunName, FunSig)
+functionP0 = do
+ (t', fname, params) <- functionPrefixP
+ let ts = map fst params
+ bodyP_
+ return (fname, (t', ts))
+
paramP :: Parser (Typed VarName)
paramP = (,) <$> simpleTypeP <*> nameP
bodyP :: [Typed VarName] -> Parser (Typed Expr)
bodyP params = declareVars params strongTermP
+
+bodyP_ :: Parser ()
+bodyP_ = strongTermP_