module DDC.Core.Eval.Env
(
primDataDefs
, primKindEnv
, kindOfPrimName
, primTypeEnv
, typeOfPrimName
, arityOfName)
where
import DDC.Core.Eval.Compounds
import DDC.Core.Eval.Name
import DDC.Core.DataDef
import DDC.Type.Exp
import DDC.Type.Compounds
import DDC.Type.Env (Env)
import qualified DDC.Type.Env as Env
primDataDefs :: DataDefs Name
primDataDefs
= fromListDataDefs
[ DataDef
(NamePrimCon PrimTyConUnit)
[]
(Just [ (NamePrimCon PrimDaConUnit, []) ])
, DataDef
(NamePrimCon PrimTyConInt)
[kRegion]
Nothing
, DataDef
(NamePrimCon PrimTyConList)
[kRegion, kData]
(Just [ (NamePrimCon PrimDaConNil, [])
, (NamePrimCon PrimDaConCons, [tList (tIx kRegion 1) (tIx kData 0)])])
]
primKindEnv :: Env Name
primKindEnv = Env.setPrimFun kindOfPrimName Env.empty
kindOfPrimName :: Name -> Maybe (Kind Name)
kindOfPrimName nn
= case nn of
NameRgn _
-> Just $ kRegion
NamePrimCon PrimTyConUnit
-> Just $ kData
NamePrimCon PrimTyConList
-> Just $ kRegion `kFun` kData `kFun` kData
NamePrimCon PrimTyConInt
-> Just $ kFun kRegion kData
_ -> Nothing
primTypeEnv :: Env Name
primTypeEnv = Env.setPrimFun typeOfPrimName Env.empty
typeOfPrimName :: Name -> Maybe (Type Name)
typeOfPrimName nn
= case nn of
NamePrimCon PrimDaConUnit
-> Just $ tUnit
NamePrimCon PrimDaConNil
-> Just $ tForalls [kRegion, kData] $ \[tR, tA]
-> tFun tUnit (tAlloc tR)
(tBot kClosure)
$ tList tR tA
NamePrimCon PrimDaConCons
-> Just $ tForalls [kRegion, kData] $ \[tR, tA]
-> tFun tA (tBot kEffect)
(tBot kClosure)
$ tFun (tList tR tA) (tSum kEffect [tAlloc tR])
(tSum kClosure [tDeepUse tA])
$ tList tR tA
NameInt _
-> Just $ tForall kRegion
$ \r -> tFun tUnit (tAlloc r)
(tBot kClosure)
$ tInt r
NamePrimOp PrimOpNegInt
-> Just $ tForalls [kRegion, kRegion] $ \[r1, r0]
-> tFun (tInt r1) (tSum kEffect [tRead r1, tAlloc r0])
(tBot kClosure)
$ (tInt r0)
NamePrimOp p
| elem p [PrimOpAddInt, PrimOpSubInt, PrimOpMulInt, PrimOpDivInt, PrimOpEqInt]
-> Just $ tForalls [kRegion, kRegion, kRegion] $ \[r2, r1, r0]
-> tFun (tInt r2) (tBot kEffect)
(tBot kClosure)
$ tFun (tInt r1) (tSum kEffect [tRead r2, tRead r1, tAlloc r0])
(tSum kClosure [tUse r2])
$ tInt r0
NamePrimOp PrimOpUpdateInt
-> Just $ tForalls [kRegion, kRegion] $ \[r1, r2]
-> tImpl (tMutable r1)
$ tFun (tInt r1) (tBot kEffect)
(tBot kClosure)
$ tFun (tInt r2) (tSum kEffect [tWrite r1, tRead r2])
(tSum kClosure [tUse r1])
$ tUnit
NameCap CapGlobal -> Just $ tForall kRegion $ \r -> tGlobal r
NameCap CapConst -> Just $ tForall kRegion $ \r -> tConst r
NameCap CapMutable -> Just $ tForall kRegion $ \r -> tMutable r
NameCap CapLazy -> Just $ tForall kRegion $ \r -> tLazy r
NameCap CapManifest -> Just $ tForall kRegion $ \r -> tManifest r
_ -> Nothing
arityOfName :: Name -> Maybe Int
arityOfName n
= case n of
NameLoc{} -> Just 0
NameRgn{} -> Just 0
NameInt{} -> Just 2
NamePrimCon PrimDaConUnit -> Just 0
NamePrimCon PrimDaConNil -> Just 3
NamePrimCon PrimDaConCons -> Just 4
NamePrimOp p
| elem p [ PrimOpAddInt, PrimOpSubInt, PrimOpMulInt, PrimOpDivInt
, PrimOpEqInt]
-> Just 5
NamePrimOp PrimOpUpdateInt
-> Just 5
_ -> Nothing