{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | High-level translation of Copilot Core into Bluespec.
module Copilot.Compile.Bluespec.CodeGen
  ( -- * Type declarations
    mkStructDecln

    -- * Ring buffers
  , mkBuffDecln
  , mkIndexDecln
  , mkAccessDecln

    -- * Stream generators
  , mkGenFun

    -- * External streams
  , mkExtWireDecln

    -- * Monitor processing
  , mkStepRule
  , mkExtRule
  , mkTriggerRule

    -- * Module interface specifications
  , mkSpecIfcFields
  , mkSpecIfcRulesFields
  ) where

-- External imports
import Data.String (IsString (..))
import qualified Language.Bluespec.Classic.AST as BS
import qualified Language.Bluespec.Classic.AST.Builtin.Ids as BS
import qualified Language.Bluespec.Classic.AST.Builtin.Types as BS

-- Internal imports: Copilot
import Copilot.Core

-- Internal imports
import Copilot.Compile.Bluespec.Expr
import Copilot.Compile.Bluespec.External
import Copilot.Compile.Bluespec.Name
import Copilot.Compile.Bluespec.Representation
import Copilot.Compile.Bluespec.Type

-- | Write a generator function for a stream.
mkGenFun :: String -> Expr a -> Type a -> BS.CDefl
mkGenFun :: forall a. String -> Expr a -> Type a -> CDefl
mkGenFun String
name Expr a
expr Type a
ty =
    -- name :: ty
    -- name = expr
    CDef -> [CQual] -> CDefl
BS.CLValueSign
      (Id -> CQType -> [CClause] -> CDef
BS.CDef Id
nameId ([CPred] -> CType -> CQType
BS.CQType [] (Type a -> CType
forall a. Type a -> CType
transType Type a
ty)) [CClause
def])
      []
  where
    nameId :: Id
nameId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ String -> String
lowercaseName String
name
    def :: CClause
def    = [CPat] -> [CQual] -> CExpr -> CClause
BS.CClause [] [] (Expr a -> CExpr
forall a. Expr a -> CExpr
transExpr Expr a
expr)

-- | Bind a @Wire@ variable using @mkBypassWire@.
mkExtWireDecln :: String -> Type a -> BS.CStmt
mkExtWireDecln :: forall a. String -> Type a -> CStmt
mkExtWireDecln String
name Type a
ty =
  CPat
-> Maybe CExpr -> [(Position, PProp)] -> CQType -> CExpr -> CStmt
BS.CSBindT
    (Id -> CPat
BS.CPVar (Position -> FString -> Id
BS.mkId Position
BS.NoPos (String -> FString
forall a. IsString a => String -> a
fromString (String -> String
wireName String
name))))
    Maybe CExpr
forall a. Maybe a
Nothing
    []
    ([CPred] -> CType -> CQType
BS.CQType [] (CType
tWire CType -> CType -> CType
`BS.TAp` Type a -> CType
forall a. Type a -> CType
transType Type a
ty))
    (Id -> CExpr
BS.CVar (Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"mkBypassWire"))

-- | Bind a buffer variable and initialise it with the stream buffer.
mkBuffDecln :: forall a. Id -> Type a -> [a] -> [BS.CStmt]
mkBuffDecln :: forall a. Id -> Type a -> [a] -> [CStmt]
mkBuffDecln Id
sId Type a
ty [a]
xs =
    [CStmt]
initVals [CStmt] -> [CStmt] -> [CStmt]
forall a. [a] -> [a] -> [a]
++ [[CDefl] -> CStmt
BS.CSletrec [CDefl
initBufSig]]
  where
    -- sId_0     :: Reg <ty> <- mkReg xs_0
    -- ...
    -- sId_(n-1) :: Reg <ty> <- mkReg xs_(n-1)
    initVals :: [CStmt]
initVals = (a -> Id -> CStmt) -> [a] -> [Id] -> [CStmt]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> Id -> CStmt
mkInitVal [a]
xs [Id
0..]
    -- sId :: Vector n (Reg <ty>)
    -- sId = update (... (update newVector 0 sId_0) ...) (n-1) sId_(n-1)
    initBufSig :: CDefl
initBufSig = CDef -> [CQual] -> CDefl
BS.CLValueSign
                   (Id -> CQType -> [CClause] -> CDef
BS.CDef Id
nameId ([CPred] -> CType -> CQType
BS.CQType [] CType
vecTy) [CClause
initBufDef])
                   []
    initBufDef :: CClause
initBufDef = [CPat] -> [CQual] -> CExpr -> CClause
BS.CClause
                   []
                   []
                   ((Id -> a -> CExpr) -> [a] -> CExpr
forall a. (Id -> a -> CExpr) -> [a] -> CExpr
genVector
                     (\Id
idx a
_ -> Id -> CExpr
BS.CVar (Id -> CExpr) -> Id -> CExpr
forall a b. (a -> b) -> a -> b
$ Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$
                                String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ Id -> Id -> String
streamElemName Id
sId Id
idx)
                     [a]
xs)

    nameId :: Id
nameId   = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ Id -> String
streamName Id
sId
    bsTy :: CType
bsTy     = CType
tReg CType -> CType -> CType
`BS.TAp` Type a -> CType
forall a. Type a -> CType
transType Type a
ty
    vecTy :: CType
vecTy    = CType
tVector CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum Integer
numElems Position
BS.NoPos CType -> CType -> CType
`BS.TAp` CType
bsTy
    numElems :: Integer
numElems = Id -> Integer
forall a. Integral a => a -> Integer
toInteger (Id -> Integer) -> Id -> Integer
forall a b. (a -> b) -> a -> b
$ [a] -> Id
forall a. [a] -> Id
forall (t :: * -> *) a. Foldable t => t a -> Id
length [a]
xs

    mkInitVal :: a -> Int -> BS.CStmt
    mkInitVal :: a -> Id -> CStmt
mkInitVal a
x Id
elemNum =
        CPat
-> Maybe CExpr -> [(Position, PProp)] -> CQType -> CExpr -> CStmt
BS.CSBindT
          (Id -> CPat
BS.CPVar Id
elemId)
          Maybe CExpr
forall a. Maybe a
Nothing
          []
          ([CPred] -> CType -> CQType
BS.CQType [] CType
bsTy)
          (CExpr -> [CExpr] -> CExpr
BS.CApply (Id -> CExpr
BS.CVar (Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"mkReg")) [Type a -> a -> CExpr
forall a. Type a -> a -> CExpr
constTy Type a
ty a
x])
      where
        elemName :: String
elemName = Id -> Id -> String
streamElemName Id
sId Id
elemNum
        elemId :: Id
elemId   = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString String
elemName

-- | Make an index variable and initialise it to 0.
mkIndexDecln :: Id -> BS.CStmt
mkIndexDecln :: Id -> CStmt
mkIndexDecln Id
sId =
  -- sId_idx :: Reg (Bit 64) <- mkReg 0
  CPat
-> Maybe CExpr -> [(Position, PProp)] -> CQType -> CExpr -> CStmt
BS.CSBindT
    (Id -> CPat
BS.CPVar Id
nameId)
    Maybe CExpr
forall a. Maybe a
Nothing
    []
    ([CPred] -> CType -> CQType
BS.CQType [] CType
bsTy)
    (CExpr -> [CExpr] -> CExpr
BS.CApply (Id -> CExpr
BS.CVar (Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"mkReg"))
               [Literal -> CExpr
cLit (Literal -> CExpr) -> Literal -> CExpr
forall a b. (a -> b) -> a -> b
$ IntLit -> Literal
BS.LInt (IntLit -> Literal) -> IntLit -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> IntLit
BS.ilDec Integer
0])
  where
    nameId :: Id
nameId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ Id -> String
indexName Id
sId
    bsTy :: CType
bsTy   = CType
tReg CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.tBitN Integer
64 Position
BS.NoPos

-- | Define an accessor function for the ring buffer associated with a stream
mkAccessDecln :: Id -> Type a -> [a] -> BS.CDefl
mkAccessDecln :: forall a. Id -> Type a -> [a] -> CDefl
mkAccessDecln Id
sId Type a
ty [a]
xs =
    -- sId_get :: Bits 64 -> ty
    -- sId_get x = (select sId ((sId_idx + x) % buffLength))._read
    CDef -> [CQual] -> CDefl
BS.CLValueSign (Id -> CQType -> [CClause] -> CDef
BS.CDef Id
nameId ([CPred] -> CType -> CQType
BS.CQType [] CType
funTy) [CClause
def]) []
  where
    def :: CClause
def        = [CPat] -> [CQual] -> CExpr -> CClause
BS.CClause [Id -> CPat
BS.CPVar Id
argId] [] CExpr
expr
    argTy :: CType
argTy      = CType
BS.tBit CType -> CType -> CType
`BS.TAp` Integer -> Position -> CType
BS.cTNum Integer
64 Position
BS.NoPos
    retTy :: CType
retTy      = Type a -> CType
forall a. Type a -> CType
transType Type a
ty
    funTy :: CType
funTy      = CType
BS.tArrow CType -> CType -> CType
`BS.TAp` CType
argTy CType -> CType -> CType
`BS.TAp` CType
retTy
    name :: String
name       = Id -> String
streamAccessorName Id
sId
    nameId :: Id
nameId     = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString String
name
    buffLength :: CExpr
buffLength = Literal -> CExpr
cLit (Literal -> CExpr) -> Literal -> CExpr
forall a b. (a -> b) -> a -> b
$ IntLit -> Literal
BS.LInt (IntLit -> Literal) -> IntLit -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> IntLit
BS.ilDec (Integer -> IntLit) -> Integer -> IntLit
forall a b. (a -> b) -> a -> b
$ Id -> Integer
forall a. Integral a => a -> Integer
toInteger (Id -> Integer) -> Id -> Integer
forall a b. (a -> b) -> a -> b
$ [a] -> Id
forall a. [a] -> Id
forall (t :: * -> *) a. Foldable t => t a -> Id
length [a]
xs
    argId :: Id
argId      = Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"x"
    index :: CExpr
index      = CExpr -> [CExpr] -> CExpr
BS.CApply (Id -> CExpr
BS.CVar (Position -> Id
BS.idPercentAt Position
BS.NoPos))
                   [ CExpr -> [CExpr] -> CExpr
BS.CApply (Id -> CExpr
BS.CVar Id
BS.idPlus)
                       [ Id -> CExpr
BS.CVar (Position -> FString -> Id
BS.mkId Position
BS.NoPos (String -> FString
forall a. IsString a => String -> a
fromString (Id -> String
indexName Id
sId)))
                       , Id -> CExpr
BS.CVar Id
argId
                       ]
                   , CExpr
buffLength
                   ]
    indexExpr :: CExpr
indexExpr  = CExpr -> CExpr -> CExpr
cIndexVector
                   (Id -> CExpr
BS.CVar (Position -> FString -> Id
BS.mkId Position
BS.NoPos (String -> FString
forall a. IsString a => String -> a
fromString (Id -> String
streamName Id
sId))))
                   CExpr
index
    expr :: CExpr
expr       = CExpr -> Id -> CExpr
BS.CSelect CExpr
indexExpr (Position -> Id
BS.id_read Position
BS.NoPos)

-- | Define fields for a module interface containing a specification's trigger
-- functions and external variables.
mkSpecIfcFields :: [UniqueTrigger] -> [External] -> [BS.CField]
mkSpecIfcFields :: [UniqueTrigger] -> [External] -> [CField]
mkSpecIfcFields [UniqueTrigger]
uniqueTriggers [External]
exts =
    (UniqueTrigger -> [CField]) -> [UniqueTrigger] -> [CField]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap UniqueTrigger -> [CField]
mkTriggerFields [UniqueTrigger]
uniqueTriggers [CField] -> [CField] -> [CField]
forall a. [a] -> [a] -> [a]
++ (External -> CField) -> [External] -> [CField]
forall a b. (a -> b) -> [a] -> [b]
map External -> CField
mkExtField [External]
exts
  where
    -- trigger_guard :: Bool
    -- trigger_arg0 :: arg_ty_0
    -- ...
    -- trigger_arg(n-1) :: arg_ty_(n-1)
    mkTriggerFields :: UniqueTrigger -> [BS.CField]
    mkTriggerFields :: UniqueTrigger -> [CField]
mkTriggerFields (UniqueTrigger String
uniqueName (Trigger String
_name Expr Bool
_ [UExpr]
args)) =
        CField
triggerGuardField CField -> [CField] -> [CField]
forall a. a -> [a] -> [a]
: [CField]
triggerArgFields
      where
        triggerGuardField :: BS.CField
        triggerGuardField :: CField
triggerGuardField = String -> [IfcPragma] -> CType -> CField
mkField (String -> String
guardName String
uniqueName) [] CType
BS.tBool

        triggerArgFields :: [BS.CField]
        triggerArgFields :: [CField]
triggerArgFields =
          (UExpr -> String -> CField) -> [UExpr] -> [String] -> [CField]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith
            (\(UExpr Type a
arg Expr a
_) String
argName -> String -> [IfcPragma] -> CType -> CField
mkField String
argName [] (Type a -> CType
forall a. Type a -> CType
transType Type a
arg))
            [UExpr]
args
            (String -> [String]
argNames String
uniqueName)

    -- ext :: ty -> Action
    mkExtField :: External -> BS.CField
    mkExtField :: External -> CField
mkExtField (External String
name Type a
ty) =
      String -> [IfcPragma] -> CType -> CField
mkField
        String
name
        [ String -> IfcPragma
BS.PIPrefixStr String
""
        , [Id] -> IfcPragma
BS.PIArgNames [Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ String -> String
lowercaseName String
name]
        ]
        (CType
BS.tArrow CType -> CType -> CType
`BS.TAp` Type a -> CType
forall a. Type a -> CType
transType Type a
ty CType -> CType -> CType
`BS.TAp` CType
BS.tAction)

-- | Define fields for a module interface containing the actions to perform for
-- a specification's trigger functions and external variables.
mkSpecIfcRulesFields :: [Trigger] -> [External] -> [BS.CField]
mkSpecIfcRulesFields :: [Trigger] -> [External] -> [CField]
mkSpecIfcRulesFields [Trigger]
triggers [External]
exts =
    (Trigger -> CField) -> [Trigger] -> [CField]
forall a b. (a -> b) -> [a] -> [b]
map Trigger -> CField
mkTriggerField [Trigger]
triggers [CField] -> [CField] -> [CField]
forall a. [a] -> [a] -> [a]
++ (External -> CField) -> [External] -> [CField]
forall a b. (a -> b) -> [a] -> [b]
map External -> CField
mkExtField [External]
exts
  where
    -- trigger_action :: arg_ty_0 -> ... -> arg_ty_(n-1) -> Action
    mkTriggerField :: Trigger -> BS.CField
    mkTriggerField :: Trigger -> CField
mkTriggerField (Trigger String
name Expr Bool
_ [UExpr]
args) =
        String -> [IfcPragma] -> CType -> CField
mkField (String -> String
actionName String
name) [] CType
triggerFieldType
      where
        triggerFieldType :: BS.CType
        triggerFieldType :: CType
triggerFieldType = (UExpr -> CType -> CType) -> CType -> [UExpr] -> CType
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr UExpr -> CType -> CType
addArgType CType
BS.tAction [UExpr]
args

        addArgType :: UExpr -> BS.CType -> BS.CType
        addArgType :: UExpr -> CType -> CType
addArgType (UExpr Type a
arg Expr a
_) CType
res =
          CType
BS.tArrow CType -> CType -> CType
`BS.TAp` Type a -> CType
forall a. Type a -> CType
transType Type a
arg CType -> CType -> CType
`BS.TAp` CType
res

    -- ext_action :: ActionValue ty
    mkExtField :: External -> BS.CField
    mkExtField :: External -> CField
mkExtField (External String
name Type a
ty) =
      String -> [IfcPragma] -> CType -> CField
mkField (String -> String
actionName String
name) [] (CType
BS.tActionValue CType -> CType -> CType
`BS.TAp` Type a -> CType
forall a. Type a -> CType
transType Type a
ty)

-- | Define a rule for an external stream that performs an action on the most
-- recently computed value from the stream.
mkExtRule :: External -> BS.CRule
mkExtRule :: External -> CRule
mkExtRule (External String
name Type a
_) =
    -- rules
    --   "ext": when True ==>
    --     action
    --       extVal <- ifcRules.ext_action
    --       ifc.ext extVal
    [RulePragma] -> Maybe CExpr -> [CQual] -> CExpr -> CRule
BS.CRule
      []
      (CExpr -> Maybe CExpr
forall a. a -> Maybe a
Just (CExpr -> Maybe CExpr) -> CExpr -> Maybe CExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CExpr
cLit (Literal -> CExpr) -> Literal -> CExpr
forall a b. (a -> b) -> a -> b
$ String -> Literal
BS.LString String
name)
      [CExpr -> CQual
BS.CQFilter (CExpr -> CQual) -> CExpr -> CQual
forall a b. (a -> b) -> a -> b
$ Id -> [CExpr] -> CExpr
BS.CCon Id
BS.idTrue []]
      (Position -> [CStmt] -> CExpr
BS.Caction Position
BS.NoPos [CStmt
callExtAction, CStmt
callExt])
  where
    ifcArgId :: Id
ifcArgId      = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString String
ifcArgName
    ifcRulesArgId :: Id
ifcRulesArgId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString String
ifcRulesArgName

    extActionId :: Id
extActionId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ String -> String
actionName String
name
    extId :: Id
extId       = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString String
name
    extValId :: Id
extValId    = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ String
name String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"Val"

    -- extVal <- ifcRules.ext_action
    callExtAction :: BS.CStmt
    callExtAction :: CStmt
callExtAction =
      CPat -> Maybe CExpr -> [(Position, PProp)] -> CExpr -> CStmt
BS.CSBind
        (Id -> CPat
BS.CPVar Id
extValId)
        Maybe CExpr
forall a. Maybe a
Nothing
        []
        (CExpr -> Id -> CExpr
BS.CSelect (Id -> CExpr
BS.CVar Id
ifcRulesArgId) Id
extActionId)

    -- ifc.ext extVal
    callExt :: BS.CStmt
    callExt :: CStmt
callExt =
      Maybe CExpr -> CExpr -> CStmt
BS.CSExpr Maybe CExpr
forall a. Maybe a
Nothing (CExpr -> CStmt) -> CExpr -> CStmt
forall a b. (a -> b) -> a -> b
$
        CExpr -> [CExpr] -> CExpr
BS.CApply (CExpr -> Id -> CExpr
BS.CSelect (Id -> CExpr
BS.CVar Id
ifcArgId) Id
extId) [Id -> CExpr
BS.CVar Id
extValId]

-- | Define a rule for a trigger function that performs an action when the rule
-- fires.
mkTriggerRule :: UniqueTrigger -> BS.CRule
mkTriggerRule :: UniqueTrigger -> CRule
mkTriggerRule (UniqueTrigger String
uniqueName (Trigger String
name Expr Bool
_ [UExpr]
args)) =
    -- rules
    --   "trigger": when ifc.trigger_guard ==>
    --     ifcRules.trigger_action ifc.trigger_arg0
    [RulePragma] -> Maybe CExpr -> [CQual] -> CExpr -> CRule
BS.CRule
      []
      (CExpr -> Maybe CExpr
forall a. a -> Maybe a
Just (CExpr -> Maybe CExpr) -> CExpr -> Maybe CExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CExpr
cLit (Literal -> CExpr) -> Literal -> CExpr
forall a b. (a -> b) -> a -> b
$ String -> Literal
BS.LString String
uniqueName)
      [ CExpr -> CQual
BS.CQFilter (CExpr -> CQual) -> CExpr -> CQual
forall a b. (a -> b) -> a -> b
$
          CExpr -> Id -> CExpr
BS.CSelect
            (Id -> CExpr
BS.CVar Id
ifcArgId)
            (Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ String -> String
guardName String
uniqueName)
      ]
      (CExpr -> [CExpr] -> CExpr
BS.CApply CExpr
actionNameExpr [CExpr]
args')
  where
    ifcArgId :: Id
ifcArgId      = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString String
ifcArgName
    ifcRulesArgId :: Id
ifcRulesArgId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString String
ifcRulesArgName
    -- Note that we use 'name' here instead of 'uniqueName', as 'name' is the
    -- name of the actual external function.
    actionNameId :: Id
actionNameId   = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ String -> String
actionName String
name
    actionNameExpr :: CExpr
actionNameExpr = CExpr -> Id -> CExpr
BS.CSelect (Id -> CExpr
BS.CVar Id
ifcRulesArgId) Id
actionNameId

    args' :: [CExpr]
args'   = Id -> [CExpr] -> [CExpr]
forall a. Id -> [a] -> [a]
take ([UExpr] -> Id
forall a. [a] -> Id
forall (t :: * -> *) a. Foldable t => t a -> Id
length [UExpr]
args) ((String -> CExpr) -> [String] -> [CExpr]
forall a b. (a -> b) -> [a] -> [b]
map String -> CExpr
argCall (String -> [String]
argNames String
uniqueName))
    argCall :: String -> CExpr
argCall = CExpr -> Id -> CExpr
BS.CSelect (Id -> CExpr
BS.CVar Id
ifcArgId) (Id -> CExpr) -> (String -> Id) -> String -> CExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> (String -> FString) -> String -> Id
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> FString
forall a. IsString a => String -> a
fromString

-- | Writes the @step@ rule that updates all streams.
mkStepRule :: [Stream] -> Maybe BS.CRule
mkStepRule :: [Stream] -> Maybe CRule
mkStepRule [Stream]
streams
  | [CStmt] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CStmt]
allUpdates
  = -- If there is nothing to update, don't bother creating a step rule.
    -- Doing so wouldn't harm anything, but bsc will generate a warning
    -- when compiling such an empty rule.
    Maybe CRule
forall a. Maybe a
Nothing
  | Bool
otherwise
  = CRule -> Maybe CRule
forall a. a -> Maybe a
Just (CRule -> Maybe CRule) -> CRule -> Maybe CRule
forall a b. (a -> b) -> a -> b
$
    [RulePragma] -> Maybe CExpr -> [CQual] -> CExpr -> CRule
BS.CRule
      []
      (CExpr -> Maybe CExpr
forall a. a -> Maybe a
Just (CExpr -> Maybe CExpr) -> CExpr -> Maybe CExpr
forall a b. (a -> b) -> a -> b
$ Literal -> CExpr
cLit (Literal -> CExpr) -> Literal -> CExpr
forall a b. (a -> b) -> a -> b
$ String -> Literal
BS.LString String
"step")
      [CExpr -> CQual
BS.CQFilter (CExpr -> CQual) -> CExpr -> CQual
forall a b. (a -> b) -> a -> b
$ Id -> [CExpr] -> CExpr
BS.CCon Id
BS.idTrue []]
      (Position -> [CStmt] -> CExpr
BS.Caction Position
BS.NoPos [CStmt]
allUpdates)
  where
    allUpdates :: [CStmt]
allUpdates = [CStmt]
bufferUpdates [CStmt] -> [CStmt] -> [CStmt]
forall a. [a] -> [a] -> [a]
++ [CStmt]
indexUpdates
    ([CStmt]
bufferUpdates, [CStmt]
indexUpdates) = [(CStmt, CStmt)] -> ([CStmt], [CStmt])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(CStmt, CStmt)] -> ([CStmt], [CStmt]))
-> [(CStmt, CStmt)] -> ([CStmt], [CStmt])
forall a b. (a -> b) -> a -> b
$ (Stream -> (CStmt, CStmt)) -> [Stream] -> [(CStmt, CStmt)]
forall a b. (a -> b) -> [a] -> [b]
map Stream -> (CStmt, CStmt)
mkUpdateGlobals [Stream]
streams

    -- Write code to update global stream buffers and index.
    mkUpdateGlobals :: Stream -> (BS.CStmt, BS.CStmt)
    mkUpdateGlobals :: Stream -> (CStmt, CStmt)
mkUpdateGlobals (Stream Id
sId [a]
buff Expr a
_ Type a
_) =
        (CStmt
bufferUpdate, CStmt
indexUpdate)
      where
        bufferUpdate :: CStmt
bufferUpdate =
          Maybe CExpr -> CExpr -> CStmt
BS.CSExpr Maybe CExpr
forall a. Maybe a
Nothing (CExpr -> CStmt) -> CExpr -> CStmt
forall a b. (a -> b) -> a -> b
$
          Position -> CExpr -> CExpr -> CExpr
BS.Cwrite
            Position
BS.NoPos
            (CExpr -> CExpr -> CExpr
cIndexVector (Id -> CExpr
BS.CVar Id
buffId) (Id -> CExpr
BS.CVar Id
indexId))
            (Id -> CExpr
BS.CVar Id
genId)

        indexUpdate :: CStmt
indexUpdate =
          Maybe CExpr -> CExpr -> CStmt
BS.CSExpr Maybe CExpr
forall a. Maybe a
Nothing (CExpr -> CStmt) -> CExpr -> CStmt
forall a b. (a -> b) -> a -> b
$
          Position -> CExpr -> CExpr -> CExpr
BS.Cwrite
            Position
BS.NoPos
            (Id -> CExpr
BS.CVar Id
indexId)
            (CExpr -> [CExpr] -> CExpr
BS.CApply (Id -> CExpr
BS.CVar (Position -> Id
BS.idPercentAt Position
BS.NoPos))
                       [CExpr
incIndex, CExpr
buffLength])
          where
            buffLength :: CExpr
buffLength = Literal -> CExpr
cLit (Literal -> CExpr) -> Literal -> CExpr
forall a b. (a -> b) -> a -> b
$ IntLit -> Literal
BS.LInt (IntLit -> Literal) -> IntLit -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> IntLit
BS.ilDec (Integer -> IntLit) -> Integer -> IntLit
forall a b. (a -> b) -> a -> b
$ Id -> Integer
forall a. Integral a => a -> Integer
toInteger (Id -> Integer) -> Id -> Integer
forall a b. (a -> b) -> a -> b
$ [a] -> Id
forall a. [a] -> Id
forall (t :: * -> *) a. Foldable t => t a -> Id
length [a]
buff
            incIndex :: CExpr
incIndex   = CExpr -> [CExpr] -> CExpr
BS.CApply (Id -> CExpr
BS.CVar Id
BS.idPlus)
                           [ Id -> CExpr
BS.CVar Id
indexId
                           , Literal -> CExpr
cLit (Literal -> CExpr) -> Literal -> CExpr
forall a b. (a -> b) -> a -> b
$ IntLit -> Literal
BS.LInt (IntLit -> Literal) -> IntLit -> Literal
forall a b. (a -> b) -> a -> b
$ Integer -> IntLit
BS.ilDec Integer
1
                           ]

        buffId :: Id
buffId  = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ Id -> String
streamName Id
sId
        genId :: Id
genId   = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ Id -> String
generatorName Id
sId
        indexId :: Id
indexId = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ Id -> String
indexName Id
sId

-- | Write a struct declaration based on its definition.
mkStructDecln :: Struct a => a -> BS.CDefn
mkStructDecln :: forall a. Struct a => a -> CDefn
mkStructDecln a
x =
    Bool
-> StructSubType
-> IdK
-> [Id]
-> [CField]
-> [CTypeclass]
-> CDefn
BS.Cstruct
      Bool
True
      StructSubType
BS.SStruct
      (Id -> IdK
BS.IdK Id
structId)
      [] -- No type variables
      [CField]
structFields
      -- Derive a Bits instance so that we can put this struct in a Reg
      [Id -> CTypeclass
BS.CTypeclass Id
BS.idBits]
  where
    structId :: Id
structId     = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ String -> String
uppercaseName (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Struct a => a -> String
typeName a
x
    structFields :: [CField]
structFields = (Value a -> CField) -> [Value a] -> [CField]
forall a b. (a -> b) -> [a] -> [b]
map Value a -> CField
forall a. Value a -> CField
mkStructField ([Value a] -> [CField]) -> [Value a] -> [CField]
forall a b. (a -> b) -> a -> b
$ a -> [Value a]
forall a. Struct a => a -> [Value a]
toValues a
x

    mkStructField :: Value a -> BS.CField
    mkStructField :: forall a. Value a -> CField
mkStructField (Value Type t
ty Field s t
field) =
      String -> [IfcPragma] -> CType -> CField
mkField (Field s t -> String
forall (s :: Symbol) t. KnownSymbol s => Field s t -> String
fieldName Field s t
field) [] (Type t -> CType
forall a. Type a -> CType
transType Type t
ty)

-- | Write a field of a struct or interface, along with its pragmas and type
-- signature.
mkField :: String -> [BS.IfcPragma] -> BS.CType -> BS.CField
mkField :: String -> [IfcPragma] -> CType -> CField
mkField String
name [IfcPragma]
pragmas CType
ty =
  BS.CField
    { cf_name :: Id
BS.cf_name = Position -> FString -> Id
BS.mkId Position
BS.NoPos (FString -> Id) -> FString -> Id
forall a b. (a -> b) -> a -> b
$ String -> FString
forall a. IsString a => String -> a
fromString (String -> FString) -> String -> FString
forall a b. (a -> b) -> a -> b
$ String -> String
lowercaseName String
name
    , cf_pragmas :: Maybe [IfcPragma]
BS.cf_pragmas = [IfcPragma] -> Maybe [IfcPragma]
forall a. a -> Maybe a
Just [IfcPragma]
pragmas
    , cf_type :: CQType
BS.cf_type = [CPred] -> CType -> CQType
BS.CQType [] CType
ty
    , cf_default :: [CClause]
BS.cf_default = []
    , cf_orig_type :: Maybe CType
BS.cf_orig_type = Maybe CType
forall a. Maybe a
Nothing
    }

-- | The @Reg@ Bluespec interface type.
tReg :: BS.CType
tReg :: CType
tReg = TyCon -> CType
BS.TCon (TyCon -> CType) -> TyCon -> CType
forall a b. (a -> b) -> a -> b
$
  BS.TyCon
    { tcon_name :: Id
BS.tcon_name = Id
BS.idReg
    , tcon_kind :: Maybe Kind
BS.tcon_kind = Kind -> Maybe Kind
forall a. a -> Maybe a
Just (Kind -> Kind -> Kind
BS.Kfun Kind
BS.KStar Kind
BS.KStar)
    , tcon_sort :: TISort
BS.tcon_sort = StructSubType -> [Id] -> TISort
BS.TIstruct ([IfcPragma] -> StructSubType
BS.SInterface [])
                                 [Position -> Id
BS.id_write Position
BS.NoPos, Position -> Id
BS.id_read Position
BS.NoPos]
    }

-- | The @Wire@ Bluespec type.
tWire :: BS.CType
tWire :: CType
tWire = TyCon -> CType
BS.TCon (TyCon -> CType) -> TyCon -> CType
forall a b. (a -> b) -> a -> b
$
  BS.TyCon
    { tcon_name :: Id
BS.tcon_name = Position -> FString -> Id
BS.mkId Position
BS.NoPos FString
"Wire"
    , tcon_kind :: Maybe Kind
BS.tcon_kind = Kind -> Maybe Kind
forall a. a -> Maybe a
Just (Kind -> Kind -> Kind
BS.Kfun Kind
BS.KStar Kind
BS.KStar)
    , tcon_sort :: TISort
BS.tcon_sort = Integer -> CType -> TISort
BS.TItype Integer
0 CType
tReg
    }