module DDC.Core.Parser.Param
( ParamSpec (..)
, funTypeOfParams
, expOfParams
, pBindParamSpecAnnot
, pBindParamSpec )
where
import DDC.Core.Exp
import DDC.Core.Parser.Type
import DDC.Core.Parser.Context
import DDC.Core.Parser.Base (Parser)
import DDC.Core.Lexer.Tokens
import qualified DDC.Base.Parser as P
import qualified DDC.Type.Compounds as T
data ParamSpec n
= ParamType (Bind n)
| ParamWitness (Bind n)
| ParamValue (Bind n) (Type n) (Type n)
expOfParams
:: a
-> [ParamSpec n]
-> Exp a n
-> Exp a n
expOfParams _ [] xBody = xBody
expOfParams a (p:ps) xBody
= case p of
ParamType b
-> XLAM a b $ expOfParams a ps xBody
ParamWitness b
-> XLam a b $ expOfParams a ps xBody
ParamValue b _ _
-> XLam a b $ expOfParams a ps xBody
funTypeOfParams
:: Context
-> [ParamSpec n]
-> Type n
-> Type n
funTypeOfParams _ [] tBody
= tBody
funTypeOfParams c (p:ps) tBody
= case p of
ParamType b
-> TForall b
$ funTypeOfParams c ps tBody
ParamWitness b
-> T.tImpl (T.typeOfBind b)
$ funTypeOfParams c ps tBody
ParamValue b eff clo
| contextFunctionalEffects c
, contextFunctionalClosures c
-> T.tFunEC (T.typeOfBind b) eff clo
$ funTypeOfParams c ps tBody
| otherwise
-> T.tFun (T.typeOfBind b)
$ funTypeOfParams c ps tBody
pBindParamSpec
:: Ord n
=> Context -> Parser n [ParamSpec n]
pBindParamSpec c
= P.choice
[
pBindParamSpecAnnot c
, do b <- pBinder
return $ [ ParamValue (T.makeBindFromBinder b (T.tBot T.kData))
(T.tBot T.kEffect) (T.tBot T.kClosure) ]
]
pBindParamSpecAnnot
:: Ord n
=> Context -> Parser n [ParamSpec n]
pBindParamSpecAnnot c
= P.choice
[ do pTok KSquareBra
bs <- P.many1 pBinder
pTok (KOp ":")
t <- pType c
pTok KSquareKet
return [ ParamType b
| b <- zipWith T.makeBindFromBinder bs (repeat t)]
, do pTok KBraceBra
b <- pBinder
pTok (KOp ":")
t <- pType c
pTok KBraceKet
return [ ParamWitness $ T.makeBindFromBinder b t]
, do pTok KRoundBra
bs <- P.many1 pBinder
pTok (KOp ":")
t <- pType c
pTok KRoundKet
(eff, clo)
<- P.choice
[ do pTok KBraceBra
eff' <- pType c
pTok (KOp "|")
clo' <- pType c
pTok KBraceKet
return (eff', clo')
, do return (T.tBot T.kEffect, T.tBot T.kClosure) ]
let bLast : bsInit
= reverse bs
return $ [ ParamValue (T.makeBindFromBinder b t)
(T.tBot T.kEffect) (T.tBot T.kClosure)
| b <- reverse bsInit]
++ [ ParamValue (T.makeBindFromBinder bLast t) eff clo]
]