diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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 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.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, diff --git a/src/CLaSH/Driver.hs b/src/CLaSH/Driver.hs --- a/src/CLaSH/Driver.hs +++ b/src/CLaSH/Driver.hs @@ -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) 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 @@ -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) diff --git a/src/CLaSH/Netlist.hs b/src/CLaSH/Netlist.hs --- a/src/CLaSH/Netlist.hs +++ b/src/CLaSH/Netlist.hs @@ -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 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 @@ -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 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 @@ -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 diff --git a/src/CLaSH/Normalize.hs b/src/CLaSH/Normalize.hs --- a/src/CLaSH/Normalize.hs +++ b/src/CLaSH/Normalize.hs @@ -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