clash-lib 0.5.5 → 0.5.6
raw patch · 12 files changed
+149/−97 lines, 12 filesdep ~clash-preludePVP: major bump suggested
API removals or changes: PVP suggests a major version bump
Dependency ranges changed: clash-prelude
API changes (from Hackage documentation)
+ CLaSH.Netlist.BlackBox.Types: [Length] :: Element -> Element
+ CLaSH.Netlist.BlackBox.Types: [Size] :: Element -> Element
+ CLaSH.Netlist.Types: [_modNm] :: NetlistState -> String
+ CLaSH.Netlist.Types: modNm :: Lens' NetlistState String
- CLaSH.Backend: genHDL :: Backend state => Component -> State state (String, Doc)
+ CLaSH.Backend: genHDL :: Backend state => String -> Component -> State state (String, Doc)
- CLaSH.Backend: mkTyPackage :: Backend state => [HWType] -> State state Doc
+ CLaSH.Backend: mkTyPackage :: Backend state => String -> [HWType] -> State state [(String, Doc)]
- CLaSH.Driver: createHDL :: Backend backend => backend -> [Component] -> [(String, Doc)]
+ CLaSH.Driver: createHDL :: Backend backend => backend -> String -> [Component] -> [(String, Doc)]
- CLaSH.Driver.TestbenchGen: genTestBench :: CLaSHOpts -> Supply -> PrimMap -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> HashMap TyConName TyCon -> (HashMap TyConName TyCon -> Term -> Term) -> Int -> HashMap TmName (Type, Term) -> Maybe TmName -> Maybe TmName -> Component -> IO ([Component])
+ CLaSH.Driver.TestbenchGen: genTestBench :: CLaSHOpts -> Supply -> PrimMap -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> HashMap TyConName TyCon -> (HashMap TyConName TyCon -> Term -> Term) -> Int -> HashMap TmName (Type, Term) -> Maybe TmName -> Maybe TmName -> String -> Component -> IO ([Component])
- CLaSH.Driver.TopWrapper: mkTopWrapper :: PrimMap -> Maybe TopEntity -> Component -> Component
+ CLaSH.Driver.TopWrapper: mkTopWrapper :: PrimMap -> Maybe TopEntity -> String -> Component -> Component
- CLaSH.Netlist: genNetlist :: Maybe Int -> HashMap TmName (Type, Term) -> PrimMap -> HashMap TyConName TyCon -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> Maybe Int -> TmName -> IO ([Component], Int)
+ CLaSH.Netlist: genNetlist :: Maybe Int -> HashMap TmName (Type, Term) -> PrimMap -> HashMap TyConName TyCon -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> Maybe Int -> String -> TmName -> IO ([Component], Int)
- CLaSH.Netlist: runNetlistMonad :: Maybe Int -> HashMap TmName (Type, Term) -> PrimMap -> HashMap TyConName TyCon -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> NetlistMonad a -> IO (a, NetlistState)
+ CLaSH.Netlist: runNetlistMonad :: Maybe Int -> HashMap TmName (Type, Term) -> PrimMap -> HashMap TyConName TyCon -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> String -> NetlistMonad a -> IO (a, NetlistState)
- CLaSH.Netlist.Types: [CondAssignment] :: Identifier -> Expr -> [(Maybe Expr, Expr)] -> Declaration
+ CLaSH.Netlist.Types: [CondAssignment] :: Identifier -> HWType -> Expr -> [(Maybe Expr, Expr)] -> Declaration
- CLaSH.Netlist.Types: [NetlistState] :: HashMap TmName (Type, Term) -> Gamma -> Int -> Int -> HashMap TmName Component -> PrimMap -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> HashMap TyConName TyCon -> Identifier -> NetlistState
+ CLaSH.Netlist.Types: [NetlistState] :: HashMap TmName (Type, Term) -> Gamma -> Int -> Int -> HashMap TmName Component -> PrimMap -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -> HashMap TyConName TyCon -> String -> Identifier -> NetlistState
Files
- CHANGELOG.md +5/−0
- clash-lib.cabal +2/−2
- src/CLaSH/Backend.hs +2/−2
- src/CLaSH/Driver.hs +13/−10
- src/CLaSH/Driver/TestbenchGen.hs +90/−70
- src/CLaSH/Driver/TopWrapper.hs +4/−3
- src/CLaSH/Netlist.hs +14/−7
- src/CLaSH/Netlist/BlackBox/Parser.hs +2/−0
- src/CLaSH/Netlist/BlackBox/Types.hs +2/−0
- src/CLaSH/Netlist/BlackBox/Util.hs +9/−1
- src/CLaSH/Netlist/Types.hs +4/−1
- src/CLaSH/Normalize/Transformations.hs +2/−1
CHANGELOG.md view
@@ -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
clash-lib.cabal view
@@ -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,
src/CLaSH/Backend.hs view
@@ -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
src/CLaSH/Driver.hs view
@@ -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.
src/CLaSH/Driver/TestbenchGen.hs view
@@ -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'')
src/CLaSH/Driver/TopWrapper.hs view
@@ -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) ""
src/CLaSH/Netlist.hs view
@@ -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'
src/CLaSH/Netlist/BlackBox/Parser.hs view
@@ -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)
src/CLaSH/Netlist/BlackBox/Types.hs view
@@ -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
src/CLaSH/Netlist/BlackBox/Util.hs view
@@ -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"
src/CLaSH/Netlist/Types.hs view
@@ -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 --
src/CLaSH/Normalize/Transformations.hs view
@@ -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