module DDC.Core.Tetra.Prim.OpVector
( readOpVectorFlag
, typeOpVectorFlag)
where
import DDC.Core.Tetra.Prim.TyConTetra
import DDC.Core.Tetra.Prim.TyConPrim
import DDC.Core.Tetra.Prim.Base
import DDC.Type.Compounds
import DDC.Type.Exp
import DDC.Base.Pretty
import Control.DeepSeq
instance NFData OpVector where
rnf !_ = ()
instance Pretty OpVector where
ppr pv
= case pv of
OpVectorAlloc -> text "vectorAlloc#"
OpVectorLength -> text "vectorLength#"
OpVectorRead -> text "vectorRead#"
OpVectorWrite -> text "vectorWrite#"
readOpVectorFlag :: String -> Maybe (OpVector, Bool)
readOpVectorFlag str
= case str of
"vectorAlloc#" -> Just (OpVectorAlloc, False)
"vectorAlloc##" -> Just (OpVectorAlloc, True)
"vectorLength#" -> Just (OpVectorLength, False)
"vectorLength##" -> Just (OpVectorLength, True)
"vectorRead#" -> Just (OpVectorRead, False)
"vectorRead##" -> Just (OpVectorRead, True)
"vectorWrite#" -> Just (OpVectorWrite, False)
"vectorWrite##" -> Just (OpVectorWrite, True)
_ -> Nothing
typeOpVectorFlag :: OpVector -> Bool -> Type Name
typeOpVectorFlag op False
= case op of
OpVectorAlloc
-> tForalls [kRegion, kData]
$ \[tR, tA] -> tNat
`tFun` tSusp (tAlloc tR) (tVector tR tA)
OpVectorLength
-> tForalls [kRegion, kData]
$ \[tR, tA] -> tVector tR tA
`tFun` tNat
OpVectorRead
-> tForalls [kRegion, kData]
$ \[tR, tA] -> tVector tR tA `tFun` tNat
`tFun` tSusp (tRead tR) tA
OpVectorWrite
-> tForalls [kRegion, kData]
$ \[tR, tA] -> tVector tR tA `tFun` tNat `tFun` tA
`tFun` tSusp (tWrite tR) tVoid
typeOpVectorFlag op True
= case op of
OpVectorAlloc
-> tForalls [kRegion, kData]
$ \[tR, tA] -> tUnboxed tNat
`tFun` tSusp (tAlloc tR) (tVector tR tA)
OpVectorLength
-> tForalls [kRegion, kData]
$ \[tR, tA] -> tVector tR tA
`tFun` tUnboxed tNat
OpVectorRead
-> tForalls [kRegion, kData]
$ \[tR, tA] -> tVector tR tA `tFun` tUnboxed tNat
`tFun` tSusp (tRead tR) (tUnboxed tA)
OpVectorWrite
-> tForalls [kRegion, kData]
$ \[tR, tA] -> tVector tR tA `tFun` tUnboxed tNat `tFun` tUnboxed tA
`tFun` tSusp (tWrite tR) tVoid