aboutsummaryrefslogtreecommitdiff
path: root/src/Language/SimpleShell/Parser/Function.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/SimpleShell/Parser/Function.hs')
-rw-r--r--src/Language/SimpleShell/Parser/Function.hs36
1 files changed, 36 insertions, 0 deletions
diff --git a/src/Language/SimpleShell/Parser/Function.hs b/src/Language/SimpleShell/Parser/Function.hs
new file mode 100644
index 0000000..29ebbaa
--- /dev/null
+++ b/src/Language/SimpleShell/Parser/Function.hs
@@ -0,0 +1,36 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Language.SimpleShell.Parser.Function
+ ( functionP
+ )
+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.Parser (Parser, symbol, declareVars)
+import Language.SimpleShell.Parser.Expr (strongTermP)
+import Language.SimpleShell.Parser.Name (funNameP, varNameP, keyword)
+import Language.SimpleShell.Parser.SimpleType (simpleTypeP, forceType)
+
+import Control.Applicative ((<|>))
+import Text.Megaparsec (sepBy)
+
+
+functionP :: Parser (FunSig, Function)
+functionP = do
+ keyword "function"
+ t' <- simpleTypeP
+ fname <- funNameP
+ params <- symbol "(" *> paramP `sepBy` symbol "," <* symbol ")"
+ let (ts, vars) = unzip params
+ body <- forceType t' (bodyP params) <|> fail "Function return type mismatch."
+ return ((t', ts), Function fname vars body)
+
+paramP :: Parser (Typed VarName)
+paramP = (,) <$> simpleTypeP <*> varNameP
+
+bodyP :: [Typed VarName] -> Parser (Typed Expr)
+bodyP params = declareVars params strongTermP