copilot-bluespec 4.5.1 → 4.6
raw patch · 7 files changed
+368/−162 lines, 7 filesdep ~copilot-corePVP ok
version bump matches the API change (PVP)
Dependency ranges changed: copilot-core
API changes (from Hackage documentation)
Files
- CHANGELOG +4/−0
- copilot-bluespec.cabal +3/−3
- src/Copilot/Compile/Bluespec/CodeGen.hs +130/−25
- src/Copilot/Compile/Bluespec/Compile.hs +188/−101
- src/Copilot/Compile/Bluespec/Expr.hs +1/−4
- src/Copilot/Compile/Bluespec/Name.hs +23/−3
- tests/Test/Copilot/Compile/Bluespec.hs +19/−26
CHANGELOG view
@@ -1,3 +1,7 @@+2025-11-07+ * Version bump (4.6). (#679)+ * Flip direction of interface inputs and outputs in Bluespec. (#677)+ 2025-09-07 * Version bump (4.5.1). (#666)
copilot-bluespec.cabal view
@@ -1,6 +1,6 @@ cabal-version : >= 1.10 name : copilot-bluespec-version : 4.5.1+version : 4.6 synopsis : A compiler for Copilot targeting FPGAs. description : This package is a back-end from Copilot to FPGAs in Bluespec.@@ -44,8 +44,8 @@ , filepath >= 1.4 && < 1.6 , pretty >= 1.1.2 && < 1.2 - , copilot-core >= 4.5.1 && < 4.6- , language-bluespec >= 0.1 && < 0.2+ , copilot-core >= 4.6 && < 4.7+ , language-bluespec >= 0.1 && < 0.2 exposed-modules : Copilot.Compile.Bluespec
src/Copilot/Compile/Bluespec/CodeGen.hs view
@@ -14,12 +14,17 @@ -- * Stream generators , mkGenFun + -- * External streams+ , mkExtWireDecln+ -- * Monitor processing , mkStepRule+ , mkExtRule , mkTriggerRule -- * Module interface specifications , mkSpecIfcFields+ , mkSpecIfcRulesFields ) where -- External imports@@ -48,8 +53,18 @@ [] where nameId = BS.mkId BS.NoPos $ fromString $ lowercaseName name- def = BS.CClause [] [] (transExpr expr)+ def = BS.CClause [] [] (transExpr expr) +-- | Bind a @Wire@ variable using @mkBypassWire@.+mkExtWireDecln :: String -> Type a -> BS.CStmt+mkExtWireDecln name ty =+ BS.CSBindT+ (BS.CPVar (BS.mkId BS.NoPos (fromString (wireName name))))+ Nothing+ []+ (BS.CQType [] (tWire `BS.TAp` transType ty))+ (BS.CVar (BS.mkId BS.NoPos "mkBypassWire"))+ -- | Bind a buffer variable and initialise it with the stream buffer. mkBuffDecln :: forall a. Id -> Type a -> [a] -> [BS.CStmt] mkBuffDecln sId ty xs =@@ -133,44 +148,124 @@ -- | Define fields for a module interface containing a specification's trigger -- functions and external variables.-mkSpecIfcFields :: [Trigger] -> [External] -> [BS.CField]-mkSpecIfcFields triggers exts =+mkSpecIfcFields :: [UniqueTrigger] -> [External] -> [BS.CField]+mkSpecIfcFields uniqueTriggers exts =+ concatMap mkTriggerFields uniqueTriggers ++ map mkExtField exts+ where+ -- trigger_guard :: Bool+ -- trigger_arg0 :: arg_ty_0+ -- ...+ -- trigger_arg(n-1) :: arg_ty_(n-1)+ mkTriggerFields :: UniqueTrigger -> [BS.CField]+ mkTriggerFields (UniqueTrigger uniqueName (Trigger _name _ args)) =+ triggerGuardField : triggerArgFields+ where+ triggerGuardField :: BS.CField+ triggerGuardField = mkField (guardName uniqueName) [] BS.tBool++ triggerArgFields :: [BS.CField]+ triggerArgFields =+ zipWith+ (\(UExpr arg _) argName -> mkField argName [] (transType arg))+ args+ (argNames uniqueName)++ -- ext :: ty -> Action+ mkExtField :: External -> BS.CField+ mkExtField (External name ty) =+ mkField+ name+ [ BS.PIPrefixStr ""+ , BS.PIArgNames [BS.mkId BS.NoPos $ fromString $ lowercaseName name]+ ]+ (BS.tArrow `BS.TAp` transType ty `BS.TAp` 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 triggers exts = map mkTriggerField triggers ++ map mkExtField exts where- -- trigger :: args_1 -> ... -> args_n -> Action+ -- trigger_action :: arg_ty_0 -> ... -> arg_ty_(n-1) -> Action mkTriggerField :: Trigger -> BS.CField mkTriggerField (Trigger name _ args) =- mkField name $- foldr- (\(UExpr arg _) res -> BS.tArrow `BS.TAp` transType arg `BS.TAp` res)- BS.tAction- args+ mkField (actionName name) [] triggerFieldType+ where+ triggerFieldType :: BS.CType+ triggerFieldType = foldr addArgType BS.tAction args - -- ext :: Reg ty+ addArgType :: UExpr -> BS.CType -> BS.CType+ addArgType (UExpr arg _) res =+ BS.tArrow `BS.TAp` transType arg `BS.TAp` res++ -- ext_action :: ActionValue ty mkExtField :: External -> BS.CField mkExtField (External name ty) =- mkField name $ tReg `BS.TAp` transType ty+ mkField (actionName name) [] (BS.tActionValue `BS.TAp` transType ty) --- | Define a rule for a trigger function.+-- | 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 name _) =+ -- rules+ -- "ext": when True ==>+ -- action+ -- extVal <- ifcRules.ext_action+ -- ifc.ext extVal+ BS.CRule+ []+ (Just $ cLit $ BS.LString name)+ [BS.CQFilter $ BS.CCon BS.idTrue []]+ (BS.Caction BS.NoPos [callExtAction, callExt])+ where+ ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName+ ifcRulesArgId = BS.mkId BS.NoPos $ fromString ifcRulesArgName++ extActionId = BS.mkId BS.NoPos $ fromString $ actionName name+ extId = BS.mkId BS.NoPos $ fromString name+ extValId = BS.mkId BS.NoPos $ fromString $ name ++ "Val"++ -- extVal <- ifcRules.ext_action+ callExtAction :: BS.CStmt+ callExtAction =+ BS.CSBind+ (BS.CPVar extValId)+ Nothing+ []+ (BS.CSelect (BS.CVar ifcRulesArgId) extActionId)++ -- ifc.ext extVal+ callExt :: BS.CStmt+ callExt =+ BS.CSExpr Nothing $+ BS.CApply (BS.CSelect (BS.CVar ifcArgId) extId) [BS.CVar extValId]++-- | Define a rule for a trigger function that performs an action when the rule+-- fires. mkTriggerRule :: UniqueTrigger -> BS.CRule mkTriggerRule (UniqueTrigger uniqueName (Trigger name _ args)) =+ -- rules+ -- "trigger": when ifc.trigger_guard ==>+ -- ifcRules.trigger_action ifc.trigger_arg0 BS.CRule [] (Just $ cLit $ BS.LString uniqueName) [ BS.CQFilter $- BS.CVar $ BS.mkId BS.NoPos $- fromString $ guardName uniqueName+ BS.CSelect+ (BS.CVar ifcArgId)+ (BS.mkId BS.NoPos $ fromString $ guardName uniqueName) ]- (BS.CApply nameExpr args')+ (BS.CApply actionNameExpr args') where- ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName+ ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName+ ifcRulesArgId = BS.mkId BS.NoPos $ fromString ifcRulesArgName -- Note that we use 'name' here instead of 'uniqueName', as 'name' is the -- name of the actual external function.- nameId = BS.mkId BS.NoPos $ fromString $ lowercaseName name- nameExpr = BS.CSelect (BS.CVar ifcArgId) nameId+ actionNameId = BS.mkId BS.NoPos $ fromString $ actionName name+ actionNameExpr = BS.CSelect (BS.CVar ifcRulesArgId) actionNameId args' = take (length args) (map argCall (argNames uniqueName))- argCall = BS.CVar . BS.mkId BS.NoPos . fromString+ argCall = BS.CSelect (BS.CVar ifcArgId) . BS.mkId BS.NoPos . fromString -- | Writes the @step@ rule that updates all streams. mkStepRule :: [Stream] -> Maybe BS.CRule@@ -233,19 +328,20 @@ -- Derive a Bits instance so that we can put this struct in a Reg [BS.CTypeclass BS.idBits] where- structId = BS.mkId BS.NoPos $ fromString $ uppercaseName $ typeName x+ structId = BS.mkId BS.NoPos $ fromString $ uppercaseName $ typeName x structFields = map mkStructField $ toValues x mkStructField :: Value a -> BS.CField mkStructField (Value ty field) =- mkField (fieldName field) (transType ty)+ mkField (fieldName field) [] (transType ty) --- | Write a field of a struct or interface, along with its type.-mkField :: String -> BS.CType -> BS.CField-mkField name 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 name pragmas ty = BS.CField { BS.cf_name = BS.mkId BS.NoPos $ fromString $ lowercaseName name- , BS.cf_pragmas = Nothing+ , BS.cf_pragmas = Just pragmas , BS.cf_type = BS.CQType [] ty , BS.cf_default = [] , BS.cf_orig_type = Nothing@@ -259,4 +355,13 @@ , BS.tcon_kind = Just (BS.Kfun BS.KStar BS.KStar) , BS.tcon_sort = BS.TIstruct (BS.SInterface []) [BS.id_write BS.NoPos, BS.id_read BS.NoPos]+ }++-- | The @Wire@ Bluespec type.+tWire :: BS.CType+tWire = BS.TCon $+ BS.TyCon+ { BS.tcon_name = BS.mkId BS.NoPos "Wire"+ , BS.tcon_kind = Just (BS.Kfun BS.KStar BS.KStar)+ , BS.tcon_sort = BS.TItype 0 tReg }
src/Copilot/Compile/Bluespec/Compile.hs view
@@ -57,13 +57,11 @@ | otherwise = do let typesBsFile = render $ pPrint $ compileTypesBS bsSettings prefix spec- ifcBsFile = render $ pPrint $ compileIfcBS bsSettings prefix spec bsFile = render $ pPrint $ compileBS bsSettings prefix spec let dir = bluespecSettingsOutputDirectory bsSettings createDirectoryIfMissing True dir writeFile (dir </> specTypesPkgName prefix ++ ".bs") typesBsFile- writeFile (dir </> specIfcPkgName prefix ++ ".bs") ifcBsFile writeFile (dir </> "bs_fp.c") copilotBluespecFloatingPointC writeFile (dir </> "BluespecFP.bsv") copilotBluespecFloatingPointBSV writeFile (dir </> prefix ++ ".bs") bsFile@@ -93,32 +91,8 @@ compile = compileWith mkDefaultBluespecSettings -- | Generate a @<prefix>.bs@ file from a 'Spec'. This is the main payload of--- the Bluespec backend.------ The generated Bluespec file will import a handful of files from the standard--- library, as well as the following generated files:------ * @<prefix>Ifc.bs@, which defines the interface containing the trigger--- functions and external variables.------ * @<prefix>Types.bs@, which defines any structs used in the 'Spec'.------ It will also generate a @mk<prefix> :: Module <prefix>Ifc -> Module Empty@--- function, which defines the module structure for this 'Spec'. The--- @mk<prefix>@ function has the following structure:------ * First, bind the argument of type @Module <prefix>Ifc@ so that trigger--- functions can be invoked and external variables can be used.------ * Next, declare stream buffers and indices.------ * Next, declare generator functions for streams, accessor functions for--- streams, and guard functions for triggers.------ * Next, declare rules for each trigger function.------ * Finally, declare a single rule that updates the stream buffers and--- indices.+-- the Bluespec backend. See the @copilot-bluespec/DESIGN.md@ document for a+-- high-level description of what this file contains. compileBS :: BluespecSettings -> String -> Spec -> BS.CPackage compileBS _bsSettings prefix spec = BS.CPackage@@ -126,53 +100,157 @@ (Right []) (stdLibImports ++ genImports) []- [moduleDef]+ [ ifcDef+ , mkModuleDefPragma+ , mkModuleDef+ , ifcRulesDef+ , mkModuleRulesDef+ , addModuleRulesDef+ ] [] where -- import <prefix>Types- -- import <prefix>Ifc genImports :: [BS.CImport] genImports = [ BS.CImpId False $ BS.mkId BS.NoPos $ fromString $ specTypesPkgName prefix- , BS.CImpId False $ BS.mkId BS.NoPos $ fromString- $ specIfcPkgName prefix , BS.CImpId False $ BS.mkId BS.NoPos "BluespecFP" ] - moduleDef :: BS.CDefn- moduleDef = BS.CValueSign $+ -- interface <prefix>Ifc {-# always_ready, always_enabled #-} =+ -- ...+ ifcDef :: BS.CDefn+ ifcDef = BS.Cstruct+ True+ (BS.SInterface [BS.PIAlwaysRdy, BS.PIAlwaysEnabled])+ (BS.IdK ifcId)+ [] -- No type variables+ ifcFields+ [] -- No derived instances++ -- {-# properties mkFibs = { verilog } #-}+ mkModuleDefPragma :: BS.CDefn+ mkModuleDefPragma = BS.CPragma $ BS.Pproperties mkModuleDefId [BS.PPverilog]++ -- mk<prefix> :: Module <prefix>Ifc+ -- mk<prefix> =+ -- module+ -- ...+ mkModuleDef :: BS.CDefn+ mkModuleDef = BS.CValueSign $ BS.CDef- (BS.mkId BS.NoPos $ fromString $ "mk" ++ prefix)- -- :: Module <prefix>Ifc -> Module Empty- (BS.CQType- []- (BS.tArrow- `BS.TAp` (BS.tModule `BS.TAp` ifcTy)- `BS.TAp` (BS.tModule `BS.TAp` emptyTy)))- [ BS.CClause [BS.CPVar ifcModId] [] $- BS.Cmodule BS.NoPos $- BS.CMStmt- (BS.CSBind (BS.CPVar ifcArgId) Nothing [] (BS.CVar ifcModId))- : map BS.CMStmt mkGlobals ++- [ BS.CMStmt $ BS.CSletrec genFuns- , BS.CMrules $ BS.Crules [] rules- ]+ mkModuleDefId+ (BS.CQType [] (BS.tModule `BS.TAp` ifcTy))+ [ BS.CClause [] [] $+ BS.Cmodule BS.NoPos $+ wireGlobalStmts ++ genFunStmts ++ ruleIfcStmts ]+ where+ wireGlobalStmts :: [BS.CMStmt]+ wireGlobalStmts = map BS.CMStmt (mkExtWires ++ mkGlobals) - ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName- ifcModId = BS.mkId BS.NoPos "ifcMod"+ genFunStmts :: [BS.CMStmt]+ genFunStmts =+ -- language-bluespec's pretty-printer will error if it encounters a+ -- CSletrec with an empty list of definitions, so avoid generating a+ -- CSletrec if there are no streams.+ [ BS.CMStmt $ BS.CSletrec genFuns | not (null genFuns) ] - rules :: [BS.CRule]- rules = map mkTriggerRule uniqueTriggers ++ maybeToList (mkStepRule streams)+ ruleIfcStmts :: [BS.CMStmt]+ ruleIfcStmts =+ [ BS.CMrules $ BS.Crules [] $ maybeToList $ mkStepRule streams+ , BS.CMinterface $ BS.Cinterface BS.NoPos (Just ifcId) ifcMethodImpls+ ] + -- interface <prefix>RulesIfc =+ -- ...+ ifcRulesDef :: BS.CDefn+ ifcRulesDef =+ BS.Cstruct+ True+ (BS.SInterface [])+ (BS.IdK ifcRulesId)+ [] -- No type variables+ ifcRulesFields+ [] -- No derived instances++ -- mk<prefix>Rules :: <prefix>Ifc -> <prefix>RulesIfc -> Rules+ -- mk<prefix>Rules ifc ifcRules =+ -- rules+ -- ...+ mkModuleRulesDef :: BS.CDefn+ mkModuleRulesDef =+ BS.CValueSign $+ BS.CDef+ mkModuleRulesDefId+ (BS.CQType [] mkModuleRulesType)+ [ BS.CClause+ (map BS.CPVar [ifcArgId, ifcRulesArgId])+ []+ (BS.Crules [] moduleRules)+ ]+ where+ -- <prefix>Ifc -> <prefix>RulesIfc -> Rules+ mkModuleRulesType :: BS.CType+ mkModuleRulesType =+ BS.tArrow `BS.TAp` ifcTy `BS.TAp`+ (BS.tArrow `BS.TAp` ifcRulesTy `BS.TAp` BS.tRules)++ -- rules+ -- ...+ moduleRules :: [BS.CRule]+ moduleRules = map mkTriggerRule uniqueTriggers ++ map mkExtRule exts++ -- add<prefix>Rules :: <prefix>Ifc -> <prefix>RulesIfc -> Module Empty+ -- add<prefix>Rules ifc ifcRules = addRules (mk<prefix>Rules ifc ifcRules)+ addModuleRulesDef :: BS.CDefn+ addModuleRulesDef =+ BS.CValueSign $+ BS.CDef+ addModuleRulesDefId+ (BS.CQType [] addModuleRulesType)+ [ BS.CClause+ (map BS.CPVar [ifcArgId, ifcRulesArgId])+ []+ addModuleRulesExpr+ ]+ where+ -- <prefix>Ifc -> <prefix>RulesIfc -> Module Empty+ addModuleRulesType :: BS.CType+ addModuleRulesType =+ BS.tArrow `BS.TAp` ifcTy `BS.TAp`+ (BS.tArrow `BS.TAp` ifcRulesTy `BS.TAp`+ (BS.tModule `BS.TAp` emptyTy))++ -- addRules (mk<prefix>Rules ifc ifcRules)+ addModuleRulesExpr :: BS.CExpr+ addModuleRulesExpr =+ BS.CApply+ (BS.CVar (BS.idAddRules BS.NoPos))+ [BS.CApply+ (BS.CVar mkModuleRulesDefId)+ (map BS.CVar [ifcArgId, ifcRulesArgId])]++ mkModuleDefId =+ BS.mkId BS.NoPos $ fromString $ "mk" ++ prefix+ mkModuleRulesDefId =+ BS.mkId BS.NoPos $ fromString $ "mk" ++ prefix ++ "Rules"+ addModuleRulesDefId =+ BS.mkId BS.NoPos $ fromString $ "add" ++ prefix ++ "Rules"+ streams = specStreams spec triggers = specTriggers spec uniqueTriggers = mkUniqueTriggers triggers exts = gatherExts streams triggers + -- Remove duplicates due to multiple guards for the same trigger.+ triggersNoDups = nubBy compareTrigger triggers++ ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName+ ifcRulesArgId = BS.mkId BS.NoPos $ fromString ifcRulesArgName+ ifcId = BS.mkId BS.NoPos $ fromString $ specIfcName prefix- ifcFields = mkSpecIfcFields triggers exts+ ifcFields = mkSpecIfcFields uniqueTriggers exts ifcTy = BS.TCon (BS.TyCon { BS.tcon_name = ifcId , BS.tcon_kind = Just BS.KStar@@ -181,12 +259,31 @@ (map BS.cf_name ifcFields) }) + ifcRulesId = BS.mkId BS.NoPos $ fromString $ specIfcRulesName prefix+ ifcRulesFields = mkSpecIfcRulesFields triggersNoDups exts++ ifcRulesTy =+ BS.TCon $+ BS.TyCon+ { BS.tcon_name = ifcRulesId+ , BS.tcon_kind = Just BS.KStar+ , BS.tcon_sort =+ BS.TIstruct (BS.SInterface []) (map BS.cf_name ifcRulesFields)+ }+ emptyTy = BS.TCon (BS.TyCon { BS.tcon_name = BS.idEmpty , BS.tcon_kind = Just BS.KStar , BS.tcon_sort = BS.TIstruct (BS.SInterface []) [] }) + -- Bind @Wire@ variables for each extern stream.+ mkExtWires :: [BS.CStmt]+ mkExtWires = map extWireStmt exts+ where+ extWireStmt :: External -> BS.CStmt+ extWireStmt (External name ty) = mkExtWireDecln name ty+ -- Make buffer and index declarations for streams. mkGlobals :: [BS.CStmt] mkGlobals = concatMap buffDecln streams ++ map indexDecln streams@@ -194,11 +291,9 @@ buffDecln (Stream sId buff _ ty) = mkBuffDecln sId ty buff indexDecln (Stream sId _ _ _ ) = mkIndexDecln sId - -- Make generator functions, including trigger arguments.+ -- Make generator functions for streams. genFuns :: [BS.CDefl]- genFuns = map accessDecln streams- ++ map streamGen streams- ++ concatMap triggerGen uniqueTriggers+ genFuns = map accessDecln streams ++ map streamGen streams where accessDecln :: Stream -> BS.CDefl accessDecln (Stream sId buff _ ty) = mkAccessDecln sId ty buff@@ -206,55 +301,47 @@ streamGen :: Stream -> BS.CDefl streamGen (Stream sId _ expr ty) = mkGenFun (generatorName sId) expr ty - triggerGen :: UniqueTrigger -> [BS.CDefl]- triggerGen (UniqueTrigger uniqueName (Trigger _name guard args)) =- guardDef : argDefs+ -- Make interface methods for @<prefix>Ifc@.+ ifcMethodImpls :: [BS.CDefl]+ ifcMethodImpls =+ concatMap triggerMethodImpls uniqueTriggers+ ++ map extMethodImpl exts+ where+ -- interface+ -- ext val = ext_wire := val+ extMethodImpl :: External -> BS.CDefl+ extMethodImpl (External name _) =+ BS.CLValue extMethodId [extMethodClause] [] where+ extMethodId = BS.mkId BS.NoPos (fromString name)+ valId = BS.mkId BS.NoPos "val"++ -- ext val = ext_wire := val+ extMethodClause :: BS.CClause+ extMethodClause =+ BS.CClause+ [BS.CPVar valId]+ []+ (BS.Cwrite+ BS.NoPos+ (BS.CVar (BS.mkId BS.NoPos (fromString (wireName name))))+ (BS.CVar valId))++ -- interface+ -- trig_guard = ...+ -- trig_arg0 = ...+ -- ...+ -- trig_arg(n-1) = ...+ triggerMethodImpls :: UniqueTrigger -> [BS.CDefl]+ triggerMethodImpls uniqueTrigger = guardDef : argDefs+ where+ UniqueTrigger uniqueName (Trigger _name guard args) = uniqueTrigger+ guardDef = mkGenFun (guardName uniqueName) guard Bool argDefs = map argGen (zip (argNames uniqueName) args) argGen :: (String, UExpr) -> BS.CDefl argGen (argName, UExpr ty expr) = mkGenFun argName expr ty---- | Generate a @<prefix>Ifc.bs@ file from a 'Spec'. This contains the--- definition of the @<prefix>Ifc@ interface, which declares the types of all--- trigger functions and external variables. This is put in a separate file so--- that larger applications can use it separately.-compileIfcBS :: BluespecSettings -> String -> Spec -> BS.CPackage-compileIfcBS _bsSettings prefix spec =- BS.CPackage- ifcPkgId- (Right [])- (stdLibImports ++ genImports)- []- [ifcDef]- []- where- -- import <prefix>Types- genImports :: [BS.CImport]- genImports =- [ BS.CImpId False $ BS.mkId BS.NoPos $ fromString- $ specTypesPkgName prefix- ]-- ifcId = BS.mkId BS.NoPos $ fromString $ specIfcName prefix- ifcPkgId = BS.mkId BS.NoPos $ fromString $ specIfcPkgName prefix- ifcFields = mkSpecIfcFields triggers exts-- streams = specStreams spec- exts = gatherExts streams triggers-- -- Remove duplicates due to multiple guards for the same trigger.- triggers = nubBy compareTrigger (specTriggers spec)-- ifcDef :: BS.CDefn- ifcDef = BS.Cstruct- True- (BS.SInterface [])- (BS.IdK ifcId)- [] -- No type variables- ifcFields- [] -- No derived instances -- | Generate a @<prefix>Types.bs@ file from a 'Spec'. This declares the types -- of any structs used by the Copilot specification. This is put in a separate
src/Copilot/Compile/Bluespec/Expr.hs view
@@ -51,11 +51,8 @@ [BS.CLit $ BS.CLiteral BS.NoPos index] transExpr (ExternVar _ name _) =- let ifcArgId = BS.mkId BS.NoPos $ fromString ifcArgName in BS.CSelect- (BS.CSelect- (BS.CVar ifcArgId)- (BS.mkId BS.NoPos $ fromString $ lowercaseName name))+ (BS.CVar $ BS.mkId BS.NoPos $ fromString $ wireName name) (BS.id_read BS.NoPos) transExpr (Label _ _ e) = transExpr e -- ignore label
src/Copilot/Compile/Bluespec/Name.hs view
@@ -1,18 +1,22 @@ -- | Naming of variables and functions in Bluespec. module Copilot.Compile.Bluespec.Name- ( argNames+ ( actionName+ , argNames , generatorName , guardName , ifcArgName+ , ifcRulesArgName , indexName , lowercaseName , specIfcName , specIfcPkgName+ , specIfcRulesName , specTypesPkgName , streamAccessorName , streamElemName , streamName , uppercaseName+ , wireName ) where -- External imports@@ -32,6 +36,10 @@ specIfcPkgName :: String -> String specIfcPkgName prefix = prefix ++ "Ifc" +-- | Turn a specification name into the name of its rules-specific interface.+specIfcRulesName :: String -> String+specIfcRulesName prefix = uppercaseName (prefix ++ "RulesIfc")+ -- | Turn a specification name into the name of the package that declares its -- struct types. specTypesPkgName :: String -> String@@ -41,11 +49,14 @@ streamElemName :: Id -> Int -> String streamElemName sId n = streamName sId ++ "_" ++ show n --- | The name of the variable of type @<prefix>Ifc@. This is used to select--- trigger functions and external variables.+-- | The name of a variable of type @<prefix>Ifc@. ifcArgName :: String ifcArgName = "ifc" +-- | The name of a variable of type @<prefix>RulesIfc@.+ifcRulesArgName :: String+ifcRulesArgName = "ifcRules"+ -- | Create a Bluespec name that must start with an uppercase letter (e.g., a -- struct or interface name). If the supplied name already begins with an -- uppercase letter, this function returns the name unchanged. Otherwise, this@@ -85,6 +96,15 @@ -- | Turn the name of a trigger into a guard generator. guardName :: String -> String guardName name = lowercaseName name ++ "_guard"++-- | Turn the name of a trigger of external stream into the name of a method+-- that performs a Bluespec @Action@.+actionName :: String -> String+actionName name = lowercaseName name ++ "_action"++-- | Turn the name of an external stream into a Bluespec @Wire@.+wireName :: String -> String+wireName name = lowercaseName name ++ "_wire" -- | Turn a trigger name into a an trigger argument name. argName :: String -> Int -> String
tests/Test/Copilot/Compile/Bluespec.hs view
@@ -157,18 +157,15 @@ [ "package Top where" , "" , "import CopilotTest"- , "import CopilotTestIfc" , "import CopilotTestTypes" , ""- , "copilotTestIfc :: Module CopilotTestIfc"- , "copilotTestIfc ="- , " module"- , " interface"- , " nop :: Action"- , " nop = return ()"- , "" , "mkTop :: Module Empty"- , "mkTop = mkCopilotTest copilotTestIfc"+ , "mkTop ="+ , " module"+ , " copilotTestMod <- mkCopilotTest"+ , " addCopilotTestRules copilotTestMod $"+ , " interface CopilotTestRulesIfc"+ , " nop_action = return ()" ] writeFile "Top.bs" bluespecProgram@@ -293,7 +290,7 @@ t1 = typeOf t2 = typeOf - varName = "input"+ varName = "input1" -- | Test the behavior of a binary operation (an @'Op2' a b c@ value) against -- its expected behavior (as a Haskell function of type @[a] -> [b] -> [c]@)@@ -762,7 +759,7 @@ t1 = typeOf t2 = typeOf - varName = "input"+ varName = "input1" -- | Generate test cases for expressions that behave like binary functions. mkTestCase2 :: (Typed a, Typed b, Typed c)@@ -1016,24 +1013,25 @@ , "import Vector" , "" , "import CopilotTest"- , "import CopilotTestIfc" , "import CopilotTestTypes" , "" ] ++ inputVecDecls ++ [ ""- , "copilotTestIfc :: Module CopilotTestIfc"- , "copilotTestIfc ="+ , "mkTop :: Module Empty"+ , "mkTop =" , " module"+ , " copilotTestMod <- mkCopilotTest" ] ++ inputRegs ++ [ " i :: Reg (Bit 64) <- mkReg 0" , " ready :: Reg Bool <- mkReg False"- , " interface"- , " printBack :: " ++ outputType ++ " -> Action"- , " printBack output = $display " ++ printBackDisplayArgs- , " when ready" , ""+ , " addCopilotTestRules copilotTestMod $"+ , " interface CopilotTestRulesIfc"+ , " printBack_action :: " ++ outputType ++ " -> Action"+ , " printBack_action output = $display " ++ printBackDisplayArgs+ , " when ready" ] ++ inputMethods ++ [ ""@@ -1043,9 +1041,6 @@ ++ inputUpdates ++ [ " i := i + 1" , " ready := True"- , ""- , "mkTop :: Module Empty"- , "mkTop = mkCopilotTest copilotTestIfc" ] where printBackDisplayArgs :: String@@ -1070,11 +1065,9 @@ inputMethods :: [String] inputMethods =- concatMap- (\(bluespecType, varName, regName, _inputVecName, _inputVals) ->- [ " " ++ varName ++ " :: Reg (" ++ bluespecType ++ ")"- , " " ++ varName ++ " = " ++ regName- ])+ map+ (\(_bluespecType, varName, regName, _inputVecName, _inputVals) ->+ " " ++ varName ++ "_action = return " ++ regName) vars inputUpdates :: [String]