content: 
  module DDC.Core.Flow.Prim.OpStore
          ( OpStore (..)
          , readOpStore
          , typeOpStore
          , xNew,         xRead,       xWrite
          , xNewVector,   xNewVectorR, xNewVectorN
          , xReadVector,  xReadVectorC
          , xWriteVector, xWriteVectorC
          , xTailVector
          , xTruncVector
          , xBufOfVector, xBufOfRateVec)
  where
  import DDC.Core.Flow.Prim.KiConFlow
  import DDC.Core.Flow.Prim.TyConFlow
  import DDC.Core.Flow.Prim.TyConPrim
  import DDC.Core.Flow.Prim.Base
  import DDC.Core.Flow.Exp.Simple.Compounds
  import DDC.Core.Flow.Exp.Simple.Exp
  import DDC.Data.Pretty
  import Control.DeepSeq
  import Data.List
  import Data.Char
  
  instance NFData OpStore where
   rnf !_ = ()
  
  
  instance Pretty OpStore where
   ppr so
    = case so of
          -- Assignables.
          OpStoreNew              -> text "new#"
          OpStoreRead             -> text "read#"
          OpStoreWrite            -> text "write#"
  
          -- Vectors.
          OpStoreNewVector        -> text "vnew#"
          OpStoreNewVectorR       -> text "vnewR#"
          OpStoreNewVectorN       -> text "vnewN#"
  
          OpStoreReadVector  1    -> text "vread#"
          OpStoreReadVector  n    -> text "vread$"  <> int n <> text "#"
  
          OpStoreWriteVector 1    -> text "vwrite#"
          OpStoreWriteVector n    -> text "vwrite$" <> int n <> text "#"
  
          OpStoreTailVector  1    -> text "vtail#"
          OpStoreTailVector  n    -> text "vtail"   <> int n <> text "#"
  
          OpStoreTruncVector      -> text "vtrunc#"
          OpStoreBufOfVector      -> text "vbuf#"
          OpStoreBufOfRateVec     -> text "vbufofratevec#"
  
  
  -- | Read a store operator name.
  readOpStore :: String -> Maybe OpStore
  readOpStore str
          | Just rest     <- stripPrefix "vread$" str
          , (ds, "#")     <- span isDigit rest
          , not $ null ds
          , n             <- read ds
          , n >= 1
          = Just $ OpStoreReadVector n
  
          | Just rest     <- stripPrefix "vwrite$" str
          , (ds, "#")     <- span isDigit rest
          , not $ null ds
          , n             <- read ds
          , n >= 1
          = Just $ OpStoreWriteVector n
  
          | Just rest     <- stripPrefix "vtail$" str
          , (ds, "#")     <- span isDigit rest
          , not $ null ds
          , n             <- read ds
          , n >= 1
          = Just $ OpStoreTailVector n
  
          | otherwise
          = case str of
                  "new#"          -> Just OpStoreNew
                  "read#"         -> Just OpStoreRead
                  "write#"        -> Just OpStoreWrite
  
                  "vnew#"         -> Just OpStoreNewVector
                  "vnewR#"        -> Just OpStoreNewVectorR
                  "vnewN#"        -> Just OpStoreNewVectorN
                  "vread#"        -> Just (OpStoreReadVector  1)
                  "vwrite#"       -> Just (OpStoreWriteVector 1)
                  "vtail#"        -> Just (OpStoreTailVector  1)
                  "vtrunc#"       -> Just OpStoreTruncVector
                  "vbuf#"         -> Just OpStoreBufOfVector
                  "vbufofratevec#"-> Just OpStoreBufOfRateVec
  
                  _               -> Nothing
  
  
  -- Types ----------------------------------------------------------------------
  -- | Yield the type of a store operator.
  typeOpStore :: OpStore -> Type Name
  typeOpStore op
   = case op of
          -- Assignables ----------------
          -- new#        :: [a : Data]. a -> Ref# a
          OpStoreNew
           -> tForall kData $ \tA -> tA `tFun` tRef tA
  
          -- read#       :: [a : Data]. Ref# a -> a
          OpStoreRead
           -> tForall kData $ \tA -> tRef tA `tFun` tA
  
          -- write#      :: [a : Data]. Ref# a -> a -> Unit
          OpStoreWrite
           -> tForall kData $ \tA -> tRef tA `tFun` tA `tFun` tUnit
  
          -- Arrays ---------------------
          -- vnew#   :: [a : Data]. Nat -> Vector# a
          OpStoreNewVector
           -> tForall kData $ \tA -> tNat `tFun` tVector tA
  
          -- vnew#  :: [a : Data]. [k : Rate]. Vector# a
          OpStoreNewVectorR
           -> tForalls [kData, kRate]
           $ \[tA, _] -> tVector tA
  
          -- vnew#  :: [a : Data]. [k : Rate]. RateNat k -> Vector a
          OpStoreNewVectorN
           -> tForalls [kData, kRate]
           $ \[tA, tK] -> tRateNat tK `tFun` tVector tA
  
          -- vread#  :: [a : Data]. Vector# a -> Nat# -> a
          OpStoreReadVector 1
           -> tForall kData
           $  \tA -> tBuffer tA `tFun` tNat `tFun` tA
  
          -- vreadN#  :: [a : Data]. Vector# a -> Nat# -> VecN# a
          OpStoreReadVector n
           -> tForall kData
           $  \tA -> tBuffer tA `tFun` tNat `tFun` tVec n tA
  
          -- vwrite# :: [a : Data]. Vector# a -> Nat# -> a -> Unit
          OpStoreWriteVector 1
           -> tForall kData
           $  \tA -> tBuffer tA `tFun` tNat `tFun` tA `tFun` tUnit
  
          -- vwriteN# :: [a : Data]. Vector# a -> Nat# -> VecN# a -> Unit
          OpStoreWriteVector n
           -> tForall kData
           $  \tA -> tBuffer tA `tFun` tNat `tFun` tVec n tA `tFun` tUnit
  
          -- vtail$N# :: [k : Rate]. [a : Data]. RateNat (TailN k) -> Vector# a -> Vector# a
          OpStoreTailVector n
           -> tForalls [kRate, kData]
           $  \[tK, tA] -> tRateNat (tTail n tK) `tFun` tVector tA `tFun` tVector tA
  
          -- vtrunc#  :: [a : Data]. Nat# -> Vector# a -> Unit
          OpStoreTruncVector
           -> tForall kData
           $  \tA -> tNat `tFun` tVector tA `tFun` tUnit
  
          -- vbuf#   :: [a : Data]. Vector# a -> Buffer# a
          OpStoreBufOfVector
           -> tForall kData
           $  \tA -> tVector tA `tFun` tBuffer tA
  
          -- vbufofratevec#   :: [k : Rate]. [a : Data]. RateVec# k a -> Buffer# a
          OpStoreBufOfRateVec
           -> tForalls [kRate, kData]
           $  \[tK, tA] -> tRateVec tK tA `tFun` tBuffer tA
  
  
  
  -- Compounds ------------------------------------------------------------------
  xNew :: Type Name -> Exp () Name -> Exp () Name
  xNew t xV
   = xApps (xVarOpStore OpStoreNew)
           [XType t, xV ]
  
  
  xRead :: Type Name -> Exp () Name -> Exp () Name
  xRead t xRef
   = xApps (xVarOpStore OpStoreRead)
           [XType t, xRef ]
  
  
  xWrite :: Type Name -> Exp () Name -> Exp () Name -> Exp () Name
  xWrite t xRef xVal
   = xApps (xVarOpStore OpStoreWrite)
           [XType t, xRef, xVal ]
  
  
  xNewVector :: Type Name -> Exp () Name -> Exp () Name
  xNewVector tElem xLen
   = xApps (xVarOpStore OpStoreNewVector)
           [XType tElem, xLen]
  
  
  xNewVectorR :: Type Name -> Type Name -> Exp () Name
  xNewVectorR tElem tR
   = xApps (xVarOpStore OpStoreNewVectorR)
           [XType tElem, XType tR]
  
  
  xNewVectorN :: Type Name -> Type Name -> Exp () Name -> Exp () Name
  xNewVectorN tA tR  xRN
   = xApps (xVarOpStore OpStoreNewVectorN)
           [XType tA, XType tR, xRN]
  
  
  xReadVector :: Type Name -> Exp () Name -> Exp () Name -> Exp () Name
  xReadVector t xArr xIx
   = xApps (xVarOpStore (OpStoreReadVector 1))
           [XType t, xArr, xIx]
  
  
  xReadVectorC :: Int -> Type Name -> Exp () Name -> Exp () Name -> Exp () Name
  xReadVectorC c t xArr xIx
   = xApps (xVarOpStore (OpStoreReadVector c))
           [XType t, xArr, xIx]
  
  
  xWriteVector :: Type Name -> Exp () Name -> Exp () Name -> Exp () Name -> Exp () Name
  xWriteVector t xArr xIx xElem
   = xApps (xVarOpStore (OpStoreWriteVector 1))
           [XType t, xArr, xIx, xElem]
  
  
  xWriteVectorC :: Int -> Type Name -> Exp () Name -> Exp () Name -> Exp () Name -> Exp () Name
  xWriteVectorC c t xArr xIx xElem
   = xApps (xVarOpStore (OpStoreWriteVector c))
           [XType t, xArr, xIx, xElem]
  
  
  xTailVector :: Int -> Type Name -> Type Name -> Exp () Name -> Exp () Name -> Exp () Name
  xTailVector n tK tA xRN xVec
   = xApps (xVarOpStore (OpStoreTailVector n))
           [XType tK, XType tA, xRN, xVec]
  
  
  xTruncVector :: Type Name -> Exp () Name -> Exp () Name -> Exp () Name
  xTruncVector tElem xLen xArr
   = xApps (xVarOpStore OpStoreTruncVector)
           [XType tElem, xLen, xArr]
  
  xBufOfVector :: Type Name -> Exp () Name -> Exp () Name
  xBufOfVector tElem xArr
   = xApps (xVarOpStore OpStoreBufOfVector)
           [XType tElem, xArr]
  
  xBufOfRateVec :: Type Name -> Type Name -> Exp () Name -> Exp () Name
  xBufOfRateVec tRate tElem xArr
   = xApps (xVarOpStore OpStoreBufOfRateVec)
           [XType tRate, XType tElem, xArr]
  
  
  
  
  -- Utils ----------------------------------------------------------------------
  xVarOpStore :: OpStore -> Exp () Name
  xVarOpStore op
          = XVar (UName (NameOpStore op))
  
  