clash-lib 0.2 → 0.2.0.1
raw patch · 10 files changed
+99/−105 lines, 10 filesdep +ListLikedep −listlike-instancesdep ~aesondep ~attoparsecdep ~base
Dependencies added: ListLike
Dependencies removed: listlike-instances
Dependency ranges changed: aeson, attoparsec, base, bytestring, concurrent-supply, containers, directory, errors, filepath, hashable, lens, mtl, template-haskell, text, transformers, unbound, unordered-containers, uu-parsinglib, wl-pprint-text
Files
- clash-lib.cabal +22/−22
- src/CLaSH/Driver.hs +1/−4
- src/CLaSH/Netlist.hs +3/−6
- src/CLaSH/Netlist/BlackBox.hs +2/−3
- src/CLaSH/Netlist/BlackBox/Types.hs +2/−1
- src/CLaSH/Netlist/Types.hs +2/−3
- src/CLaSH/Netlist/Util.hs +2/−1
- src/CLaSH/Netlist/VHDL.hs +59/−59
- src/CLaSH/Primitives/Types.hs +3/−4
- src/CLaSH/Rewrite/Types.hs +3/−2
clash-lib.cabal view
@@ -1,5 +1,5 @@ Name: clash-lib-Version: 0.2+Version: 0.2.0.1 Synopsis: CAES Language for Synchronous Hardware - As a Library Description: CλaSH (pronounced ‘clash’) is a functional hardware description language that@@ -42,7 +42,7 @@ source-repository head type: git- location: git@github.com:christiaanb/clash2.git+ location: https://github.com/christiaanb/clash2.git Library HS-Source-Dirs: src@@ -50,30 +50,30 @@ default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs - Build-depends: aeson >= 0.6.0.2,- attoparsec >= 0.10.2.0,- base >= 4.3.1.0 && < 5,- bytestring >= 0.9.2.1,- concurrent-supply >= 0.1.3,- containers >= 0.4.2.1,- directory >= 1.1.0.2,- errors >= 1.4.1,+ Build-depends: aeson >= 0.6.2.0,+ attoparsec >= 0.10.4.0,+ base >= 4.6.0.1 && < 5,+ bytestring >= 0.10.0.2,+ concurrent-supply >= 0.1.7,+ containers >= 0.5.0.0,+ directory >= 1.2.0.1,+ errors >= 1.4.2, fgl >= 5.4.2.4,- filepath >= 1.3.0.0,- hashable >= 1.1.2.3,- lens >= 3.7.1,- listlike-instances >= 0.2.3.1,- mtl >= 2.0.1.0,+ filepath >= 1.3.0.1,+ hashable >= 1.2.1.0,+ lens >= 3.9.2,+ ListLike >= 4.0.0,+ mtl >= 2.1.2, pretty >= 1.1.1.0, process >= 1.1.0.2,- template-haskell >= 2.7.0.0,- text >= 0.11.1.13,+ template-haskell >= 2.8.0.0,+ text >= 0.11.3.1, time >= 1.4.0.1,- transformers >= 0.2.2.0,- unbound >= 0.4.0.2,- unordered-containers >= 0.2.1.0,- uu-parsinglib >= 2.7.4,- wl-pprint-text >= 1.0.0.0+ transformers >= 0.3.0.0,+ unbound >= 0.4.2,+ unordered-containers >= 0.2.3.3,+ uu-parsinglib >= 2.8.1,+ wl-pprint-text >= 1.1.0.0 Exposed-modules: CLaSH.Core.DataCon CLaSH.Core.FreeVars
src/CLaSH/Driver.hs view
@@ -1,6 +1,3 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TemplateHaskell #-} -- | Module that connects all the parts of the CLaSH compiler library@@ -59,7 +56,7 @@ (\var _ -> isSuffixOf "expectedOutput" $ name2String var) bindingsMap - case topEntities of+ start `seq` case topEntities of [topEntity] -> do -- Create unique supplies for normalisation and TB generation (supplyN,supplyTB) <- Supply.splitSupply
src/CLaSH/Netlist.hs view
@@ -10,7 +10,6 @@ import qualified Control.Monad as Monad import Control.Monad.State (runStateT) import Control.Monad.Writer (listen, runWriterT)-import qualified Data.ByteString.Lazy.Char8 as LZ import Data.Either (partitionEithers) import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Lazy as HashMap@@ -253,7 +252,7 @@ | all (\e -> isConstant e || isVar e) args' -> mkDcApplication hwTy dc args' | otherwise -> error $ $(curLoc) ++ "Not in normal form: DataCon-application with non-Simple arguments" Prim nm _ -> do- bbM <- fmap (HashMap.lookup . LZ.pack $ name2String nm) $ Lens.use primitives+ bbM <- fmap (HashMap.lookup . Text.pack $ name2String nm) $ Lens.use primitives case bbM of Just p@(P.BlackBox {}) -> case template p of@@ -299,10 +298,8 @@ EQ -> return (HW.DataCon dstHType (Just $ DC (dstHType,0)) argExprs) LT -> error $ $(curLoc) ++ "Over-applied constructor" GT -> error $ $(curLoc) ++ "Under-applied constructor"- Sum _ dcs ->- let dcNameBS = Text.pack . name2String $ dcName dc- dcI = fromMaybe (error "Sum: dc not found") $ elemIndex dcNameBS dcs- in return (HW.DataCon dstHType (Just $ DC (dstHType,dcI)) [])+ Sum _ _ ->+ return (HW.DataCon dstHType (Just $ DC (dstHType,dcTag dc - 1)) []) Bool -> let dc' = case name2String $ dcName dc of "True" -> HW.Literal Nothing (BoolLit True)
src/CLaSH/Netlist/BlackBox.hs view
@@ -13,7 +13,6 @@ import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.Maybe (MaybeT (..)) import Control.Monad.Writer (tell)-import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Either (lefts, partitionEithers) import qualified Data.HashMap.Lazy as HashMap import Data.List (partition)@@ -96,7 +95,7 @@ _ -> fmap (first (first Left)) $ mkLitInput e where mkInput' nm args = do- bbM <- fmap (HashMap.lookup . BSL.pack $ name2String nm) $ Lens.use primitives+ bbM <- fmap (HashMap.lookup . pack $ name2String nm) $ Lens.use primitives case bbM of Just p@(P.BlackBox {}) -> do i <- lift $ varCount <<%= (+1)@@ -142,7 +141,7 @@ -> MaybeT NetlistMonad ((BlackBoxTemplate,BlackBoxContext),[Declaration]) mkFunInput resId e = case collectArgs e of (Prim nm _, args) -> do- bbM <- fmap (HashMap.lookup . BSL.pack $ name2String nm) $ Lens.use primitives+ bbM <- fmap (HashMap.lookup . pack $ name2String nm) $ Lens.use primitives case bbM of Just p@(P.BlackBox {}) -> do (bbCtx,dcls) <- lift $ mkBlackBoxContext resId (lefts args)
src/CLaSH/Netlist/BlackBox/Types.hs view
@@ -2,6 +2,7 @@ -- | Types used in BlackBox modules module CLaSH.Netlist.BlackBox.Types where +import Control.Applicative (Applicative) import Control.Monad.State (MonadState, State) import Control.Monad.Writer (MonadWriter,WriterT) import Data.Text.Lazy (Text)@@ -53,4 +54,4 @@ -- | Monad that caches VHDL information and remembers hidden inputs of -- black boxes that are being generated (WriterT) newtype BlackBoxMonad a = B { runBlackBoxM :: WriterT [(Identifier,HWType)] (State VHDLState) a }- deriving (Functor, Monad, MonadWriter [(Identifier,HWType)], MonadState VHDLState)+ deriving (Functor, Applicative, Monad, MonadWriter [(Identifier,HWType)], MonadState VHDLState)
src/CLaSH/Netlist/Types.hs view
@@ -7,7 +7,6 @@ import Control.Monad.State (MonadIO, MonadState, StateT) import Control.Monad.Writer (MonadWriter, WriterT)-import Data.ByteString.Lazy (ByteString) import Data.Hashable import Data.HashMap.Lazy (HashMap) import Data.HashSet (HashSet)@@ -19,7 +18,7 @@ import CLaSH.Core.Term (Term, TmName) import CLaSH.Core.Type (Type) import CLaSH.Core.Util (Gamma)-import CLaSH.Primitives.Types (Primitive)+import CLaSH.Primitives.Types (PrimMap) import CLaSH.Util -- | Monad that caches generated components (StateT) and remembers hidden inputs@@ -45,7 +44,7 @@ , _varCount :: Int -- ^ Number of signal declarations , _cmpCount :: Int -- ^ Number of create components , _components :: HashMap TmName Component -- ^ Cached components- , _primitives :: HashMap ByteString Primitive -- ^ Primitive Definitions+ , _primitives :: PrimMap -- ^ Primitive Definitions , _vhdlMState :: VHDLState -- ^ State for the 'CLaSH.Netlist.VHDL.VHDLM' Monad , _typeTranslator :: Type -> Maybe (Either String HWType) -- ^ Hardcoded Type -> HWType translator }
src/CLaSH/Netlist/Util.hs view
@@ -25,6 +25,7 @@ splitTyConAppM, tyView) import CLaSH.Core.Util (collectBndrs, termType) import CLaSH.Core.Var (Id, Var (..), modifyVarName)+import CLaSH.Netlist.Id import CLaSH.Netlist.Types import CLaSH.Util @@ -168,7 +169,7 @@ -- is not a variable. varToExpr :: Term -> Expr-varToExpr (Var _ var) = Identifier (pack $ name2String var) Nothing+varToExpr (Var _ var) = Identifier (mkBasicId . pack $ name2String var) Nothing varToExpr _ = error "not a var" -- | Uniquely rename all the variables and their references in a normalized
src/CLaSH/Netlist/VHDL.hs view
@@ -17,12 +17,11 @@ import qualified Control.Applicative as A import Control.Lens hiding (Indexed)-import Control.Monad (liftM,zipWithM)+import Control.Monad (liftM,when,zipWithM) import Control.Monad.State (State) import Data.Graph.Inductive (Gr, mkGraph, topsort') import qualified Data.HashMap.Lazy as HashMap import qualified Data.HashSet as HashSet-import Data.List (nub) import Data.Maybe (catMaybes,mapMaybe) import Data.Text.Lazy (unpack) import qualified Data.Text.Lazy as T@@ -36,20 +35,13 @@ -- | Generate VHDL for a Netlist component genVHDL :: Component -> VHDLM (String,Doc)-genVHDL c = do- _1 %= (\s -> foldr HashSet.insert s needsDec)- (unpack cName,) A.<$> vhdl+genVHDL c = (unpack cName,) A.<$> vhdl where cName = componentName c- vhdl = tyImports (not $ null needsDec) <$$> linebreak <>+ vhdl = tyImports <$$> linebreak <> entity c <$$> linebreak <> architecture c - tys = snd (output c)- : map snd (inputs c)- ++ concatMap (\d -> case d of {(NetDecl _ ty _) -> [ty]; _ -> []}) (declarations c)- needsDec = nub $ concatMap needsTyDec tys- -- | Generate a VHDL package containing type definitions for the given HWTypes mkTyPackage :: [HWType] -> VHDLM Doc@@ -90,14 +82,14 @@ in concatMap (\(_,tys) -> mapMaybe (\ty -> liftM (ti,,()) (HashMap.lookup ty nodesI)) tys) ctys edge _ = [] -needsTyDec :: HWType -> [HWType]-needsTyDec (Vector _ Bit) = []-needsTyDec (Vector _ elTy) = needsTyDec elTy ++ [Vector 0 elTy]-needsTyDec ty@(Product _ tys) = concatMap needsTyDec tys ++ [ty]-needsTyDec (SP _ tys) = concatMap (concatMap needsTyDec . snd) tys-needsTyDec Bool = [Bool]-needsTyDec Integer = [Integer]-needsTyDec _ = []+needsTyDec :: HWType -> Bool+needsTyDec (Vector _ Bit) = False+needsTyDec (Vector _ _) = True+needsTyDec (Product _ _) = True+needsTyDec (SP _ _) = True+needsTyDec Bool = True+needsTyDec Integer = True+needsTyDec _ = False tyDec :: HWType -> VHDLM Doc tyDec Bool = "function" <+> "toSLV" <+> parens ("b" <+> colon <+> "in" <+> "boolean") <+> "return" <+> "std_logic_vector" <> semi@@ -137,29 +129,14 @@ funDec _ = return Nothing -tyName :: HWType -> VHDLM Doc-tyName Integer = "integer"-tyName Bit = "std_logic"-tyName (Vector n Bit) = "std_logic_vector_" <> int n-tyName (Vector n elTy) = "array_of_" <> int n <> "_" <> tyName elTy-tyName (Signed n) = "signed_" <> int n-tyName (Unsigned n) = "unsigned_" <> int n-tyName t@(Sum _ _) = "unsigned_" <> int (typeSize t)-tyName t@(Product _ _) = makeCached t _3 prodName- where- prodName = do i <- _2 <<%= (+1)- "product" <> int i--tyName _ = empty--tyImports :: Bool -> VHDLM Doc-tyImports needsDec =- punctuate' semi $ sequence $ concat- [ [ "library IEEE"- , "use IEEE.STD_LOGIC_1164.ALL"- , "use IEEE.NUMERIC_STD.ALL"- , "use work.all" ]- , if needsDec then ["use work.types.all"] else []+tyImports :: VHDLM Doc+tyImports =+ punctuate' semi $ sequence+ [ "library IEEE"+ , "use IEEE.STD_LOGIC_1164.ALL"+ , "use IEEE.NUMERIC_STD.ALL"+ , "use work.all"+ , "use work.types.all" ] @@ -195,25 +172,30 @@ -- | Convert a Netlist HWType to a VHDL type vhdlType :: HWType -> VHDLM Doc-vhdlType Bit = "std_logic"-vhdlType Bool = "boolean"-vhdlType (Clock _) = "std_logic"-vhdlType (Reset _) = "std_logic"-vhdlType Integer = "integer"-vhdlType (Signed n) = "signed" <>+vhdlType hwty = do+ when (needsTyDec hwty) (_1 %= HashSet.insert hwty)+ vhdlType' hwty++vhdlType' :: HWType -> VHDLM Doc+vhdlType' Bit = "std_logic"+vhdlType' Bool = "boolean"+vhdlType' (Clock _) = "std_logic"+vhdlType' (Reset _) = "std_logic"+vhdlType' Integer = "integer"+vhdlType' (Signed n) = "signed" <> parens ( int (n-1) <+> "downto 0")-vhdlType (Unsigned n) = "unsigned" <>+vhdlType' (Unsigned n) = "unsigned" <> parens ( int (n-1) <+> "downto 0")-vhdlType (Vector n Bit) = "std_logic_vector" <> parens ( int (n-1) <+> "downto 0")-vhdlType (Vector n elTy) = "array_of_" <> tyName elTy <> parens ( int (n-1) <+> "downto 0")-vhdlType t@(SP _ _) = "std_logic_vector" <>+vhdlType' (Vector n Bit) = "std_logic_vector" <> parens ( int (n-1) <+> "downto 0")+vhdlType' (Vector n elTy) = "array_of_" <> tyName elTy <> parens ( int (n-1) <+> "downto 0")+vhdlType' t@(SP _ _) = "std_logic_vector" <> parens ( int (typeSize t - 1) <+> "downto 0" )-vhdlType t@(Sum _ _) = "unsigned" <>+vhdlType' t@(Sum _ _) = "unsigned" <> parens ( int (typeSize t -1) <+> "downto 0")-vhdlType t@(Product _ _) = tyName t-vhdlType t = error $ "vhdlType: " ++ show t+vhdlType' t@(Product _ _) = tyName t+vhdlType' t = error $ "vhdlType: " ++ show t -- | Convert a Netlist HWType to the root of a VHDL type vhdlTypeMark :: HWType -> VHDLM Doc@@ -231,6 +213,22 @@ vhdlTypeMark t@(Product _ _) = tyName t vhdlTypeMark t = error $ "vhdlTypeMark: " ++ show t +tyName :: HWType -> VHDLM Doc+tyName Integer = "integer"+tyName Bit = "std_logic"+tyName Bool = "boolean"+tyName (Vector n Bit) = "std_logic_vector_" <> int n+tyName (Vector n elTy) = "array_of_" <> int n <> "_" <> tyName elTy+tyName (Signed n) = "signed_" <> int n+tyName (Unsigned n) = "unsigned_" <> int n+tyName t@(Sum _ _) = "unsigned_" <> int (typeSize t)+tyName t@(Product _ _) = makeCached t _3 prodName+ where+ prodName = do i <- _2 <<%= (+1)+ "product" <> int i++tyName _ = empty+ -- | Convert a Netlist HWType to a default VHDL value for that type vhdlTypeDefault :: HWType -> VHDLM Doc vhdlTypeDefault Bit = "'0'"@@ -270,11 +268,13 @@ text id_ <+> larrow <+> expr False e <> semi inst (CondAssignment id_ scrut es) = fmap Just $- text id_ <+> larrow <+> align (vcat (mapM cond es)) <> semi+ text id_ <+> larrow <+> align (vcat (conds es)) <> semi where- cond :: (Maybe Expr,Expr) -> VHDLM Doc- cond (Nothing,e) = expr False e- cond (Just c ,e) = expr False e <+> "when" <+> parens (expr True scrut <+> "=" <+> expr True c) <+> "else"+ conds :: [(Maybe Expr,Expr)] -> VHDLM [Doc]+ conds [] = return []+ conds [(_,e)] = expr False e <:> return []+ conds ((Nothing,e):_) = expr False e <:> return []+ conds ((Just c ,e):es') = (expr False e <+> "when" <+> parens (expr True scrut <+> "=" <+> expr True c) <+> "else") <:> conds es' inst (InstDecl nm lbl pms) = fmap Just $ nest 2 $ text lbl <> "_comp_inst" <+> colon <+> "entity"
src/CLaSH/Primitives/Types.hs view
@@ -5,24 +5,23 @@ import Control.Applicative ((<$>), (<*>), (<|>)) import Data.Aeson (FromJSON (..), Value (..), (.:))-import Data.ByteString.Lazy (ByteString) import Data.HashMap.Lazy (HashMap) import qualified Data.HashMap.Strict as H import Data.Text.Lazy (Text) -- | Primitive Definitions-type PrimMap = HashMap ByteString Primitive+type PrimMap = HashMap Text Primitive -- | Externally defined primitive data Primitive -- | A primitive that has a template that can be filled out by the backend render = BlackBox- { name :: ByteString -- ^ Name of the primitive+ { name :: Text -- ^ Name of the primitive , template :: Either Text Text -- ^ Either a /declaration/ or an /expression/ template. } -- | A primitive that carries additional information | Primitive- { name :: ByteString -- ^ Name of the primitive+ { name :: Text -- ^ Name of the primitive , primType :: Text -- ^ Additional information }
src/CLaSH/Rewrite/Types.hs view
@@ -74,8 +74,9 @@ -- | MTL convenience wrapper around 'RewriteMonad' newtype R m a = R { runR :: RewriteMonad m a }- deriving ( Monad- , Functor+ deriving ( Functor+ , Applicative+ , Monad , MonadReader RewriteEnv , MonadState RewriteState , MonadWriter Any