diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,10 @@ # Changelog for the [`clash-lib`](http://hackage.haskell.org/package/clash-lib) package +## 0.5.6 *June 3rd 2015* +* New features: + * Support Verilog backend + * Generated component names are prefixed by the name of the module containing the `topEntity` + ## 0.5.5 *May 18th 2015* * New features: * Make inlining and specialisation limit configurable diff --git a/clash-lib.cabal b/clash-lib.cabal --- a/clash-lib.cabal +++ b/clash-lib.cabal @@ -1,5 +1,5 @@ Name: clash-lib -Version: 0.5.5 +Version: 0.5.6 Synopsis: CAES Language for Synchronous Hardware - As a Library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that @@ -57,7 +57,7 @@ attoparsec >= 0.10.4.0, base >= 4.8 && < 5, bytestring >= 0.10.0.2, - clash-prelude >= 0.7.4, + clash-prelude >= 0.8, concurrent-supply >= 0.1.7, containers >= 0.5.0.0, deepseq >= 1.3.0.2, diff --git a/src/CLaSH/Backend.hs b/src/CLaSH/Backend.hs --- a/src/CLaSH/Backend.hs +++ b/src/CLaSH/Backend.hs @@ -25,9 +25,9 @@ extractTypes :: state -> HashSet HWType -- | Generate HDL for a Netlist component - genHDL :: Component -> State state (String, Doc) + genHDL :: String -> Component -> State state (String, Doc) -- | Generate a HDL package containing type definitions for the given HWTypes - mkTyPackage :: [HWType] -> State state Doc + mkTyPackage :: String -> [HWType] -> State state [(String, Doc)] -- | Convert a Netlist HWType to a target HDL type hdlType :: HWType -> State state Doc -- | Convert a Netlist HWType to an HDL error value for that type diff --git a/src/CLaSH/Driver.hs b/src/CLaSH/Driver.hs --- a/src/CLaSH/Driver.hs +++ b/src/CLaSH/Driver.hs @@ -81,9 +81,9 @@ let prepNormDiff = Clock.diffUTCTime normTime prepTime putStrLn $ "Normalisation took " ++ show prepNormDiff - (netlist,cmpCnt) <- genNetlist Nothing - transformedBindings - primMap tcm typeTrans Nothing (fst topEntity) + let modName = takeWhile (/= '.') (name2String $ fst topEntity) + (netlist,cmpCnt) <- genNetlist Nothing transformedBindings primMap tcm + typeTrans Nothing modName (fst topEntity) netlistTime <- netlist `deepseq` Clock.getCurrentTime let normNetDiff = Clock.diffUTCTime netlistTime normTime @@ -99,6 +99,7 @@ typeTrans tcm eval cmpCnt bindingsMap (listToMaybe $ map fst $ HashMap.toList testInputs) (listToMaybe $ map fst $ HashMap.toList expectedOutputs) + modName topComponent @@ -107,8 +108,8 @@ putStrLn $ "Testbench generation took " ++ show netTBDiff let hdlState' = fromMaybe (initBackend :: backend) hdlState - topWrapper = mkTopWrapper primMap teM topComponent - hdlDocs = createHDL hdlState' (topWrapper : netlist ++ testBench) + topWrapper = mkTopWrapper primMap teM modName topComponent + hdlDocs = createHDL hdlState' modName (topWrapper : netlist ++ testBench) dir = concat [ "./" ++ CLaSH.Backend.name hdlState' ++ "/" , takeWhile (/= '.') (name2String $ fst topEntity) , "/" @@ -126,14 +127,16 @@ -- | Pretty print Components to HDL Documents createHDL :: Backend backend => backend -- ^ Backend + -> String -> [Component] -- ^ List of components -> [(String,Doc)] -createHDL backend components = flip evalState backend $ do - (hdlNms,hdlDocs) <- unzip <$> mapM genHDL components - let hdlNmDocs = zip hdlNms hdlDocs +createHDL backend modName components = flip evalState backend $ do + -- (hdlNms,hdlDocs) <- unzip <$> mapM genHDL components + -- let hdlNmDocs = zip hdlNms hdlDocs + hdlNmDocs <- mapM (genHDL modName) components hwtys <- HashSet.toList <$> extractTypes <$> get - typesPkg <- mkTyPackage hwtys - return (("types",typesPkg):hdlNmDocs) + typesPkg <- mkTyPackage modName hwtys + return (typesPkg ++ hdlNmDocs) -- | Prepares the directory for writing HDL files. This means creating the -- dir if it does not exist and removing all existing .hdl files from it. diff --git a/src/CLaSH/Driver/TestbenchGen.hs b/src/CLaSH/Driver/TestbenchGen.hs --- a/src/CLaSH/Driver/TestbenchGen.hs +++ b/src/CLaSH/Driver/TestbenchGen.hs @@ -8,12 +8,13 @@ where import Control.Concurrent.Supply (Supply) +import Control.Lens ((.=)) import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap import Data.List (find,nub) -import Data.Maybe (mapMaybe) -import Data.Text.Lazy (isPrefixOf,pack,splitOn) -import Unbound.Generics.LocallyNameless (name2String) +import Data.Maybe (catMaybes,mapMaybe) +import Data.Text.Lazy (append,isPrefixOf,pack,splitOn) +import Unbound.Generics.LocallyNameless (name2String) import CLaSH.Core.Term import CLaSH.Core.TyCon @@ -22,8 +23,8 @@ import CLaSH.Driver.Types import CLaSH.Netlist +import CLaSH.Netlist.BlackBox (prepareBlackBox) import CLaSH.Netlist.BlackBox.Types (Element (Err)) -import CLaSH.Netlist.BlackBox.Util (parseFail) import CLaSH.Netlist.Types as N import CLaSH.Normalize (cleanupGraph, normalize, runNormalization) @@ -44,36 +45,46 @@ -> HashMap TmName (Type,Term) -- ^ Global binders -> Maybe TmName -- ^ Stimuli -> Maybe TmName -- ^ Expected output + -> String -- ^ Name of the module containing the @topEntity@ -> Component -- ^ Component to generate TB for -> IO ([Component]) -genTestBench opts supply primMap typeTrans tcm eval cmpCnt globals stimuliNmM expectedNmM +genTestBench opts supply primMap typeTrans tcm eval cmpCnt globals stimuliNmM expectedNmM modName (Component cName hidden [inp] [outp] _) = do let ioDecl = [ uncurry NetDecl inp , uncurry NetDecl outp ] inpExpr = Assignment (fst inp) (BlackBoxE "" [Err Nothing] (emptyBBContext {bbResult = (undefined,snd inp)}) False) (inpInst,inpComps,cmpCnt',hidden') <- maybe (return (inpExpr,[],cmpCnt,hidden)) - (genStimuli cmpCnt primMap globals typeTrans tcm normalizeSignal hidden inp) + (genStimuli cmpCnt primMap globals typeTrans tcm normalizeSignal hidden inp modName) stimuliNmM - let finDecl = [ NetDecl "finished" Bool - , genDone primMap - ] - finExpr = genFinish primMap - (expInst,expComps,hidden'') <- maybe (return (finExpr,[],hidden')) - (genVerifier cmpCnt' primMap globals typeTrans tcm normalizeSignal hidden' outp) + ((finDecl,finExpr),s) <- runNetlistMonad (Just cmpCnt') globals primMap tcm typeTrans modName $ do + done <- genDone primMap + let finDecl' = [ NetDecl "finished" Bool + , done + ] + finExpr' <- genFinish primMap + return (finDecl',finExpr') + + (expInst,expComps,cmpCnt'',hidden'') <- maybe (return (finExpr,[],cmpCnt',hidden')) + (genVerifier cmpCnt' primMap globals typeTrans tcm normalizeSignal hidden' outp modName) expectedNmM + let clkNms = mapMaybe (\hd -> case hd of (clkNm,Clock _ _) -> Just clkNm ; _ -> Nothing) hidden rstNms = mapMaybe (\hd -> case hd of (clkNm,Reset _ _) -> Just clkNm ; _ -> Nothing) hidden - clks = mapMaybe (genClock primMap) hidden'' - rsts = mapMaybe (genReset primMap) hidden'' + ((clks,rsts),_) <- runNetlistMonad (Just cmpCnt'') globals primMap tcm typeTrans modName $ do + varCount .= (_varCount s) + clks' <- catMaybes <$> mapM (genClock primMap) hidden'' + rsts' <- catMaybes <$> mapM (genReset primMap) hidden'' + return (clks',rsts') + let instDecl = InstDecl cName "totest" (map (\i -> (i,Identifier i Nothing)) (concat [ clkNms, rstNms, [fst inp], [fst outp] ]) ) - tbComp = Component "testbench" [] [] [("done",Bool)] + tbComp = Component (pack modName `append` "_testbench") [] [] [("done",Bool)] (concat [ finDecl , concat clks , concat rsts @@ -89,69 +100,76 @@ normalizeSignal glbls bndr = runNormalization opts supply glbls typeTrans tcm eval (normalize [bndr] >>= cleanupGraph bndr) -genTestBench opts _ _ _ _ _ _ _ _ _ c = traceIf (opt_dbgLevel opts > DebugNone) ("Can't make testbench for: " ++ show c) $ return [] +genTestBench opts _ _ _ _ _ _ _ _ _ _ c = traceIf (opt_dbgLevel opts > DebugNone) ("Can't make testbench for: " ++ show c) $ return [] genClock :: PrimMap -> (Identifier,HWType) - -> Maybe [Declaration] -genClock primMap (clkName,Clock clkSym rate) = Just clkDecls - where - clkGenDecl = case HashMap.lookup "CLaSH.Driver.TestbenchGen.clockGen" primMap of - Just (BlackBox _ (Left templ)) -> let (rising,rest) = divMod (toInteger rate) 2 - falling = rising + rest - ctx = emptyBBContext - { bbResult = (Left (Identifier clkName Nothing), Clock clkSym rate) - , bbInputs = [ (Left (N.Literal Nothing (NumLit 2)),Integer,True) - , (Left (N.Literal Nothing (NumLit rising)),Integer,True) - , (Left (N.Literal Nothing (NumLit falling)),Integer,True) - ] - } - in BlackBoxD "CLaSH.Driver.TestbenchGen.clockGen" (parseFail templ) ctx - pM -> error $ $(curLoc) ++ ("Can't make clock declaration for: " ++ show pM) - - clkDecls = [ NetDecl clkName (Clock clkSym rate) - , clkGenDecl - ] + -> NetlistMonad (Maybe [Declaration]) +genClock primMap (clkName,Clock clkSym rate) = + case HashMap.lookup "CLaSH.Driver.TestbenchGen.clockGen" primMap of + Just (BlackBox _ (Left templ)) -> do + let (rising,rest) = divMod (toInteger rate) 2 + falling = rising + rest + ctx = emptyBBContext + { bbResult = (Left (Identifier clkName Nothing), Clock clkSym rate) + , bbInputs = [ (Left (N.Literal Nothing (NumLit 2)),Integer,True) + , (Left (N.Literal Nothing (NumLit rising)),Integer,True) + , (Left (N.Literal Nothing (NumLit falling)),Integer,True) + ] + } + templ' <- prepareBlackBox "CLaSH.Driver.TestbenchGen.clockGen" templ ctx + let clkGenDecl = BlackBoxD "CLaSH.Driver.TestbenchGen.clockGen" templ' ctx + clkDecls = [ NetDecl clkName (Clock clkSym rate) + , clkGenDecl + ] + return (Just clkDecls) + pM -> error $ $(curLoc) ++ ("Can't make clock declaration for: " ++ show pM) -genClock _ _ = Nothing +genClock _ _ = return Nothing genReset :: PrimMap -> (Identifier,HWType) - -> Maybe [Declaration] -genReset primMap (rstName,Reset clkSym rate) = Just rstDecls - where - resetGenDecl = case HashMap.lookup "CLaSH.Driver.TestbenchGen.resetGen" primMap of - Just (BlackBox _ (Left templ)) -> let ctx = emptyBBContext - { bbResult = (Left (Identifier rstName Nothing), Reset clkSym rate) - , bbInputs = [(Left (N.Literal Nothing (NumLit 1)),Integer,True)] - } - in BlackBoxD "CLaSH.Driver.TestbenchGen.resetGen" (parseFail templ) ctx - pM -> error $ $(curLoc) ++ ("Can't make reset declaration for: " ++ show pM) + -> NetlistMonad (Maybe [Declaration]) +genReset primMap (rstName,Reset clkSym rate) = + case HashMap.lookup "CLaSH.Driver.TestbenchGen.resetGen" primMap of + Just (BlackBox _ (Left templ)) -> do + let ctx = emptyBBContext + { bbResult = (Left (Identifier rstName Nothing), Reset clkSym rate) + , bbInputs = [(Left (N.Literal Nothing (NumLit 1)),Integer,True)] + } + templ' <- prepareBlackBox "CLaSH.Driver.TestbenchGen.resetGen" templ ctx + let resetGenDecl = BlackBoxD "CLaSH.Driver.TestbenchGen.resetGen" templ' ctx + rstDecls = [ NetDecl rstName (Reset clkSym rate) + , resetGenDecl + ] + return (Just rstDecls) - rstDecls = [ NetDecl rstName (Reset clkSym rate) - , resetGenDecl - ] + pM -> error $ $(curLoc) ++ ("Can't make reset declaration for: " ++ show pM) -genReset _ _ = Nothing +genReset _ _ = return Nothing genFinish :: PrimMap - -> Declaration + -> NetlistMonad Declaration genFinish primMap = case HashMap.lookup "CLaSH.Driver.TestbenchGen.finishedGen" primMap of - Just (BlackBox _ (Left templ)) -> let ctx = emptyBBContext - { bbResult = (Left (Identifier "finished" Nothing), Bool) - , bbInputs = [ (Left (N.Literal Nothing (NumLit 100)),Integer,True) ] - } - in BlackBoxD "CLaSH.Driver.TestbenchGen.finishGen" (parseFail templ) ctx + Just (BlackBox _ (Left templ)) -> do + let ctx = emptyBBContext + { bbResult = (Left (Identifier "finished" Nothing), Bool) + , bbInputs = [ (Left (N.Literal Nothing (NumLit 100)),Integer,True) ] + } + templ' <- prepareBlackBox "CLaSH.Driver.TestbenchGen.finishGen" templ ctx + return $ BlackBoxD "CLaSH.Driver.TestbenchGen.finishGen" templ' ctx pM -> error $ $(curLoc) ++ ("Can't make finish declaration for: " ++ show pM) genDone :: PrimMap - -> Declaration + -> NetlistMonad Declaration genDone primMap = case HashMap.lookup "CLaSH.Driver.TestbenchGen.doneGen" primMap of - Just (BlackBox _ (Left templ)) -> let ctx = emptyBBContext - { bbResult = (Left (Identifier "done" Nothing), Bool) - , bbInputs = [(Left (Identifier "finished" Nothing),Bool,False)] - } - in BlackBoxD "CLaSH.Driver.TestbenchGen.doneGen" (parseFail templ) ctx + Just (BlackBox _ (Left templ)) -> do + let ctx = emptyBBContext + { bbResult = (Left (Identifier "done" Nothing), Bool) + , bbInputs = [(Left (Identifier "finished" Nothing),Bool,False)] + } + templ' <- prepareBlackBox "CLaSH.Driver.TestbenchGen.doneGen" templ ctx + return $ BlackBoxD "CLaSH.Driver.TestbenchGen.doneGen" templ' ctx pM -> error $ $(curLoc) ++ ("Can't make done declaration for: " ++ show pM) genStimuli :: Int @@ -164,12 +182,13 @@ -> HashMap TmName (Type,Term) ) -> [(Identifier,HWType)] -> (Identifier,HWType) + -> String -> TmName -> IO (Declaration,[Component],Int,[(Identifier,HWType)]) -genStimuli cmpCnt primMap globals typeTrans tcm normalizeSignal hidden inp signalNm = do +genStimuli cmpCnt primMap globals typeTrans tcm normalizeSignal hidden inp modName signalNm = do let stimNormal = normalizeSignal globals signalNm - (comps,cmpCnt') <- genNetlist (Just cmpCnt) stimNormal primMap tcm typeTrans Nothing signalNm - let sigNm = last (splitOn (pack ".") (pack (name2String signalNm))) + (comps,cmpCnt') <- genNetlist (Just cmpCnt) stimNormal primMap tcm typeTrans Nothing modName signalNm + let sigNm = pack (modName ++ "_") `append` last (splitOn (pack ".") (pack (name2String signalNm))) `append` pack "_" sigComp = case find ((isPrefixOf sigNm) . componentName) comps of Just c -> c Nothing -> error $ $(curLoc) ++ "Can't locate component for stimuli gen: " ++ (show $ pack $ name2String signalNm) ++ show (map (componentName) comps) @@ -197,12 +216,13 @@ -> HashMap TmName (Type,Term) ) -> [(Identifier,HWType)] -> (Identifier,HWType) + -> String -> TmName - -> IO (Declaration,[Component],[(Identifier,HWType)]) -genVerifier cmpCnt primMap globals typeTrans tcm normalizeSignal hidden outp signalNm = do + -> IO (Declaration,[Component],Int,[(Identifier,HWType)]) +genVerifier cmpCnt primMap globals typeTrans tcm normalizeSignal hidden outp modName signalNm = do let stimNormal = normalizeSignal globals signalNm - (comps,_) <- genNetlist (Just cmpCnt) stimNormal primMap tcm typeTrans Nothing signalNm - let sigNm = last (splitOn (pack ".") (pack (name2String signalNm))) + (comps,cmpCnt') <- genNetlist (Just cmpCnt) stimNormal primMap tcm typeTrans Nothing modName signalNm + let sigNm = pack (modName ++ "_") `append` last (splitOn (pack ".") (pack (name2String signalNm))) `append` "_" sigComp = case find ((isPrefixOf sigNm) . componentName) comps of Just c -> c Nothing -> error $ $(curLoc) ++ "Can't locate component for Verifier: " ++ (show $ pack $ name2String signalNm) ++ show (map (componentName) comps) @@ -217,4 +237,4 @@ (concat [ clkNms, rstNms ]) ++ [(inp,Identifier (fst outp) Nothing),(fin,Identifier "finished" Nothing)] ) - return (decl,comps,hidden'') + return (decl,comps,cmpCnt',hidden'') diff --git a/src/CLaSH/Driver/TopWrapper.hs b/src/CLaSH/Driver/TopWrapper.hs --- a/src/CLaSH/Driver/TopWrapper.hs +++ b/src/CLaSH/Driver/TopWrapper.hs @@ -32,11 +32,12 @@ -- | Create a wrapper around a component, potentially initiating clock sources mkTopWrapper :: PrimMap -> Maybe TopEntity -- ^ TopEntity specifications + -> String -- ^ Name of the module containing the @topEntity@ -> Component -- ^ Entity to wrap -> Component -mkTopWrapper primMap teM topComponent +mkTopWrapper primMap teM modName topComponent = Component - { componentName = maybe "topEntity" (pack . t_name) teM + { componentName = maybe (pack modName `append` "_topEntity") (pack . t_name) teM , inputs = inputs'' ++ extraIn teM , outputs = outputs'' ++ extraOut teM , hiddenPorts = case maybe [] t_clocks teM of @@ -283,4 +284,4 @@ unsafeRunNetlist = unsafePerformIO . fmap fst . runNetlistMonad Nothing HashMap.empty HashMap.empty - HashMap.empty (\_ _ -> Nothing) + HashMap.empty (\_ _ -> Nothing) "" diff --git a/src/CLaSH/Netlist.hs b/src/CLaSH/Netlist.hs --- a/src/CLaSH/Netlist.hs +++ b/src/CLaSH/Netlist.hs @@ -50,11 +50,13 @@ -- ^ Hardcoded Type -> HWType translator -> Maybe Int -- ^ Symbol count + -> String + -- ^ Name of the module containing the @topEntity@ -> TmName -- ^ Name of the @topEntity@ -> IO ([Component],Int) -genNetlist compCntM globals primMap tcm typeTrans mStart topEntity = do - (_,s) <- runNetlistMonad compCntM globals primMap tcm typeTrans $ genComponent topEntity mStart +genNetlist compCntM globals primMap tcm typeTrans mStart modName topEntity = do + (_,s) <- runNetlistMonad compCntM globals primMap tcm typeTrans modName $ genComponent topEntity mStart return (HashMap.elems $ _components s, _cmpCount s) -- | Run a NetlistMonad action in a given environment @@ -68,16 +70,18 @@ -- ^ TyCon cache -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -- ^ Hardcode Type -> HWType translator + -> String + -- ^ Name of the module containing the @topEntity@ -> NetlistMonad a -- ^ Action to run -> IO (a, NetlistState) -runNetlistMonad compCntM s p tcm typeTrans +runNetlistMonad compCntM s p tcm typeTrans modName = runFreshMT . flip runStateT s' . (fmap fst . runWriterT) . runNetlist where - s' = NetlistState s HashMap.empty 0 (fromMaybe 0 compCntM) HashMap.empty p typeTrans tcm Text.empty + s' = NetlistState s HashMap.empty 0 (fromMaybe 0 compCntM) HashMap.empty p typeTrans tcm modName Text.empty -- | Generate a component for a given function (caching) genComponent :: TmName -- ^ Name of the function @@ -98,8 +102,10 @@ genComponentT compName componentExpr mStart = do varCount .= fromMaybe 0 mStart componentNumber <- cmpCount <<%= (+1) + modName <- Lens.use modNm - let componentName' = (`Text.append` (Text.pack $ show componentNumber)) + let componentName' = (Text.pack (modName ++ "_") `Text.append`) + . (`Text.append` (Text.pack $ show componentNumber)) . ifThenElse Text.null (`Text.append` Text.pack "Component_") (`Text.append` Text.pack "_") @@ -193,11 +199,12 @@ tcm <- Lens.use tcCache scrutTy <- termType tcm scrut scrutHTy <- unsafeCoreTypeToHWTypeM $(curLoc) scrutTy + altHTy <- unsafeCoreTypeToHWTypeM $(curLoc) altTy (scrutExpr,scrutDecls) <- first (mkScrutExpr scrutHTy (fst (last alts'))) <$> mkExpr True scrutTy scrut (exprs,altsDecls) <- (second concat . unzip) <$> mapM (mkCondExpr scrutHTy) alts' let dstId = mkBasicId . Text.pack . name2String $ varName bndr - return $! scrutDecls ++ altsDecls ++ [CondAssignment dstId scrutExpr (reverse exprs)] + return $! scrutDecls ++ altsDecls ++ [CondAssignment dstId altHTy scrutExpr (reverse exprs)] where mkCondExpr :: HWType -> (Pat,Term) -> NetlistMonad ((Maybe Expr,Expr),[Declaration]) mkCondExpr scrutHTy (pat,alt) = do @@ -274,7 +281,7 @@ -> Type -- ^ Type of the LHS of the let-binder -> Term -- ^ Term to convert to an expression -> NetlistMonad (Expr,[Declaration]) -- ^ Returned expression and a list of generate BlackBox declarations -mkExpr _ _ (Core.Literal lit) = return (HW.Literal Nothing . NumLit $ fromInteger $! i,[]) +mkExpr _ _ (Core.Literal lit) = return (HW.Literal (Just (Integer,32)) . NumLit $ fromInteger $! i,[]) where i = case lit of (IntegerLiteral i') -> i' diff --git a/src/CLaSH/Netlist/BlackBox/Parser.hs b/src/CLaSH/Netlist/BlackBox/Parser.hs --- a/src/CLaSH/Netlist/BlackBox/Parser.hs +++ b/src/CLaSH/Netlist/BlackBox/Parser.hs @@ -70,6 +70,8 @@ <|> (Err . Just) <$> (pToken "~ERROR" *> pBrackets pNatural) <|> TypElem <$> (pToken "~TYPEL" *> pBrackets pTagE) <|> CompName <$ pToken "~COMPNAME" + <|> Size <$> (pToken "~SIZE" *> pBrackets pTagE) + <|> Length <$> (pToken "~LENGTH" *> pBrackets pTagE) <|> SigD <$> (pToken "~SIGD" *> pBrackets pTagE) <*> (Just <$> (pBrackets pNatural)) <|> (`SigD` Nothing) <$> (pToken "~SIGDO" *> pBrackets pTagE) diff --git a/src/CLaSH/Netlist/BlackBox/Types.hs b/src/CLaSH/Netlist/BlackBox/Types.hs --- a/src/CLaSH/Netlist/BlackBox/Types.hs +++ b/src/CLaSH/Netlist/BlackBox/Types.hs @@ -22,6 +22,8 @@ | TypElem Element -- ^ Select element type from a vector type | CompName -- ^ Hole for the name of the component in which -- the blackbox is instantiated + | Size Element -- ^ Size of a type hole + | Length Element -- ^ Length of a vector hole | SigD Element (Maybe Int) deriving Show diff --git a/src/CLaSH/Netlist/BlackBox/Util.hs b/src/CLaSH/Netlist/BlackBox/Util.hs --- a/src/CLaSH/Netlist/BlackBox/Util.hs +++ b/src/CLaSH/Netlist/BlackBox/Util.hs @@ -25,6 +25,7 @@ import CLaSH.Netlist.Types (HWType (..), Identifier, BlackBoxContext (..), SyncExpr, Expr(Identifier)) +import CLaSH.Netlist.Util (typeSize) import CLaSH.Util -- | Determine if the number of normal/literal/function inputs of a blackbox @@ -212,8 +213,15 @@ renderTag b (Err Nothing) = fmap (displayT . renderOneLine) . hdlTypeErrValue . snd $ bbResult b renderTag b (Err (Just n)) = let (_,ty,_) = bbInputs b !! n in (displayT . renderOneLine) <$> hdlTypeErrValue ty +renderTag b (Size e) = return . Text.pack . show . typeSize $ lineToType b [e] +renderTag b (Length e) = return . Text.pack . show . vecLen $ lineToType b [e] + where + vecLen (Vector n _) = n + vecLen _ = error $ $(curLoc) ++ "vecLen of a non-vector type" +renderTag b e@(TypElem _) = let ty = lineToType b [e] + in (displayT . renderOneLine) <$> hdlType ty + renderTag _ (D _) = error $ $(curLoc) ++ "Unexpected component declaration" -renderTag _ (TypElem _) = error $ $(curLoc) ++ "Unexpected type element selector" renderTag _ (SigD _ _) = error $ $(curLoc) ++ "Unexpected signal declaration" renderTag _ (Clk _) = error $ $(curLoc) ++ "Unexpected clock" renderTag _ (Rst _) = error $ $(curLoc) ++ "Unexpected reset" diff --git a/src/CLaSH/Netlist/Types.hs b/src/CLaSH/Netlist/Types.hs --- a/src/CLaSH/Netlist/Types.hs +++ b/src/CLaSH/Netlist/Types.hs @@ -47,6 +47,7 @@ , _primitives :: PrimMap -- ^ Primitive Definitions , _typeTranslator :: HashMap TyConName TyCon -> Type -> Maybe (Either String HWType) -- ^ Hardcoded Type -> HWType translator , _tcCache :: HashMap TyConName TyCon -- ^ TyCon cache + , _modNm :: String -- ^ Name of the module containing the @topEntity@ , _curCompNm :: Identifier } @@ -100,10 +101,12 @@ -- * Signal to assign -- -- * Assigned expression - | CondAssignment Identifier Expr [(Maybe Expr,Expr)] + | CondAssignment Identifier HWType Expr [(Maybe Expr,Expr)] -- ^ Conditional signal assignment: -- -- * Signal to assign + -- + -- * Type of the result/alternatives -- -- * Scrutinized expression -- diff --git a/src/CLaSH/Normalize/Transformations.hs b/src/CLaSH/Normalize/Transformations.hs --- a/src/CLaSH/Normalize/Transformations.hs +++ b/src/CLaSH/Normalize/Transformations.hs @@ -375,7 +375,8 @@ bodyMaybe <- HashMap.lookup f <$> Lens.use bindings case bodyMaybe of (Just (_,body)) - | termSize body < 5 -> changed (mkApps body args) + | termSize body < 5 -> do liftR $ addNewInline f + changed (mkApps body args) _ -> return e inlineSmall _ e = return e