netlist (empty) → 0.2
raw patch · 7 files changed
+976/−0 lines, 7 filesdep +basedep +binarydep +containerssetup-changed
Dependencies added: base, binary, containers, syb
Files
- LICENSE +27/−0
- Language/Netlist/AST.hs +597/−0
- Language/Netlist/Examples.hs +65/−0
- Language/Netlist/Inline.hs +137/−0
- Language/Netlist/Util.hs +114/−0
- Setup.hs +2/−0
- netlist.cabal +34/−0
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright 2010, Signali Corp.++All Rights Reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:+1. Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.+2. Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.+3. Neither the name of the author nor the names of other contributors+ may be used to endorse or promote products derived from this software+ without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND+ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE+IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS+OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)+HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT+LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY+OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF+SUCH DAMAGE.
+ Language/Netlist/AST.hs view
@@ -0,0 +1,597 @@+--------------------------------------------------------------------------------+-- |+-- Module : Language.Netlist.AST+-- Copyright : (c) Signali Corp. 2010+-- License : All rights reserved+--+-- Maintainer : pweaver@signalicorp.com+-- Stability : experimental+-- Portability : non-portable (DeriveDataTypeable)+--+-- An abstract syntax tree (AST) for a generic netlist, kind of like a+-- high-level subset of Verilog and VHDL that is compatible with both languages.+--+-- There are no definitive semantics assigned to this AST.+--+-- For example, the user may choose to treat the bindings as recursive, so that+-- expressions can reference variables before their declaration, like in+-- Haskell, which is not supported in Verilog and VHDL. in this case, the user+-- must fix the bindings when converting to an HDL.+--+-- Also, the user may treat module instantiations and processes as having an+-- implict clock/reset, so that they are not explicitly named in those+-- constructs in this AST. Then, the clock and reset can be inserted when+-- generating HDL.+--+-- When you instantiate a module but information about that module is missing+-- (e.g. the clock/reset are implicit and you need to know what they are called+-- in that module), you can use ExternDecl (TODO) to declare a module's+-- interface so that you know how to instantiate it, or retrieve the interface+-- from a user-maintained database or by parsing and extracting from an HDL+-- file.+--------------------------------------------------------------------------------++{-# LANGUAGE DeriveDataTypeable #-}+{-# OPTIONS_GHC -Wall #-}+{-# OPTIONS_DERIVE --append -d Binary #-}++module Language.Netlist.AST where++import Data.Binary ( Binary(..), putWord8, getWord8 )+import Data.Generics ( Data, Typeable )++-- -----------------------------------------------------------------------------++-- | A Module corresponds to a \"module\" in Verilog or an \"entity\" in VHDL.+data Module = Module+ { module_name :: Ident+ , module_inputs :: [(Ident, Maybe Range)]+ , module_outputs :: [(Ident, Maybe Range)]+ , module_statics :: [(Ident, ConstExpr)]+ -- static parameters (VHDL "generic", Verilog "parameter")+ , module_decls :: [Decl]+ }+ deriving (Eq, Ord, Show, Data, Typeable)++-- | An identifier name.+type Ident = String++-- | The size of a wire.+type Size = Int++-- | A declaration, analogous to an \"item\" in the Verilog formal syntax.+data Decl+ -- | A net (@wire@ in Verilog) has a continuously assigned value. The net can+ -- be declared and assigned at the same time (@Just Expr@), or separately+ -- (@Nothing@) in a @NetAssign@.+ = NetDecl Ident (Maybe Range) (Maybe Expr)+ | NetAssign Ident Expr++ -- | A mem (@reg@ in Verilog) is stateful. It can be assigned by a+ -- non-blocking assignment (or blocking, but we don't support those yet)+ -- within a process. TODO: support optional initial value+ --+ -- The first range is the most significant dimension.+ -- So, @MemDecl x (0, 31) (7, 0)@ corresponds to the following in Verilog:+ -- @reg [7:0] x [0:31]@+ | MemDecl Ident (Maybe Range) (Maybe Range)++ -- | A module/entity instantiation. The arguments are the name of the module,+ -- the name of the instance, the parameter assignments, the input port+ -- connections, and the output port connections.+ | InstDecl Ident -- name of the module+ Ident -- name of the instance+ [(Ident, Expr)] -- parameter assignments+ [(Ident, Expr)] -- input port connections+ [(Ident, Expr)] -- output port connections++ -- declare an external module entity+ -- TODO: ExternDecl ExternLang++ -- | A general process construct, compatible with both VHDL and Verilog+ -- processes. It supports positive and negative edge triggers and a body (a+ -- statement) for each trigger. Here are loose semantics of a process+ -- @[(trigger0, stmt0), (trigger1, stmt1)...]@:+ --+ -- @+ -- if trigger0+ -- statement0+ -- else if+ -- trigger1+ -- ...+ -- @++ | ProcessDecl [(Event, Stmt)]++ -- | A statement that executes once at the beginning of simulation.+ -- Equivalent to Verilog \"initial\" statement.+ | InitProcessDecl Stmt++ -- | A basic comment (typically is placed above a decl of interest).+ -- Newlines are allowed, and generate new single line comments.+ | CommentDecl String++ deriving (Eq, Ord, Show, Data, Typeable)++-- | A 'Range' tells us the type of a bit vector. It can count up or down.+data Range+ = Range ConstExpr ConstExpr+ deriving (Eq, Ord, Show, Data, Typeable)++-- | A constant expression is simply an expression that must be a constant+-- (i.e. the only free variables are static parameters). This restriction is+-- not made in the AST.+type ConstExpr = Expr++data Event+ = Event Expr Edge+ deriving (Eq, Ord, Show, Data, Typeable)++-- | An event can be triggered by the rising edge ('PosEdge') or falling edge+-- ('NegEdge') of a signal.+data Edge+ = PosEdge+ | NegEdge+ | AsyncHigh+ | AsyncLow+ -- TODO: AnyEdge?+ deriving (Eq, Ord, Show, Data, Typeable)++-- | Expr is a combination of VHDL and Verilog expressions.+--+-- In VHDL, concatenation is a binary operator, but in Verilog it takes any+-- number of arguments. In this AST, we define it like the Verilog operator.+-- If we translate to VHDL, we have to convert it to the VHDL binary operator.+--+-- There are some HDL operators that we don't represent here. For example, in+-- Verilog there is a multiple concatenation (a.k.a. replication) operator,+-- which we don't bother to support.++data Expr+ = ExprLit (Maybe Size) ExprLit -- ^ a sized or unsized literal+ | ExprVar Ident -- ^ a variable ference+ | ExprString String -- ^ a quoted string (useful for parameters)++ | ExprIndex Ident Expr -- ^ @x[e]@+ | ExprSlice Ident Expr Expr -- ^ @x[e1 : e2]@+ | ExprSliceOff Ident Expr Int -- ^ @x[e : e+i]@, where @i@ can be negative+ | ExprCase Expr [([ConstExpr], Expr)] (Maybe Expr)+ -- ^ case expression. supports multiple matches+ -- per result value, and an optional default value+ | ExprConcat [Expr] -- ^ concatenation+ | ExprCond Expr Expr Expr -- ^ conditional expression+ | ExprUnary UnaryOp Expr -- ^ application of a unary operator+ | ExprBinary BinaryOp Expr Expr -- ^ application of a binary operator+ | ExprFunCall Ident [Expr] -- ^ a function application+ deriving (Eq, Ord, Show, Data, Typeable)++data ExprLit+ = ExprNum Integer -- ^ a number+ | ExprBit Bit -- ^ a single bit. in vhdl, bits are different than 1-bit bitvectors+ | ExprBitVector [Bit]+ deriving (Eq, Ord, Show, Data, Typeable)++data Bit+ = T | F | U | Z+ deriving (Eq, Ord, Show, Data, Typeable)++-- | Behavioral sequential statement+data Stmt+ = Assign LValue Expr -- ^ non-blocking assignment+ | If Expr Stmt (Maybe Stmt) -- ^ @if@ statement+ | Case Expr [([Expr], Stmt)] (Maybe Stmt)+ -- ^ case statement, with optional default case+ | Seq [Stmt] -- ^ multiple statements in sequence+ | FunCallStmt Ident [Expr] -- ^ a function call that can appear as a statement,+ -- useful for calling Verilog tasks (e.g. $readmem).+ deriving (Eq, Ord, Show, Data, Typeable)++-- | An 'LValue' is something that can appear on the left-hand side of an+-- assignment. We're lazy and do not enforce any restriction, and define this+-- simply to be 'Expr'.+type LValue = Expr++-- | Unary operators+--+-- 'LNeg' is logical negation, 'Neg' is bitwise negation. 'UAnd', 'UNand',+-- 'UOr', 'UNor', 'UXor', and 'UXnor' are sometimes called \"reduction+-- operators\".++data UnaryOp+ = UPlus | UMinus | LNeg | Neg | UAnd | UNand | UOr | UNor | UXor | UXnor+ deriving (Eq, Ord, Show, Data, Typeable)++-- | Binary operators.+--+-- These operators include almost all VHDL and Verilog operators.+--+-- * precedence and pretty-printing are language specific, and defined elsewhere.+--+-- * exponentation operators were introduced in Verilog-2001.+--+-- * some operators are not prefix/infix, such as verilog concatenation and the+-- conditional (@x ? y : z@) operator. those operators are defined in+-- 'Expr'.+--+-- * VHDL has both \"logical\" and \"barithmetic\" shift operators, which we+-- don't yet distinguish between here.+--+-- * VHDL has both a @mod@ and a @rem@ operator, but so far we only define+-- 'Modulo'.+--+-- * VHDL has a concat operator (@&@) that isn't yet supported here. Use+-- 'ExprConcat' instead.+--+-- * VHDL has an @abs@ operator that isn't yet supported here.++data BinaryOp+ = Pow | Plus | Minus | Times | Divide | Modulo -- arithmetic+ | Equals | NotEquals -- logical equality+ | CEquals | CNotEquals -- case equality+ | LAnd | LOr -- logical and/or+ | LessThan | LessEqual | GreaterThan | GreaterEqual -- relational+ | And | Nand | Or | Nor | Xor | Xnor -- bitwise+ | ShiftLeft | ShiftRight | RotateLeft | RotateRight -- shift/rotate+ deriving (Eq, Ord, Show, Data, Typeable)++-- -----------------------------------------------------------------------------+-- GENERATED START+++instance Binary Module where+ put (Module x1 x2 x3 x4 x5)+ = do put x1+ put x2+ put x3+ put x4+ put x5+ get+ = do x1 <- get+ x2 <- get+ x3 <- get+ x4 <- get+ x5 <- get+ return (Module x1 x2 x3 x4 x5)+++instance Binary Decl where+ put x+ = case x of+ NetDecl x1 x2 x3 -> do putWord8 0+ put x1+ put x2+ put x3+ NetAssign x1 x2 -> do putWord8 1+ put x1+ put x2+ MemDecl x1 x2 x3 -> do putWord8 2+ put x1+ put x2+ put x3+ InstDecl x1 x2 x3 x4 x5 -> do putWord8 3+ put x1+ put x2+ put x3+ put x4+ put x5+ ProcessDecl x1 -> do putWord8 4+ put x1+ InitProcessDecl x1 -> do putWord8 5+ put x1+ CommentDecl x1 -> do putWord8 6+ put x1+ get+ = do i <- getWord8+ case i of+ 0 -> do x1 <- get+ x2 <- get+ x3 <- get+ return (NetDecl x1 x2 x3)+ 1 -> do x1 <- get+ x2 <- get+ return (NetAssign x1 x2)+ 2 -> do x1 <- get+ x2 <- get+ x3 <- get+ return (MemDecl x1 x2 x3)+ 3 -> do x1 <- get+ x2 <- get+ x3 <- get+ x4 <- get+ x5 <- get+ return (InstDecl x1 x2 x3 x4 x5)+ 4 -> do x1 <- get+ return (ProcessDecl x1)+ 5 -> do x1 <- get+ return (InitProcessDecl x1)+ 6 -> do x1 <- get+ return (CommentDecl x1)+ _ -> error "Corrupted binary data for Decl"+++instance Binary Range where+ put (Range x1 x2)+ = do put x1+ put x2+ get+ = do x1 <- get+ x2 <- get+ return (Range x1 x2)+++instance Binary Event where+ put (Event x1 x2)+ = do put x1+ put x2+ get+ = do x1 <- get+ x2 <- get+ return (Event x1 x2)+++instance Binary Edge where+ put x+ = case x of+ PosEdge -> putWord8 0+ NegEdge -> putWord8 1+ get+ = do i <- getWord8+ case i of+ 0 -> return PosEdge+ 1 -> return NegEdge+ _ -> error "Corrupted binary data for Edge"+++instance Binary Expr where+ put x+ = case x of+ ExprLit x1 x2 -> do putWord8 0+ put x1+ put x2+ ExprVar x1 -> do putWord8 1+ put x1+ ExprString x1 -> do putWord8 2+ put x1+ ExprIndex x1 x2 -> do putWord8 3+ put x1+ put x2+ ExprSlice x1 x2 x3 -> do putWord8 4+ put x1+ put x2+ put x3+ ExprSliceOff x1 x2 x3 -> do putWord8 5+ put x1+ put x2+ put x3+ ExprCase x1 x2 x3 -> do putWord8 6+ put x1+ put x2+ put x3+ ExprConcat x1 -> do putWord8 7+ put x1+ ExprCond x1 x2 x3 -> do putWord8 8+ put x1+ put x2+ put x3+ ExprUnary x1 x2 -> do putWord8 9+ put x1+ put x2+ ExprBinary x1 x2 x3 -> do putWord8 10+ put x1+ put x2+ put x3+ ExprFunCall x1 x2 -> do putWord8 11+ put x1+ put x2+ get+ = do i <- getWord8+ case i of+ 0 -> do x1 <- get+ x2 <- get+ return (ExprLit x1 x2)+ 1 -> do x1 <- get+ return (ExprVar x1)+ 2 -> do x1 <- get+ return (ExprString x1)+ 3 -> do x1 <- get+ x2 <- get+ return (ExprIndex x1 x2)+ 4 -> do x1 <- get+ x2 <- get+ x3 <- get+ return (ExprSlice x1 x2 x3)+ 5 -> do x1 <- get+ x2 <- get+ x3 <- get+ return (ExprSliceOff x1 x2 x3)+ 6 -> do x1 <- get+ x2 <- get+ x3 <- get+ return (ExprCase x1 x2 x3)+ 7 -> do x1 <- get+ return (ExprConcat x1)+ 8 -> do x1 <- get+ x2 <- get+ x3 <- get+ return (ExprCond x1 x2 x3)+ 9 -> do x1 <- get+ x2 <- get+ return (ExprUnary x1 x2)+ 10 -> do x1 <- get+ x2 <- get+ x3 <- get+ return (ExprBinary x1 x2 x3)+ 11 -> do x1 <- get+ x2 <- get+ return (ExprFunCall x1 x2)+ _ -> error "Corrupted binary data for Expr"+++instance Binary ExprLit where+ put x+ = case x of+ ExprNum x1 -> do putWord8 0+ put x1+ ExprBit x1 -> do putWord8 1+ put x1+ ExprBitVector x1 -> do putWord8 2+ put x1+ get+ = do i <- getWord8+ case i of+ 0 -> do x1 <- get+ return (ExprNum x1)+ 1 -> do x1 <- get+ return (ExprBit x1)+ 2 -> do x1 <- get+ return (ExprBitVector x1)+ _ -> error "Corrupted binary data for ExprLit"+++instance Binary Bit where+ put x+ = case x of+ T -> putWord8 0+ F -> putWord8 1+ U -> putWord8 2+ Z -> putWord8 3+ get+ = do i <- getWord8+ case i of+ 0 -> return T+ 1 -> return F+ 2 -> return U+ 3 -> return Z+ _ -> error "Corrupted binary data for Bit"+++instance Binary Stmt where+ put x+ = case x of+ Assign x1 x2 -> do putWord8 0+ put x1+ put x2+ If x1 x2 x3 -> do putWord8 1+ put x1+ put x2+ put x3+ Case x1 x2 x3 -> do putWord8 2+ put x1+ put x2+ put x3+ Seq x1 -> do putWord8 3+ put x1+ FunCallStmt x1 x2 -> do putWord8 4+ put x1+ put x2+ get+ = do i <- getWord8+ case i of+ 0 -> do x1 <- get+ x2 <- get+ return (Assign x1 x2)+ 1 -> do x1 <- get+ x2 <- get+ x3 <- get+ return (If x1 x2 x3)+ 2 -> do x1 <- get+ x2 <- get+ x3 <- get+ return (Case x1 x2 x3)+ 3 -> do x1 <- get+ return (Seq x1)+ 4 -> do x1 <- get+ x2 <- get+ return (FunCallStmt x1 x2)+ _ -> error "Corrupted binary data for Stmt"+++instance Binary UnaryOp where+ put x+ = case x of+ UPlus -> putWord8 0+ UMinus -> putWord8 1+ LNeg -> putWord8 2+ Neg -> putWord8 3+ UAnd -> putWord8 4+ UNand -> putWord8 5+ UOr -> putWord8 6+ UNor -> putWord8 7+ UXor -> putWord8 8+ UXnor -> putWord8 9+ get+ = do i <- getWord8+ case i of+ 0 -> return UPlus+ 1 -> return UMinus+ 2 -> return LNeg+ 3 -> return Neg+ 4 -> return UAnd+ 5 -> return UNand+ 6 -> return UOr+ 7 -> return UNor+ 8 -> return UXor+ 9 -> return UXnor+ _ -> error "Corrupted binary data for UnaryOp"+++instance Binary BinaryOp where+ put x+ = case x of+ Pow -> putWord8 0+ Plus -> putWord8 1+ Minus -> putWord8 2+ Times -> putWord8 3+ Divide -> putWord8 4+ Modulo -> putWord8 5+ Equals -> putWord8 6+ NotEquals -> putWord8 7+ CEquals -> putWord8 8+ CNotEquals -> putWord8 9+ LAnd -> putWord8 10+ LOr -> putWord8 11+ LessThan -> putWord8 12+ LessEqual -> putWord8 13+ GreaterThan -> putWord8 14+ GreaterEqual -> putWord8 15+ And -> putWord8 16+ Nand -> putWord8 17+ Or -> putWord8 18+ Nor -> putWord8 19+ Xor -> putWord8 20+ Xnor -> putWord8 21+ ShiftLeft -> putWord8 22+ ShiftRight -> putWord8 23+ RotateLeft -> putWord8 24+ RotateRight -> putWord8 25+ get+ = do i <- getWord8+ case i of+ 0 -> return Pow+ 1 -> return Plus+ 2 -> return Minus+ 3 -> return Times+ 4 -> return Divide+ 5 -> return Modulo+ 6 -> return Equals+ 7 -> return NotEquals+ 8 -> return CEquals+ 9 -> return CNotEquals+ 10 -> return LAnd+ 11 -> return LOr+ 12 -> return LessThan+ 13 -> return LessEqual+ 14 -> return GreaterThan+ 15 -> return GreaterEqual+ 16 -> return And+ 17 -> return Nand+ 18 -> return Or+ 19 -> return Nor+ 20 -> return Xor+ 21 -> return Xnor+ 22 -> return ShiftLeft+ 23 -> return ShiftRight+ 24 -> return RotateLeft+ 25 -> return RotateRight+ _ -> error "Corrupted binary data for BinaryOp"+-- GENERATED STOP
+ Language/Netlist/Examples.hs view
@@ -0,0 +1,65 @@+--------------------------------------------------------------------------------+-- |+-- Module : Language.Netlist.Examples+-- Copyright : (c) Signali Corp. 2010+-- License : All rights reserved+--+-- Maintainer : pweaver@signalicorp.com+-- Stability : experimental+-- Portability : non-portable+--+-- Examples of Netlist AST.+--------------------------------------------------------------------------------++{-# LANGUAGE ParallelListComp #-}++module Language.Netlist.Examples where++import Language.Netlist.AST+import Language.Netlist.Util++-- -----------------------------------------------------------------------------++t :: Module+t = Module "foo" (f ins) (f outs) [] ds+ where+ f xs = [ (x, makeRange Down sz) | (x, sz) <- xs ]+ ins = [("clk", 1), ("reset", 1), ("enable", 1), ("x", 16)]+ outs = [("z", 16)]++ds :: [Decl]+ds = [ NetDecl "a" (makeRange Down 16) (Just (ExprVar "x"))+ , NetDecl "b" (makeRange Down 16) (Just (sizedInteger 16 10))+ , MemDecl "c" Nothing (makeRange Down 16)+ , ProcessDecl+ [ (Event (ExprVar "reset") PosEdge, Assign (ExprVar "c") (sizedInteger 16 0))+ , (Event (ExprVar "clk") PosEdge, If (ExprVar "enable")+ (Assign (ExprVar "c") (ExprVar "x"))+ Nothing)+ ]+ ]++var_exprs :: [Expr]+var_exprs = [ ExprVar [x] | x <- "abcdefghijklmnopqrstuvwxyz" ]++stmts :: [Stmt]+stmts = [ Assign x (unsizedInteger i) | x <- var_exprs | i <- [0..] ]++if0 :: Stmt+if0 = If e0 s0 $ Just $+ If e1 s1' $ Just $+ If e2 s2' $ Just s3'+ where+ s1' = Seq [s1, s2, s3]+ s2' = Seq [s4, s5, s6]+ s3' = s7+ (e0:e1:e2:_) = var_exprs+ (s0:s1:s2:s3:s4:s5:s6:s7:_) = stmts++if1 :: Stmt+if1 = If e0 (If e1 s1 Nothing) (Just (If e2 s2 Nothing))+ where+ (e0:e1:e2:_) = var_exprs+ (_:s1:s2:_) = stmts++-- -----------------------------------------------------------------------------
+ Language/Netlist/Inline.hs view
@@ -0,0 +1,137 @@+--------------------------------------------------------------------------------+-- |+-- Module : Language.Netlist.Inline+-- Copyright : (c) Signali Corp. 2010+-- License : All rights reserved+--+-- Maintainer : pweaver@signalicorp.com+-- Stability : experimental+-- Portability : non-portable+--+-- A simple inliner for a Netlist AST ('Language.Netlist.AST').+--------------------------------------------------------------------------------++{-# LANGUAGE Rank2Types, PatternGuards #-}++module Language.Netlist.Inline ( inlineModule ) where++import Data.Generics+--import Data.List+import Data.Maybe+import Data.Map (Map)+import qualified Data.Map as Map++import Language.Netlist.AST++-- -----------------------------------------------------------------------------++-- | Produce a new module in which some variables have been inlined. An+-- expression is inlined (and it\'s declaration removed) if it only used in one+-- place in the entire module.+inlineModule :: Module -> Module+inlineModule (Module name inputs outputs statics decls)+ = Module name inputs outputs statics decls''+ where+ deps = getIdentExprs decls+ bs = getBindings decls+ bs' = Map.filterWithKey (shouldInline (map fst outputs) deps) bs+ decls' = replaceExprs bs' decls+ decls'' = removeDecls (Map.keys bs') decls'++-- given a list of identifier-to-expression bindings, replace the identifiers+-- everywhere in an AST. Note: "everywhere" applies bottom-up. We want+-- everywhere', which is top-down.+replaceExprs :: forall a. (Data a) => Map Ident Expr -> a -> a+replaceExprs bs a = everywhere' (mkT f) a+ where+ f e+ | ExprVar x <- e, Just e' <- Map.lookup x bs+ = e' -- replaceExprs bs e'+ | otherwise = e++-- this is essentially a DCE pass. it removes the declarations that have been inlined.+removeDecls :: [Ident] -> [Decl] -> [Decl]+removeDecls xs = mapMaybe f+ where+ f d@(NetDecl x _ _)+ = if elem x xs then Nothing else Just d+ f d@(NetAssign x _)+ = if elem x xs then Nothing else Just d+ f decl+ = Just decl++-- -----------------------------------------------------------------------------+-- utility functions++getBindings :: [Decl] -> Map Ident Expr+getBindings = Map.unions . map getDeclBinding++getDeclBinding :: Decl -> Map Ident Expr+getDeclBinding (NetDecl x _ (Just expr))+ = Map.singleton x expr+getDeclBinding (NetAssign x expr)+ = Map.singleton x expr+getDeclBinding _+ = Map.empty++shouldInline :: [Ident] -> Map Ident [Expr] -> Ident -> Expr -> Bool+shouldInline ignore deps x e+ | x `notElem` ignore, Just n <- checkUsers+ = case e of+ -- always inline trivial expressions regardless of the number of users.+ ExprLit _ _ -> True+ ExprString _ -> True+ ExprVar _ -> True+ ExprIndex _ _ -> True+ ExprSlice _ _ _ -> True+ -- ExprSliceOff _ _ _ -> True++ -- never inline case expressions. as far as we know, there's no case+ -- /expression/ in Verilog. we leave ExprCase alone here so that it may+ -- be easier to translate to, for example, a case /statement/ in a+ -- combinational process in HDL.+ ExprCase {} -> False++ -- any complex expressions should only be inlined if they're used once.+ _ -> n == 1++ | otherwise+ = False+ where+ -- returns Nothing if this identifier cannot be inlined because it is+ -- referred to by a Index/Project/FuncCall. returns Just n if the only+ -- users are 'n' number of ExprVar expressions.+ checkUsers+ = if all checkUser zs then Just (length zs) else Nothing+ where+ zs = fromMaybe [] (Map.lookup x deps)+ checkUser (ExprVar _) = True+ checkUser _ = False++-- map each identifier to every expression that directly refers to that identifier.+getIdentExprs :: forall a. (Data a) => a -> Map Ident [Expr]+getIdentExprs a = f Map.empty (getAll a)+ where+ f :: Map Ident [Expr] -> [Expr] -> Map Ident [Expr]+ f m [] = m+ f m (expr:rest)+ = f m' rest+ where m' = case maybeExprIdent expr of+ Just v -> Map.insertWith (++) v [expr] m+ Nothing -> m++-- generically get a list of all terms of a certain type.+getAll :: forall a b. (Data a, Typeable b) => a -> [b]+getAll = listify (\_ -> True)++-- if an expression references an identifier directly, return the identifier.+-- note that subexpressions are not counted here!+maybeExprIdent :: Expr -> Maybe Ident+maybeExprIdent (ExprVar x) = Just x+maybeExprIdent (ExprIndex x _) = Just x+maybeExprIdent (ExprSlice x _ _) = Just x+maybeExprIdent (ExprSliceOff x _ _) = Just x+maybeExprIdent (ExprFunCall x _) = Just x+maybeExprIdent _ = Nothing++-- -----------------------------------------------------------------------------
+ Language/Netlist/Util.hs view
@@ -0,0 +1,114 @@+--------------------------------------------------------------------------------+-- |+-- Module : Language.Netlist.Util+-- Copyright : (c) Signali Corp. 2010+-- License : All rights reserved+--+-- Maintainer : pweaver@signalicorp.com+-- Stability : experimental+-- Portability : non-portable+--+-- Utility functions for constructing Netlist AST elements.+--------------------------------------------------------------------------------++module Language.Netlist.Util where++import Language.Netlist.AST++-- -----------------------------------------------------------------------------++data Direction = Up | Down++unsizedInteger :: Integer -> Expr+unsizedInteger = unsizedIntegral++unsizedIntegral :: Integral a => a -> Expr+unsizedIntegral = ExprLit Nothing . ExprNum . toInteger++sizedInteger :: Int -> Integer -> Expr+sizedInteger = sizedIntegral++sizedIntegral :: Integral a => Int -> a -> Expr+sizedIntegral sz = ExprLit (Just sz) . ExprNum . toInteger++-- | Given a direction and size, maybe generate a 'Range', where a size of 1+-- yields 'Nothing'.+makeRange :: Direction -> Size -> Maybe Range+makeRange _ 1 = Nothing+makeRange d sz+ | sz > 1+ = let upper = unsizedIntegral (sz - 1)+ lower = unsizedInteger 0+ in Just $ case d of+ Up -> Range lower upper+ Down -> Range upper lower++ | otherwise+ = error ("makeRange: invalid size: " ++ show sz)++-- | Concatenate a list of expressions, unless there is just one expression.+exprConcat :: [Expr] -> Expr+exprConcat [e] = e+exprConcat es = ExprConcat es++-- | Make a 'Seq' statement from a list of statements, unless there is just one+-- statement.+statements :: [Stmt] -> Stmt+statements [x] = x+statements xs = Seq xs++-- -----------------------------------------------------------------------------++-- | generate a process declaration for a generic register based on the following:+--+-- * the register name (as an expression)+--+-- * clock expression+--+-- * width of the register+--+-- * optional asynchronous reset and initial value+--+-- * optional clock enable+--+-- * optional synchronous restart and initial value+--+-- * optional load enable+--+-- * when enabled, the expression to assign to the identifier+--+-- You can implement a shift register by passing in a concatenation for the+-- register expression and the input expression, though that is not compatible+-- with VHDL.+--++-- TODO+-- * support negative-edge triggered clock/reset, active-low reset/restart+-- * support true clock enable (as opposed to load enable)?++generateReg :: Expr -> Expr -> Maybe (Expr, Expr) -> Maybe (Expr, Expr) ->+ Maybe Expr -> Expr -> Decl+generateReg x clk mb_reset mb_restart mb_enable expr+ = ProcessDecl as+ where+ as = case mb_reset of+ Just (reset, initial)+ -> [ (Event reset PosEdge, Assign x initial), a0]+ Nothing+ -> [a0]++ a0 = (Event clk PosEdge, stmt2)++ stmt2 = case mb_restart of+ Just (restart, initial)+ -> If restart (Assign x initial) (Just stmt1)+ Nothing+ -> stmt1++ stmt1 = case mb_enable of+ Just enable -> If enable stmt0 Nothing+ Nothing -> stmt0++ stmt0 = Assign x expr++-- -----------------------------------------------------------------------------
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple +main = defaultMain
+ netlist.cabal view
@@ -0,0 +1,34 @@+name: netlist+version: 0.2+synopsis: Netlist AST+description: A very simplified and generic netlist designed to be compatible with+ Hardware Description Languages (HDLs) like Verilog and VHDL.+ Includes a simple inliner.+category: Language+license: BSD3+license-file: LICENSE+copyright: Copyright (c) 2010 Signali Corp.+ Copyright (c) 2010 Philip Weaver+author: Philip Weaver+maintainer: philip.weaver@gmail.com+package-url: git://github.com/pheaver/netlist-verilog.git+build-type: Simple+cabal-version: >=1.6++flag base4+ Description: Compile using base-4 instead of base-3+ Default: True++Library+ ghc-options: -Wall++ exposed-modules: Language.Netlist.AST,+ Language.Netlist.Inline,+ Language.Netlist.Util+ other-modules: Language.Netlist.Examples++ build-depends: binary, containers+ if flag(base4)+ build-depends: base == 4.*, syb+ else+ build-depends: base == 3.*