netlist-to-vhdl (empty) → 0.2

raw patch · 4 files changed

+339/−0 lines, 4 filesdep +basedep +netlistdep +prettysetup-changed

Dependencies added: base, netlist, pretty

Files

• LICENSE +25/−0
• Language/Netlist/GenVHDL.hs +283/−0
• Setup.hs +2/−0
• netlist-to-vhdl.cabal +29/−0

@@ -0,0 +1,25 @@+Copyright (c) 2010 The University of Kansas+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. The names of the authors may not 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 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.+

@@ -0,0 +1,283 @@+--------------------------------------------------------------------------------+-- |+-- Module       :  Language.Netlist.GenVHDL+-- Copyright    :  (c) University of Kansas 2010+-- License      :  All rights reserved+--+-- Maintainer   : garrin.kimmell@gmail.com+-- Stability    : experimental+-- Portability  : non-portable+--+-- Translates a Netlist AST ('Language.Netlist.AST') to VHDL.+--------------------------------------------------------------------------------++module Language.Netlist.GenVHDL(genVHDL) where++import Language.Netlist.AST++import Text.PrettyPrint+import Data.Maybe(catMaybes)+import Data.List(nub)+++-- | Generate a 'Language.Netlist.AST.Module' as a VHDL file . The ['String'] argument+-- is the list of extra modules to import, typically [\"work.all\"].+genVHDL :: Module -> [String] -> String+genVHDL m others = render vhdl ++ "\n"+  where+    vhdl  =  imports others $$+             entity m $$+             architecture m++imports :: [String] -> Doc+imports others = vcat+	[ text "library IEEE" <> semi+        , text "use IEEE.STD_LOGIC_1164.ALL" <> semi+        , text "use IEEE.NUMERIC_STD.ALL" <> semi+	] $$ vcat [+          text ("use " ++ other) <> semi+	| other <- others+        ]+++entity :: Module -> Doc+entity m = text "entity" <+> text (module_name m) <+> text "is" $$+            nest 2 (text "port" <> parens (vcat $ punctuate semi ports) <> semi) $$+            text "end" <+> text "entity" <+> text (module_name m) <> semi++  where ports = [text i <+> colon <+> text "in" <+> slv_type ran | (i,ran) <- module_inputs m ] +++                [text i <+> colon <+> text "out" <+> slv_type ran | (i,ran) <- module_outputs m ]+++architecture :: Module -> Doc+architecture m = text "architecture" <+> text "str" <+> text "of" <+>  text (module_name m) <+> text "is" $$+                 nest 2 (decls (module_decls m)) $$+                 text "begin" $$+                 nest 2 (insts (module_decls m)) $$+                 text "end" <+> text "architecture" <+> text "str" <> semi++decls :: [Decl] -> Doc+decls [] = empty+decls ds = (vcat $ punctuate semi $ catMaybes $ map decl ds) <> semi++decl :: Decl -> Maybe Doc+decl (NetDecl i r Nothing) = Just $+  text "signal" <+> text i <+> colon <+> slv_type r++decl (NetDecl i r (Just init)) = Just $+  text "signal" <+> text i <+> colon <+> slv_type r <+> text ":=" <+> expr init++decl (MemDecl i Nothing dsize) = Just $+    text "signal" <+> text i <+> colon <+> slv_type dsize++decl (MemDecl i (Just asize) dsize) = Just $+  text "type" <+> mtype  <+> text "is" <+>+       text "array" <+> range asize <+> text "of" <+> slv_type dsize <> semi $$+  text "signal" <+> text i <> text "_ram" <+> colon <+> mtype+ where mtype = text i <> text "_memory_type"++decl _d = Nothing+++++insts ::  [Decl] -> Doc+insts [] = empty+insts is = case catMaybes $ zipWith inst gensyms is of+             [] -> empty+             is' -> (vcat $ punctuate semi is') <> semi+  where gensyms = ["proc" ++ show i | i <- [(0::Integer)..]]++inst :: String -> Decl -> Maybe Doc+inst _ (NetAssign i e) = Just $ text i <+> text "<=" <+> expr e++inst gensym proc@(ProcessDecl evs) = Just $+    text gensym <+> colon <+> text "process" <> senlist <+> text "is" $$+    text "begin" $$+    nest 2 (pstmts evs) $$+    text "end process" <+> text gensym+  where senlist = parens $ cat $ punctuate comma $ map expr $   mkSensitivityList proc++++inst _ (InstDecl nm inst gens ins outs) = Just $+  text inst <+> colon <+> text "entity" <+> text nm $$+       gs $$+       ps+ where+   gs | null gens = empty+      | otherwise =+        text "generic map" <+>+         (parens (cat (punctuate comma  [text i <+> text "=>" <+> expr e | (i,e) <- gens])))+   -- Assume that ports is never null+   ps = text "port map" <+>+         parens (cat (punctuate comma  [text i <+> text "=>" <+> expr e | (i,e) <- (ins ++ outs)]))+++inst gensym (InitProcessDecl s) = Just $+    text "-- synthesis_off" $$+    text gensym <+> colon <+> text "process" <> senlist <+> text "is" $$+    text "begin" $$+    nest 2 (stmt s) $$+    text "wait" <> semi $$+    text "end process" <+> text gensym $$+    text "-- synthesis_on"+  where senlist = parens empty++-- TODO: get multline working+inst _ (CommentDecl msg) = Just $+	(vcat [ text "--" <+> text m | m <- lines msg ])++inst _ _d = Nothing++pstmts :: [(Event, Stmt)] -> Doc+pstmts ss = (vcat $ zipWith mkIf is ss)  $$ text "end if" <> semi+  where is = (text "if"):(repeat (text "elsif"))+        mkIf i (p,s) = i <+> nest 2 (event p) <+> text "then" $$+                       nest 2 (stmt s)++event :: Event -> Doc+event (Event i PosEdge)   = text "rising_edge" <> parens (expr i)+event (Event i NegEdge)   = text "falling_edge" <> parens (expr i)+event (Event i AsyncHigh) = expr i <+> text "= '1'"+event (Event i AsyncLow)  = expr i <+> text "= '0'"++stmt :: Stmt -> Doc+stmt (Assign l r) = expr l <+> text "<=" <+> expr r <> semi+stmt (Seq ss) = vcat (map stmt ss)+stmt (If e t Nothing) =+  text "if" <+> expr e <+> text "then" $$+  nest 2 (stmt t) $$+  text "end if" <> semi+stmt (If p t (Just e)) =+  text "if" <+> expr p <+> text "then" $$+  nest 2 (stmt t) $$+  text "else" $$+  nest 2 (stmt e) $$+  text "end if" <> semi+stmt (Case d ps def) =+    text "case" <+> expr d <+> text "of" $$+    vcat (map mkAlt ps) $$+    defDoc $$+    text "end case" <> semi+  where defDoc = maybe empty mkDefault def+        mkDefault s = text "when others =>" $$+                      nest 2 (stmt s)+        mkAlt ([g],s) = text "when" <+> expr g <+> text "=>" $$+                        nest 2 (stmt s)+++to_bits :: Integral a => Int -> a -> [Bit]+to_bits size val = map (\x -> if odd x then T else F)+                   $ reverse+                   $ take size+                   $ map (`mod` 2)+                   $ iterate (`div` 2)+                   $ val++bit_char :: Bit -> Char+bit_char T = '1'+bit_char F = '0'+bit_char U = 'U'  -- 'U' means uninitialized,+                  -- 'X' means forced to unknown.+                  -- not completely sure that 'U' is the right choice here.+bit_char Z = 'Z'++bits :: [Bit] -> Doc+bits = doubleQuotes . text . map bit_char++expr_lit :: Maybe Size -> ExprLit -> Doc+expr_lit Nothing (ExprNum i)          = int $ fromIntegral i+expr_lit (Just sz) (ExprNum i)        = bits (to_bits sz i)+expr_lit _ (ExprBit x)                = quotes (char (bit_char x))+                                        -- ok to ignore the size here?+expr_lit Nothing (ExprBitVector xs)   = bits xs+expr_lit (Just sz) (ExprBitVector xs) = bits $ take sz xs++expr :: Expr -> Doc+expr (ExprLit mb_sz lit) = expr_lit mb_sz lit+expr (ExprVar n) = text n+expr (ExprIndex s i) = text s <> parens (expr i)+expr (ExprSlice s h l)+  | h >= l = text s <> parens (expr h <+> text "downto" <+> expr l)+  | otherwise = text s <> parens (expr h <+> text "to" <+> expr l)++expr (ExprConcat ss) = hcat $ punctuate (text " & ") (map expr ss)+expr (ExprUnary op e) = lookupUnary op (expr e)+expr (ExprBinary op a b) = lookupBinary op (expr a) (expr b)+expr (ExprFunCall f args) = text f <> parens (cat $ punctuate comma $ map expr args)+expr (ExprCond c t e) = expr t <+> text "when" <+> expr c <+> text "else" $$ expr e+expr (ExprCase _ [] Nothing) = error "VHDL does not support non-defaulted ExprCase"+expr (ExprCase _ [] (Just e)) = expr e+expr (ExprCase e (([],_):alts) def) = expr (ExprCase e alts def)+expr (ExprCase e ((p:ps,alt):alts) def) =+	expr (ExprCond (ExprBinary Equals e p) alt (ExprCase e ((ps,alt):alts) def))+expr x = text (show x)+++-- | mkSensitivityList takes a process and extracts the appropriate sensitify list+--++mkSensitivityList :: Decl -> [Expr]+mkSensitivityList (ProcessDecl evs) = nub event_names+  where event_names =+	 	--   AJG: This is now *only* based on the 'Event' vars, nothing else.+		map (\ (e,_) -> case e of+				 Event (ExprVar name) _ -> ExprVar name+				 _ -> error $ "strange form for mkSensitivityList " ++ show e+		    ) evs++lookupUnary :: UnaryOp -> Doc -> Doc+lookupUnary op e = text (unOp op) <> parens e++unOp :: UnaryOp -> String+unOp UPlus = ""+unOp UMinus = "-"+unOp LNeg = "not"+unOp UAnd = "and"+unOp UNand = "nand"+unOp UOr = "or"+unOp UNor = "nor"+unOp UXor = "xor"+unOp UXnor = "xnor"+unOp Neg = "-"+++-- "(\\(.*\\), text \\(.*\\)),"+lookupBinary :: BinaryOp -> Doc -> Doc -> Doc+lookupBinary op a b = parens $ a <+> text (binOp op) <+> b++binOp :: BinaryOp -> String+binOp Pow = "**"+binOp Plus = "+"+binOp Minus = "-"+binOp Times = "*"+binOp Divide = "/"+binOp Modulo = "mod"+binOp Equals = "="+binOp NotEquals = "!="+binOp CEquals = "="+binOp CNotEquals = "!="+binOp LAnd = "and"+binOp LOr = "or"+binOp LessThan = "<"+binOp LessEqual = "<="+binOp GreaterThan = ">"+binOp GreaterEqual = ">="+binOp And = "and"+binOp Nand = "nand"+binOp Or = "or"+binOp Nor = "nor"+binOp Xor = "xor"+binOp Xnor = "xnor"+binOp ShiftLeft = "sll"+binOp ShiftRight = "srl"+binOp RotateLeft = "rol"+binOp RotateRight = "ror"++slv_type :: Maybe Range -> Doc+slv_type Nothing = text "std_logic"+slv_type (Just r) =  text "std_logic_vector" <> range r++range :: Range -> Doc+range (Range high low) = parens (expr high <+> text "downto" <+> expr low)

@@ -0,0 +1,2 @@+import Distribution.Simple
+main = defaultMain

@@ -0,0 +1,29 @@+name:           netlist-to-vhdl+version:        0.2+synopsis:       Convert a Netlist AST to VHDL+description:    Convert a Netlist AST to VHDL+category:       Language+license:        BSD3+license-file:   LICENSE+copyright:      Copyright (c) 2010 University of Kansas+author:         Garrin Kimmell+maintainer:     garrin.kimmell@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.GenVHDL++  build-depends:        netlist == 0.2, pretty >= 1.0++  if flag(base4)+     build-depends:   base == 4.*+  else+     build-depends:   base == 3.*