{-# 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

    -- * Monitor processing
  , mkStepRule
  , mkTriggerRule

    -- * Module interface specifications
  , mkSpecIfcFields
  ) 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 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 :: [Trigger] -> [External] -> [BS.CField]
mkSpecIfcFields :: [Trigger] -> [External] -> [CField]
mkSpecIfcFields [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 :: args_1 -> ... -> args_n -> Action
    mkTriggerField :: Trigger -> BS.CField
    mkTriggerField :: Trigger -> CField
mkTriggerField (Trigger String
name Expr Bool
_ [UExpr]
args) =
      String -> CType -> CField
mkField String
name (CType -> CField) -> CType -> CField
forall a b. (a -> b) -> a -> b
$
      (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 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)
        CType
BS.tAction
        [UExpr]
args

    -- ext :: Reg ty
    mkExtField :: External -> BS.CField
    mkExtField :: External -> CField
mkExtField (External String
name Type a
ty) =
      String -> CType -> CField
mkField String
name (CType -> CField) -> CType -> CField
forall a b. (a -> b) -> a -> b
$ CType
tReg CType -> CType -> CType
`BS.TAp` Type a -> CType
forall a. Type a -> CType
transType Type a
ty

-- | Define a rule for a trigger function.
mkTriggerRule :: UniqueTrigger -> BS.CRule
mkTriggerRule :: UniqueTrigger -> CRule
mkTriggerRule (UniqueTrigger String
uniqueName (Trigger String
name Expr Bool
_ [UExpr]
args)) =
    [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
$
        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
$ String -> String
guardName String
uniqueName
      ]
      (CExpr -> [CExpr] -> CExpr
BS.CApply CExpr
nameExpr [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
    -- Note that we use 'name' here instead of 'uniqueName', as 'name' is the
    -- name of the actual external function.
    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
    nameExpr :: CExpr
nameExpr = CExpr -> Id -> CExpr
BS.CSelect (Id -> CExpr
BS.CVar Id
ifcArgId) Id
nameId

    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 = Id -> CExpr
BS.CVar (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 -> 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 type.
mkField :: String -> BS.CType -> BS.CField
mkField :: String -> CType -> CField
mkField String
name 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 = Maybe [IfcPragma]
forall a. Maybe a
Nothing
    , 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]
    }