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
37

{-# 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 (nameP, 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 <- nameP
  params <- symbol "(" *> paramP `sepBy` symbol "," <* 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 <*> nameP

bodyP :: [Typed VarName] -> Parser (Typed Expr)
bodyP params = declareVars params strongTermP