module DDC.Core.Flow.Prim.OpLoop
( readOpLoop
, typeOpLoop
, xLoopLoopN
, xLoopGuard)
where
import DDC.Core.Flow.Prim.KiConFlow
import DDC.Core.Flow.Prim.TyConPrim
import DDC.Core.Flow.Prim.TyConFlow
import DDC.Core.Flow.Prim.Base
import DDC.Core.Compounds.Simple
import DDC.Core.Exp.Simple
import DDC.Base.Pretty
import Control.DeepSeq
instance NFData OpLoop
instance Pretty OpLoop where
ppr fo
= case fo of
OpLoopLoop -> text "loop#"
OpLoopLoopN -> text "loopn#"
OpLoopGuard -> text "guard#"
readOpLoop :: String -> Maybe OpLoop
readOpLoop str
= case str of
"loop#" -> Just $ OpLoopLoop
"loopn#" -> Just $ OpLoopLoopN
"guard#" -> Just $ OpLoopGuard
_ -> Nothing
typeOpLoop :: OpLoop -> Type Name
typeOpLoop op
= case op of
OpLoopLoop
-> tForall kRate
$ \_ -> (tNat `tFun` tUnit) `tFun` tUnit
OpLoopLoopN
-> tForall kRate
$ \kR -> tRateNat kR `tFun` (tNat `tFun` tUnit) `tFun` tUnit
OpLoopGuard
-> tRef tNat
`tFun` tBool
`tFun` (tNat `tFun` tUnit)
`tFun` tUnit
xLoopLoopN :: Type Name -> Exp () Name -> Exp () Name -> Exp () Name
xLoopLoopN tR xRN xF
= xApps (xVarOpLoop OpLoopLoopN) [XType tR, xRN, xF]
xLoopGuard
:: Exp () Name
-> Exp () Name
-> Exp () Name
-> Exp () Name
xLoopGuard xB xCount xF
= xApps (xVarOpLoop OpLoopGuard) [xCount, xB, xF]
xVarOpLoop :: OpLoop -> Exp () Name
xVarOpLoop op
= XVar (UPrim (NameOpLoop op) (typeOpLoop op))