clash-lib 0.6.6 → 0.6.7
raw patch · 8 files changed
+128/−89 lines, 8 filesdep ~unbound-generics
Dependency ranges changed: unbound-generics
Files
- CHANGELOG.md +5/−0
- clash-lib.cabal +2/−2
- src/CLaSH/Core/DataCon.hs +17/−1
- src/CLaSH/Core/TyCon.hs +17/−1
- src/CLaSH/Driver.hs +52/−71
- src/CLaSH/Netlist.hs +16/−11
- src/CLaSH/Netlist/Id.hs +4/−2
- src/Unbound/Generics/LocallyNameless/Extra.hs +15/−1
CHANGELOG.md view
@@ -1,5 +1,10 @@ # Changelog for the [`clash-lib`](http://hackage.haskell.org/package/clash-lib) package +## 0.6.7 *December 21st 2015*+* Support for `unbound-generics-0.3`+* New features:+ * Only look for 'topEntity' in the root module. [#22](https://github.com/clash-lang/clash-compiler/issues/22)+ ## 0.6.6 *December 11th 2015* * New features: * Remove all existing HDL files before generating new ones. This can be disabled by the `-clash-noclean` flag. [#96](https://github.com/clash-lang/clash-compiler/issues/96)
clash-lib.cabal view
@@ -1,5 +1,5 @@ Name: clash-lib-Version: 0.6.6+Version: 0.6.7 Synopsis: CAES Language for Synchronous Hardware - As a Library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -108,7 +108,7 @@ text >= 0.11.3.1, time >= 1.4.0.1, transformers >= 0.3.0.0,- unbound-generics >= 0.1 && < 0.3,+ unbound-generics >= 0.1 && < 0.4, unordered-containers >= 0.2.3.3, uu-parsinglib >= 2.8.1, wl-pprint-text >= 1.1.0.0
src/CLaSH/Core/DataCon.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}@@ -13,10 +14,19 @@ ) where +#ifndef MIN_VERSION_unbound_generics+#define MIN_VERSION_unbound_generics(x,y,z)(1)+#endif+ import Control.DeepSeq (NFData(..)) import GHC.Generics (Generic) import Unbound.Generics.LocallyNameless (Alpha(..),Name,Subst(..)) import Unbound.Generics.LocallyNameless.Extra ()+#if MIN_VERSION_unbound_generics(0,3,0)+import Data.Monoid (All (..))+import Unbound.Generics.LocallyNameless (NthPatFind (..),+ NamePatFind (..))+#endif import {-# SOURCE #-} CLaSH.Core.Type (TyName, Type) import CLaSH.Util@@ -59,10 +69,16 @@ open _ _ dc = dc isPat _ = mempty- isTerm _ = True +#if MIN_VERSION_unbound_generics(0,3,0)+ isTerm _ = All True+ nthPatFind _ = NthPatFind Left+ namePatFind _ = NamePatFind (const (Left 0))+#else+ isTerm _ = True nthPatFind _ = Left namePatFind _ _ = Left 0+#endif swaps' _ _ dc = dc lfreshen' _ dc cont = cont dc mempty
src/CLaSH/Core/TyCon.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleInstances #-}@@ -14,12 +15,21 @@ ) where +#ifndef MIN_VERSION_unbound_generics+#define MIN_VERSION_unbound_generics(x,y,z)(1)+#endif+ -- External Import import Control.DeepSeq import GHC.Generics import Unbound.Generics.LocallyNameless (Alpha(..)) import Unbound.Generics.LocallyNameless.Extra () import Unbound.Generics.LocallyNameless.Name (Name,name2String)+#if MIN_VERSION_unbound_generics(0,3,0)+import Data.Monoid (All (..))+import Unbound.Generics.LocallyNameless (NthPatFind (..),+ NamePatFind (..))+#endif -- Internal Imports import CLaSH.Core.DataCon (DataCon)@@ -93,10 +103,16 @@ open _ _ tc = tc isPat _ = mempty- isTerm _ = True +#if MIN_VERSION_unbound_generics(0,3,0)+ isTerm _ = All True+ nthPatFind _ = NthPatFind Left+ namePatFind _ = NamePatFind (const (Left 0))+#else+ isTerm _ = True nthPatFind _ = Left namePatFind _ _ = Left 0+#endif swaps' _ _ tc = tc lfreshen' _ tc cont = cont tc mempty
src/CLaSH/Driver.hs view
@@ -9,11 +9,9 @@ import Control.Monad (when) import Control.Monad.State (evalState, get) import Data.HashMap.Strict (HashMap)-import qualified Data.HashMap.Strict as HashMap import qualified Data.HashSet as HashSet import Data.IntMap (IntMap)-import Data.List (isSuffixOf)-import Data.Maybe (fromMaybe, listToMaybe)+import Data.Maybe (fromMaybe) import qualified Data.Text.Lazy as Text import qualified Data.Time.Clock as Clock import qualified System.Directory as Directory@@ -24,18 +22,17 @@ import CLaSH.Annotations.TopEntity (TopEntity) import CLaSH.Backend-import CLaSH.Core.Term (Term)+import CLaSH.Core.Term (Term, TmName) import CLaSH.Core.Type (Type) import CLaSH.Core.TyCon (TyCon, TyConName) import CLaSH.Driver.TestbenchGen import CLaSH.Driver.TopWrapper import CLaSH.Driver.Types-import CLaSH.Netlist (genNetlist)+import CLaSH.Netlist (genComponentName, genNetlist) import CLaSH.Netlist.Types (Component (..), HWType) import CLaSH.Normalize (checkNonRecursive, cleanupGraph, normalize, runNormalization) import CLaSH.Primitives.Types-import CLaSH.Util -- | Create a set of target HDL files for a set of functions generateHDL :: forall backend . Backend backend@@ -46,88 +43,72 @@ -> IntMap TyConName -- ^ Tuple TyCon cache -> (HashMap TyConName TyCon -> Type -> Maybe (Either String HWType)) -- ^ Hardcoded 'Type' -> 'HWType' translator -> (HashMap TyConName TyCon -> Bool -> Term -> Term) -- ^ Hardcoded evaluator (delta-reduction)- -> Maybe TopEntity+ -> (TmName,Maybe TopEntity) -- ^ topEntity bndr + (maybe) TopEntity annotation+ -> Maybe TmName -- ^ testInput bndr+ -> Maybe TmName -- ^ expectedOutput bndr -> CLaSHOpts -- ^ Debug information level for the normalization process -> IO ()-generateHDL bindingsMap hdlState primMap tcm tupTcm typeTrans eval teM opts = do+generateHDL bindingsMap hdlState primMap tcm tupTcm typeTrans eval (topEntity,annM) testInpM expOutM opts = do start <- Clock.getCurrentTime prepTime <- start `deepseq` bindingsMap `deepseq` tcm `deepseq` Clock.getCurrentTime let prepStartDiff = Clock.diffUTCTime prepTime start putStrLn $ "Loading dependencies took " ++ show prepStartDiff - let topEntities = HashMap.filterWithKey- (\var _ -> isSuffixOf ".topEntity" $ name2String var)- bindingsMap-- testInputs = HashMap.filterWithKey- (\var _ -> isSuffixOf ".testInput" $ name2String var)- bindingsMap-- expectedOutputs = HashMap.filterWithKey- (\var _ -> isSuffixOf ".expectedOutput" $ name2String var)- bindingsMap-- case HashMap.toList topEntities of- [topEntity] -> do- -- Create unique supplies for normalisation and TB generation- (supplyN,supplyTB) <- Supply.splitSupply- . snd- . Supply.freshId- <$> Supply.newSupply+ (supplyN,supplyTB) <- Supply.splitSupply+ . snd+ . Supply.freshId+ <$> Supply.newSupply - let doNorm = do norm <- normalize [fst topEntity]- let normChecked = checkNonRecursive (fst topEntity) norm- cleanupGraph (fst topEntity) normChecked- transformedBindings = runNormalization opts supplyN bindingsMap typeTrans tcm tupTcm eval doNorm+ let doNorm = do norm <- normalize [topEntity]+ let normChecked = checkNonRecursive topEntity norm+ cleanupGraph topEntity normChecked+ transformedBindings = runNormalization opts supplyN bindingsMap typeTrans tcm tupTcm eval doNorm - normTime <- transformedBindings `deepseq` Clock.getCurrentTime- let prepNormDiff = Clock.diffUTCTime normTime prepTime- putStrLn $ "Normalisation took " ++ show prepNormDiff+ normTime <- transformedBindings `deepseq` Clock.getCurrentTime+ let prepNormDiff = Clock.diffUTCTime normTime prepTime+ putStrLn $ "Normalisation took " ++ show prepNormDiff - let modName = takeWhile (/= '.') (name2String $ fst topEntity)- (netlist,dfiles,cmpCnt) <- genNetlist Nothing transformedBindings primMap tcm- typeTrans Nothing modName [] (fst topEntity)+ let modName = takeWhile (/= '.') (name2String topEntity)+ (netlist,dfiles,cmpCnt) <- genNetlist Nothing transformedBindings primMap tcm+ typeTrans Nothing modName [] topEntity - netlistTime <- netlist `deepseq` Clock.getCurrentTime- let normNetDiff = Clock.diffUTCTime netlistTime normTime- putStrLn $ "Netlist generation took " ++ show normNetDiff+ netlistTime <- netlist `deepseq` Clock.getCurrentTime+ let normNetDiff = Clock.diffUTCTime netlistTime normTime+ putStrLn $ "Netlist generation took " ++ show normNetDiff - let topComponent = head- $ filter (\(Component cName _ _ _ _) ->- Text.isSuffixOf (Text.pack "topEntity_0")- cName)- netlist+ let topComponent = head+ $ filter (\(Component cName _ _ _ _) ->+ Text.isSuffixOf (genComponentName modName topEntity 0)+ cName)+ netlist - (testBench,dfiles') <- genTestBench opts supplyTB primMap- typeTrans tcm tupTcm eval cmpCnt bindingsMap- (listToMaybe $ map fst $ HashMap.toList testInputs)- (listToMaybe $ map fst $ HashMap.toList expectedOutputs)- modName- dfiles- topComponent+ (testBench,dfiles') <- genTestBench opts supplyTB primMap+ typeTrans tcm tupTcm eval cmpCnt bindingsMap+ testInpM+ expOutM+ modName+ dfiles+ topComponent - testBenchTime <- testBench `seq` Clock.getCurrentTime- let netTBDiff = Clock.diffUTCTime testBenchTime netlistTime- putStrLn $ "Testbench generation took " ++ show netTBDiff-- let hdlState' = fromMaybe (initBackend :: backend) hdlState- topWrapper = mkTopWrapper primMap teM modName topComponent- hdlDocs = createHDL hdlState' modName (topWrapper : netlist ++ testBench)- dir = concat [ "./" ++ CLaSH.Backend.name hdlState' ++ "/"- , takeWhile (/= '.') (name2String $ fst topEntity)- , "/"- ]- prepareDir (opt_cleanhdl opts) (extension hdlState') dir- mapM_ (writeHDL hdlState' dir) hdlDocs- copyDataFiles dir dfiles'+ testBenchTime <- testBench `seq` Clock.getCurrentTime+ let netTBDiff = Clock.diffUTCTime testBenchTime netlistTime+ putStrLn $ "Testbench generation took " ++ show netTBDiff - end <- hdlDocs `seq` Clock.getCurrentTime- let startEndDiff = Clock.diffUTCTime end start- putStrLn $ "Total compilation took " ++ show startEndDiff+ let hdlState' = fromMaybe (initBackend :: backend) hdlState+ topWrapper = mkTopWrapper primMap annM modName topComponent+ hdlDocs = createHDL hdlState' modName (topWrapper : netlist ++ testBench)+ dir = concat [ "./" ++ CLaSH.Backend.name hdlState' ++ "/"+ , takeWhile (/= '.') (name2String topEntity)+ , "/"+ ]+ prepareDir (opt_cleanhdl opts) (extension hdlState') dir+ mapM_ (writeHDL hdlState' dir) hdlDocs+ copyDataFiles dir dfiles' - [] -> error $ $(curLoc) ++ "No 'topEntity' found"- _ -> error $ $(curLoc) ++ "Multiple 'topEntity's found"+ end <- hdlDocs `seq` Clock.getCurrentTime+ let startEndDiff = Clock.diffUTCTime end start+ putStrLn $ "Total compilation took " ++ show startEndDiff -- | Pretty print Components to HDL Documents createHDL :: Backend backend
src/CLaSH/Netlist.hs view
@@ -109,17 +109,7 @@ componentNumber <- cmpCount <<%= (+1) modName <- Lens.use modNm - 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 "_")- . mkBasicId' True- . stripDollarPrefixes- . last- . Text.splitOn (Text.pack ".")- . Text.pack- $ name2String compName+ let componentName' = genComponentName modName compName componentNumber curCompNm .= componentName' tcm <- Lens.use tcCache@@ -152,6 +142,21 @@ compOutp = (mkBasicId . Text.pack $ name2String result, resType) component = Component componentName' (toList clks) compInps [compOutp] (netDecls ++ decls) return component++genComponentName :: String -> TmName -> Int -> Identifier+genComponentName prefix nm i+ = mkBasicId' True+ . (Text.pack (prefix ++ "_") `Text.append`)+ . (`Text.append` (Text.pack $ show i))+ . ifThenElse Text.null+ (`Text.append` Text.pack "Component_")+ (`Text.append` Text.pack "_")+ . mkBasicId' True+ . stripDollarPrefixes+ . last+ . Text.splitOn (Text.pack ".")+ . Text.pack+ $ name2String nm -- | Generate a list of Declarations for a let-binder mkDeclarations :: Id -- ^ LHS of the let-binder
src/CLaSH/Netlist/Id.hs view
@@ -31,7 +31,7 @@ . Text.group stripDollarPrefixes :: Text -> Text-stripDollarPrefixes = stripSpecPrefix . stripConPrefix+stripDollarPrefixes = stripWorkerPrefix . stripSpecPrefix . stripConPrefix . stripWorkerPrefix . stripDictFunPrefix where stripDictFunPrefix t = case Text.stripPrefix "$f" t of@@ -48,7 +48,9 @@ Just k -> k Nothing -> t - stripSpecPrefix t = snd (Text.breakOnEnd "$s" t)+ stripSpecPrefix t = case Text.stripPrefix "$s" t of+ Just k -> k+ Nothing -> t -- snd (Text.breakOnEnd "$s" t) type UserString = Text -- As the user typed it
src/Unbound/Generics/LocallyNameless/Extra.hs view
@@ -6,7 +6,7 @@ module Unbound.Generics.LocallyNameless.Extra where -#ifndef CABAL+#ifndef MIN_VERSION_unbound_generics #define MIN_VERSION_unbound_generics(x,y,z)(1) #endif @@ -15,9 +15,17 @@ import Control.DeepSeq #endif import Data.Hashable (Hashable(..),hash)+#if MIN_VERSION_unbound_generics(0,3,0)+import Data.Monoid+#endif import Data.Text (Text) import GHC.Real (Ratio)+#if MIN_VERSION_unbound_generics(0,3,0)+import Unbound.Generics.LocallyNameless.Alpha (Alpha (..), NamePatFind (..),+ NthPatFind (..))+#else import Unbound.Generics.LocallyNameless.Alpha (Alpha (..))+#endif #if MIN_VERSION_unbound_generics(0,2,0) #else import Unbound.Generics.LocallyNameless.Bind (Bind (..))@@ -61,9 +69,15 @@ close _ctx _b = id open _ctx _b = id isPat _ = mempty+#if MIN_VERSION_unbound_generics(0,3,0)+ isTerm _ = All True+ nthPatFind _ = NthPatFind Left+ namePatFind _ = NamePatFind (const (Left 0))+#else isTerm _ = True nthPatFind _ = Left namePatFind _ _ = Left 0+#endif swaps' _ctx _p = id freshen' _ctx i = return (i, mempty) lfreshen' _ctx i cont = cont i mempty