clash-lib 0.5.2 → 0.5.3

raw patch · 8 files changed

+61/−134 lines, 8 filesdep +clash-preludePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: clash-prelude

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• clash-lib.cabal +2/−1
• src/CLaSH/Driver.hs +1/−0
• src/CLaSH/Driver/TopWrapper.hs +32/−118
• src/CLaSH/Netlist.hs +5/−3
• src/CLaSH/Netlist/BlackBox/Util.hs +6/−5
• src/CLaSH/Netlist/Types.hs +4/−3
• src/CLaSH/Normalize.hs +4/−4

@@ -1,5 +1,12 @@ # Changelog for the [`clash-lib`](http://hackage.haskell.org/package/clash-lib) package +## 0.5.3 *May 5th 2015*+* New features:+  * `TopEntity` wrappers are now specified as `ANN` annotation pragmas+* Fixes bugs:+  * Lost system1000 clock in VHDL generation... [#53](https://github.com/clash-lang/clash-compiler/issues/53)+  * `flattenCallTree` sometimes introduces free variables+ ## 0.5.2 *May 1st 2015* * New features:   * Generate wrappers around `topEntity` that have constant names and types

@@ -1,5 +1,5 @@ Name:                 clash-lib-Version:              0.5.2+Version:              0.5.3 Synopsis:             CAES Language for Synchronous Hardware - As a Library Description:   CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -57,6 +57,7 @@                       attoparsec              >= 0.10.4.0,                       base                    >= 4.8 && < 5,                       bytestring              >= 0.10.0.2,+                      clash-prelude           >= 0.7.4,                       concurrent-supply       >= 0.1.7,                       containers              >= 0.5.0.0,                       deepseq                 >= 1.3.0.2,

@@ -20,6 +20,7 @@ import           Text.PrettyPrint.Leijen.Text     (Doc, hPutDoc) import           Unbound.Generics.LocallyNameless (name2String) +import           CLaSH.Annotations.TopEntity      (TopEntity) import           CLaSH.Backend import           CLaSH.Core.Term                  (Term) import           CLaSH.Core.Type                  (Type)

@@ -12,17 +12,14 @@ -} module CLaSH.Driver.TopWrapper where -import           Data.Aeson           (FromJSON (..), Value (..), (.:), (.:?),-                                       (.!=))-import           Data.Aeson.Extra     (decodeAndReport)-import qualified Data.ByteString.Lazy as B-import qualified Data.HashMap.Strict  as H+ import qualified Data.HashMap.Lazy    as HashMap import           Data.List            (mapAccumL)-import           Data.Text.Lazy       (Text, append, pack)-import           System.Directory     (doesFileExist)+import           Data.Text.Lazy       (Text, append, pack, unpack) import           System.IO.Unsafe     (unsafePerformIO) +import CLaSH.Annotations.TopEntity    (TopEntity (..), ClockSource (..))+ import CLaSH.Netlist                  (runNetlistMonad) import CLaSH.Netlist.BlackBox         (prepareBlackBox) import CLaSH.Netlist.Types            (BlackBoxContext (..), Component (..),@@ -32,93 +29,6 @@ import CLaSH.Primitives.Types         (PrimMap, Primitive (..)) import CLaSH.Util --- | TopEntity specifications, fields are self-explanatory-data TopEntity-  = TopEntity-  { t_name     :: Text-  , t_inputs   :: [Text]        -- optional-  , t_outputs  :: [Text]        -- optional-  , t_extraIn  :: [(Text,Int)]  -- optional-  , t_extraOut :: [(Text,Int)]  -- optional-  , t_clocks   :: [ClockSource] -- optional-  }-  deriving Show---- | A clock source-data ClockSource-  = ClockSource-  { c_name  :: Text              -- ^ Component name-  , c_paths :: [ClockPath]       -- ^ Number of clock paths-  , c_reset :: Maybe (Text,Text) -- ^ optional: Asynchronous reset input-  , c_lock  :: Text              -- ^ Port name that indicates clock is stable-  , c_sync  :: Bool              -- ^ optional: devices connected this clock-                                 -- source should be pulled out of reset in-sync-  }-  deriving Show---- | A clock path-data ClockPath-  = ClockPath-  { cp_inp   :: Maybe (Text,Text) -- optional: (Input port, clock pin)-  , cp_outp  :: [(Text,Clock)]    -- [(output port,clock signal)]-  }-  deriving Show---- | A clock-data Clock-  = Clk { clk_name :: Text, clk_rate :: Int }-  deriving (Eq,Show)--instance FromJSON TopEntity where-  parseJSON (Object v) = case H.toList v of-    [(conKey,Object conVal)] -> case conKey of-      "TopEntity"  -> TopEntity <$> conVal .: "name"-                                <*> (conVal .:? "inputs" .!= [])-                                <*> (conVal .:? "outputs" .!= [])-                                <*> (conVal .:? "extra_in" .!= [])-                                <*> (conVal .:? "extra_out" .!= [])-                                <*> (conVal .:? "clocks" .!= [])-      _ -> error "Expected: TopEntity"-    _ -> error "Expected: TopEntity object"-  parseJSON _ = error "Expected: TopEntity object"--instance FromJSON ClockSource where-  parseJSON (Object v) = case H.toList v of-    [(conKey,Object conVal)] -> case conKey of-      "Source" -> ClockSource <$> conVal .: "name" <*> conVal .: "paths"-                              <*> conVal .:? "reset" <*> conVal .: "lock"-                              <*> (conVal .:? "sync" .!= False)-      _ -> error "Expected: Source"-    _ -> error "Expected: Source object"-  parseJSON _ = error "Expected: Source object"--instance FromJSON ClockPath where-  parseJSON (Object v) = case H.toList v of-    [(conKey,Object conVal)] -> case conKey of-      "Path" -> ClockPath <$> conVal .:? "inp" <*> conVal .: "outp"-      _ -> error "Expected: Path"-    _ -> error "Expected: Path object"-  parseJSON _ = error "Expected: Path object"--instance FromJSON Clock where-  parseJSON (Object v) = case H.toList v of-    [(conKey,Object conVal)] -> case conKey of-      "Clk" -> Clk <$> conVal .: "name" <*> conVal .: "rate"-      _ -> error "Expected: Clk"-    _ -> error "Expected: Clk object"-  parseJSON (String "System") = pure (Clk "system" 1000)-  parseJSON _ = error "Expected: System, or, Clk object"---- | Create a 'TopEntity' data type from the JSON encoded @.topentity@ file.-generateTopEnt :: String-               -> IO (Maybe TopEntity)-generateTopEnt modName = do-  let topEntityFile = modName ++ ".topentity"-  exists <- doesFileExist topEntityFile-  if exists-    then return . decodeAndReport <=< B.readFile $ topEntityFile-    else return Nothing- -- | Create a wrapper around a component, potentially initiating clock sources mkTopWrapper :: PrimMap              -> Maybe TopEntity -- ^ TopEntity specifications@@ -126,7 +36,7 @@              -> Component mkTopWrapper primMap teM topComponent   = Component-  { componentName = maybe "topEntity" t_name teM+  { componentName = maybe "topEntity" (pack . t_name) teM   , inputs        = inputs'' ++ extraIn teM   , outputs       = outputs'' ++ extraOut teM   , hiddenPorts   = case maybe [] t_clocks teM of@@ -138,7 +48,7 @@                            ]   }   where-    iNameSupply                = maybe [] t_inputs teM+    iNameSupply                = maybe [] (map pack . t_inputs) teM     originalHidden             = hiddenPorts topComponent      inputs'                    = map (first (const "input"))@@ -150,7 +60,7 @@                                             iNameSupply                                             (zip inputs' [0..]) -    oNameSupply                   = maybe [] t_outputs teM+    oNameSupply                   = maybe [] (map pack . t_outputs) teM     outputs'                      = map (first (const "output"))                                         (outputs topComponent)     (outputs'',(unwrappers,idsO)) = (concat *** (first concat . unzip))@@ -175,11 +85,11 @@  -- | Create extra input ports for the wrapper extraIn :: Maybe TopEntity -> [(Identifier,HWType)]-extraIn = maybe [] ((map (second BitVector)) . t_extraIn)+extraIn = maybe [] ((map (pack *** BitVector)) . t_extraIn)  -- | Create extra output ports for the wrapper extraOut :: Maybe TopEntity -> [(Identifier,HWType)]-extraOut = maybe [] ((map (second BitVector)) . t_extraOut)+extraOut = maybe [] ((map (pack *** BitVector)) . t_extraOut)  -- | Generate input port mappings mkInput :: [Identifier]@@ -292,52 +202,55 @@     , resets     ]   where-    hiddenSigDecs        = map (uncurry NetDecl) hidden+    hiddenSigDecs        = maybe [] (const (map (uncurry NetDecl) hidden)) teM     (clockGens,clkLocks) = maybe ([],[])                                  (first concat . unzip . map mkClock . t_clocks)                                  teM     resets               = mkResets primMap hidden clkLocks +stringToVar :: String -> Expr+stringToVar = (`Identifier` Nothing) . pack+ -- | Create a single clock generator-mkClock :: ClockSource -> ([Declaration],(Identifier,[Clock],Bool))+mkClock :: ClockSource -> ([Declaration],(Identifier,[String],Bool)) mkClock (ClockSource {..}) = ([lockedDecl,instDecl],(lockedName,clks,c_sync))   where-    lockedName   = append c_name "_locked"+    c_nameT      = pack c_name+    lockedName   = append c_nameT "_locked"     lockedDecl   = NetDecl lockedName (Reset lockedName 0)-    (ports,clks) = (concat *** concat) . unzip $ map clockPorts c_paths-    instDecl     = InstDecl c_name (append c_name "_inst")+    (ports,clks) = clockPorts c_inp c_outp+    instDecl     = InstDecl c_nameT (append c_nameT "_inst")                  $ concat [ ports-                          , maybe [] ((:[]) . second (`Identifier` Nothing))+                          , maybe [] ((:[]) . (pack *** stringToVar))                                   c_reset-                          , [(c_lock,Identifier lockedName Nothing)]+                          , [(pack c_lock,Identifier lockedName Nothing)]                           ]  -- | Create a single clock path-clockPorts :: ClockPath -> ([(Identifier,Expr)],[Clock])-clockPorts (ClockPath {..}) = (inp ++ outp,clks)+clockPorts :: Maybe (String,String) -> [(String,String)]+           -> ([(Identifier,Expr)],[String])+clockPorts inp outp = (inp' ++ outp',clks)   where-    inp  = maybe [] ((:[]) . second (`Identifier` Nothing)) cp_inp-    outp = map (second ((`Identifier` Nothing) . clkToId)) cp_outp-    clks = map snd cp_outp--    clkToId (Clk nm r) = append nm (pack (show r))+    inp'  = maybe [] ((:[]) . (pack *** stringToVar)) inp+    outp' = map (pack *** stringToVar) outp+    clks  = map snd outp  -- | Generate resets mkResets :: PrimMap          -> [(Identifier,HWType)]-         -> [(Identifier,[Clock],Bool)]+         -> [(Identifier,[String],Bool)]          -> [Declaration] mkResets primMap hidden = unsafeRunNetlist . fmap concat . mapM assingReset   where     assingReset (lock,clks,doSync) = concat <$> mapM connectReset matched       where         matched = filter match hidden-        match (_,(Reset nm r)) = elem (Clk nm r) clks+        match (_,(Reset nm r)) = elem (unpack nm ++ show r) clks         match _                = False          connectReset (rst,(Reset nm r)) = if doSync             then return [Assignment rst (Identifier lock Nothing)]-            else genSyncReset primMap lock rst (Clk nm r)+            else genSyncReset primMap lock rst nm r         connectReset _ = return []  -- | Generate a reset synchroniser that synchronously de-asserts an@@ -345,9 +258,10 @@ genSyncReset :: PrimMap              -> Identifier              -> Identifier-             -> Clock+             -> Text+             -> Int              -> NetlistMonad [Declaration]-genSyncReset primMap lock rst (Clk nm r) = do+genSyncReset primMap lock rst nm r = do   let resetType = Reset rst 0       ctx = emptyBBContext               { bbResult = (Right ((Identifier rst Nothing),(nm,r)), resetType)

@@ -7,12 +7,13 @@ import           Control.Lens                     ((.=), (<<%=)) import qualified Control.Lens                     as Lens import           Control.Monad.State              (runStateT)-import           Control.Monad.Writer             (listen, runWriterT)+import           Control.Monad.Writer             (listen, runWriterT, tell) import           Data.Either                      (lefts,partitionEithers) import           Data.HashMap.Lazy                (HashMap) import qualified Data.HashMap.Lazy                as HashMap-import           Data.List                        (elemIndex, nub)+import           Data.List                        (elemIndex) import           Data.Maybe                       (fromMaybe)+import           Data.Set                         (toList,fromList) import qualified Data.Text.Lazy                   as Text import           Unbound.Generics.LocallyNameless (Embed (..), name2String,                                                   runFreshMT, unbind, unembed,@@ -137,7 +138,7 @@    let compInps       = zip (map (mkBasicId . Text.pack . name2String . varName) arguments) argTypes       compOutp       = (mkBasicId . Text.pack $ name2String result, resType)-      component      = Component componentName' (nub clks) compInps [compOutp] (netDecls ++ decls)+      component      = Component componentName' (toList clks) compInps [compOutp] (netDecls ++ decls)   return component  -- | Generate a list of Declarations for a let-binder@@ -245,6 +246,7 @@                     outpAssign    = (fst compOutp,Identifier dstId Nothing)                     instLabel     = Text.concat [compName, Text.pack "_", dstId]                     instDecl      = InstDecl compName instLabel (outpAssign:hiddenAssigns ++ inpAssigns)+                tell (fromList hidden)                 return (argDecls ++ [instDecl])         else error $ $(curLoc) ++ "under-applied normalized function"     Nothing -> case args of

@@ -13,6 +13,7 @@ import           Control.Monad.Writer                 (MonadWriter, tell) import           Data.Foldable                        (foldrM) import qualified Data.IntMap                          as IntMap+import           Data.Set                             (Set,singleton) import           Data.Text.Lazy                       (Text) import qualified Data.Text.Lazy                       as Text import           Text.PrettyPrint.Leijen.Text.Monadic (displayT, renderCompact,@@ -76,7 +77,7 @@                       _             -> pure e               ) -setClocks :: ( MonadWriter [(Identifier,HWType)] m+setClocks :: ( MonadWriter (Set (Identifier,HWType)) m              , Applicative m              )           => BlackBoxContext@@ -89,19 +90,19 @@      setClocks' (Clk Nothing)  = let (clk,rate) = clkSyncId $ fst $ bbResult bc                                     clkName    = Text.append clk (Text.pack (show rate))-                                in  tell [(clkName,Clock clk rate)] >> return (C clkName)+                                in  tell (singleton (clkName,Clock clk rate)) >> return (C clkName)     setClocks' (Clk (Just n)) = let (e,_,_)    = bbInputs bc !! n                                     (clk,rate) = clkSyncId e                                     clkName    = Text.append clk (Text.pack (show rate))-                                in  tell [(clkName,Clock clk rate)] >> return (C clkName)+                                in  tell (singleton (clkName,Clock clk rate)) >> return (C clkName)      setClocks' (Rst Nothing)  = let (rst,rate) = clkSyncId $ fst $ bbResult bc                                     rstName    = Text.concat [rst,Text.pack (show rate),"_rstn"]-                                in  tell [(rstName,Reset rst rate)] >> return (C rstName)+                                in  tell (singleton (rstName,Reset rst rate)) >> return (C rstName)     setClocks' (Rst (Just n)) = let (e,_,_)    = bbInputs bc !! n                                     (rst,rate) = clkSyncId e                                     rstName    = Text.concat [rst,Text.pack (show rate),"_rstn"]-                                in  tell [(rstName,Reset rst rate)] >> return (C rstName)+                                in  tell (singleton (rstName,Reset rst rate)) >> return (C rstName)      setClocks' e = return e 

@@ -11,6 +11,7 @@ import Data.Hashable import Data.HashMap.Lazy                    (HashMap) import Data.IntMap.Lazy                     (IntMap, empty)+import Data.Set                             (Set) import qualified Data.Text                  as S import Data.Text.Lazy                       (Text, pack) import GHC.Generics                         (Generic)@@ -28,11 +29,11 @@ -- of components that are being generated (WriterT) newtype NetlistMonad a =   NetlistMonad { runNetlist :: WriterT-                               [(Identifier,HWType)]+                               (Set (Identifier,HWType))                                (StateT NetlistState (FreshMT IO))                                a                }-  deriving (Functor, Monad, Applicative, MonadWriter [(Identifier,HWType)],+  deriving (Functor, Monad, Applicative, MonadWriter (Set (Identifier,HWType)),             MonadState NetlistState, Fresh, MonadIO)  -- | State of the NetlistMonad@@ -85,7 +86,7 @@   | SP       Identifier [(Identifier,[HWType])] -- ^ Sum-of-Product type: Name and Constructor names + field types   | Clock    Identifier Int -- ^ Clock type with specified name and period   | Reset    Identifier Int -- ^ Reset type corresponding to clock with a specified name and period-  deriving (Eq,Show,Generic)+  deriving (Eq,Ord,Show,Generic)  instance Hashable HWType instance NFData HWType

@@ -10,7 +10,7 @@ import           Data.Either                      (partitionEithers) import           Data.HashMap.Strict              (HashMap) import qualified Data.HashMap.Strict              as HashMap-import           Data.List                        (mapAccumL)+import           Data.List                        (mapAccumL,intersect) import qualified Data.Map                         as Map import qualified Data.Maybe                       as Maybe import qualified Data.Set                         as Set@@ -165,9 +165,9 @@                                 then Nothing                                 else Just args   where-    mentionsId t = case t of-                     (Left (Var _ nm)) | nm `elem` allIds -> True-                     _ -> False+    mentionsId t = not $ null (either (Lens.toListOf termFreeIds) (const []) t+                              `intersect`+                              allIds)  stripArgs allIds (id_:ids) (Left (Var _ nm):args)       | varName id_ == nm = stripArgs allIds ids args