src/Language/SimpleShell/Parser/Function.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
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