diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Language/Netlist/AST.hs b/Language/Netlist/AST.hs new file mode 100644 --- /dev/null +++ b/Language/Netlist/AST.hs @@ -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 diff --git a/Language/Netlist/Examples.hs b/Language/Netlist/Examples.hs new file mode 100644 --- /dev/null +++ b/Language/Netlist/Examples.hs @@ -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 + +-- ----------------------------------------------------------------------------- diff --git a/Language/Netlist/Inline.hs b/Language/Netlist/Inline.hs new file mode 100644 --- /dev/null +++ b/Language/Netlist/Inline.hs @@ -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 + +-- ----------------------------------------------------------------------------- diff --git a/Language/Netlist/Util.hs b/Language/Netlist/Util.hs new file mode 100644 --- /dev/null +++ b/Language/Netlist/Util.hs @@ -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 + +-- ----------------------------------------------------------------------------- diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/netlist.cabal b/netlist.cabal new file mode 100644 --- /dev/null +++ b/netlist.cabal @@ -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.*