├── .gitignore ├── Makefile ├── README.org ├── netlist-to-verilog ├── LICENSE ├── Language │ └── Netlist │ │ └── GenVerilog.hs ├── Setup.hs └── netlist-to-verilog.cabal ├── netlist-to-vhdl ├── LICENSE ├── Language │ └── Netlist │ │ └── GenVHDL.hs ├── Setup.hs └── netlist-to-vhdl.cabal ├── netlist ├── LICENSE ├── Language │ └── Netlist │ │ ├── AST.hs │ │ ├── Examples.hs │ │ ├── Inline.hs │ │ └── Util.hs ├── Setup.hs └── netlist.cabal └── verilog ├── LICENSE ├── Language ├── Verilog.hs └── Verilog │ ├── Parser.hs │ ├── ParserTest.hs │ ├── PrettyPrint.hs │ ├── Syntax.hs │ └── Syntax │ ├── AST.hs │ ├── Expression.hs │ └── Ident.hs ├── Setup.hs ├── examples ├── GrayCounter.v ├── README ├── aFifo.v ├── arbiter.v ├── arbiter_tb.v ├── cam.v ├── clk_div.v ├── clk_div_45.v ├── d_latch_gates.v ├── d_latch_switch.v ├── decoder_2to4_gates.v ├── decoder_using_assign.v ├── decoder_using_case.v ├── dff_async_reset.v ├── dff_sync_reset.v ├── dff_udp.v ├── divide_by_3.v ├── dlatch_reset.v ├── encoder_4to2_gates.v ├── encoder_using_case.v ├── encoder_using_if.v ├── full_adder_gates.v ├── full_subtracter_gates.v ├── gray_counter.v ├── half_adder_gates.v ├── hello_pli.v ├── jkff_udp.v ├── latch_udp.v ├── lfsr.v ├── lfsr_updown.v ├── lfsr_updown_tb.v ├── misc1.v ├── mux21_switch.v ├── mux_21_udp.v ├── mux_2to1_gates.v ├── mux_4to1_gates.v ├── mux_using_assign.v ├── mux_using_case.v ├── mux_using_if.v ├── nand_switch.v ├── not_switch.v ├── one_hot_cnt.v ├── or2_input.v ├── parallel_crc.v ├── parity_using_assign.v ├── parity_using_bitwise.v ├── parity_using_function.v ├── parity_using_function2.v ├── pri_encoder_using_assign.v ├── pri_encoder_using_if.v ├── ram_dp_ar_aw.v ├── ram_dp_sr_sw.v ├── ram_sp_ar_aw.v ├── ram_sp_ar_sw.v ├── ram_sp_sr_sw.v ├── rom.v ├── rom_using_case.v ├── rom_using_file.v ├── serial_crc.v ├── srff_udp.v ├── syn_fifo.v ├── t_gate_switch.v ├── tff_async_reset.v ├── tff_sync_reset.v ├── uart.v ├── up_counter.v ├── up_counter_load.v ├── up_down_counter.v ├── xor2_input.v └── xor_switch.v └── verilog.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | package.conf.d/ 3 | -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | .PHONY: all 2 | all: derive 3 | 4 | PACKAGEDB=package.conf.d 5 | 6 | ifneq (,$(findstring CYGWIN, $(ARCH))) 7 | PREFIX_PATH:=$(shell cygpath.exe -m -w $(PWD))/dist 8 | PACKAGEDB_PATH:=$(shell cygpath.exe -m -w $(abspath $(PACKAGEDB))) 9 | else 10 | PREFIX_PATH=$(PWD)/dist 11 | PACKAGEDB_PATH=$(abspath $(PACKAGEDB)) 12 | endif 13 | 14 | .PHONY: packagedb 15 | packagedb: $(PACKAGEDB) 16 | $(PACKAGEDB): 17 | ghc-pkg init $(PACKAGEDB) 18 | 19 | install-local: 20 | cd netlist && cabal install --prefix=$(PREFIX_PATH) --package-db=$(PACKAGEDB_PATH) 21 | cd netlist-to-vhdl && cabal install --prefix=$(PREFIX_PATH) --package-db=$(PACKAGEDB_PATH) 22 | cd verilog && cabal install --prefix=$(PREFIX_PATH) --package-db=$(PACKAGEDB_PATH) 23 | cd netlist-to-verilog && cabal install --prefix=$(PREFIX_PATH) --package-db=$(PACKAGEDB_PATH) 24 | 25 | .PHONY: derive 26 | # run derive on every file that has derived instances in it. 27 | # generated boilerplate code for instances of Binary. 28 | .PHONY: derive 29 | derive: 30 | @for f in `grep -l OPTIONS_DERIVE -r --include=*.hs .`; do \ 31 | echo derive $$f; derive $$f; \ 32 | sed -i -e 's/[ \t]*$$//g' $$f; done 33 | 34 | .PHONY: delete-trailing-whitespace 35 | delete-trailing-whitespace: 36 | @for f in `/usr/bin/find . -iname \*.hs`; do \ 37 | sed -i -e 's/[ \t]*$$//g' $$f; done 38 | 39 | 40 | hudson: 41 | cd netlist && cabal install 42 | cd netlist-to-vhdl && cabal install 43 | -------------------------------------------------------------------------------- /README.org: -------------------------------------------------------------------------------- 1 | #+TITLE: The Haskell Netlist Repository 2 | #+AUTHOR: Philip Weaver 3 | #+EMAIL: philip.weaver@gmail.com 4 | #+DATE: 2010-08-26 Thu 5 | #+DESCRIPTION: 6 | #+KEYWORDS: 7 | #+LANGUAGE: en 8 | #+OPTIONS: H:3 num:t toc:t \n:nil @:t ::t |:t ^:t -:t f:t *:t <:t 9 | #+OPTIONS: TeX:t LaTeX:nil skip:nil d:nil todo:t pri:nil tags:not-in-toc 10 | #+INFOJS_OPT: view:nil toc:nil ltoc:t mouse:underline buttons:0 path:http://orgmode.org/org-info.js 11 | #+EXPORT_SELECT_TAGS: export 12 | #+EXPORT_EXCLUDE_TAGS: noexport 13 | #+LINK_UP: 14 | #+LINK_HOME: 15 | 16 | * Overview 17 | This repository holds 4 Haskell packages: 18 | - netlist - An abstract syntax tree (AST) for a very simple hardware description 19 | language (HDL) that corresponds to a limited subset of VHDL and Verilog. 20 | - verilog - An AST, parser, and pretty-printer for Verilog. 21 | - netlist-to-verilog - A translator from the netlist AST to Verilog AST. 22 | - netlist-to-vhdl - A translator from the netlist AST to VHDL concrete syntax. 23 | 24 | Once these packages are released on [[http://hackage.haskell.org/][Hackage]], links to their packages will appear 25 | here. 26 | 27 | There are 3 forks of the repository on github, [[http://github.com/pheaver/netlist-verilog][pheaver]], [[http://github.com/garrinkimmell/netlist-verilog][garrinkimmell]], and 28 | [[http://github.com/andygill/netlist-verilog][andygill]]. 29 | 30 | * Installation 31 | 32 | ** Install from Hackage 33 | 34 | This is not yet possible. Once these packages are released on [[http://hackage.haskell.org/][Hackage]], they can 35 | be installed like this: 36 | 37 | : cabal install netlist 38 | : cabal install netlist-to-vhdl 39 | : cabal install verilog 40 | : cabal install netlist-to-verilog 41 | 42 | ** Install from git repository 43 | 44 | Clone one of the aforementioned repositories. For example: 45 | 46 | : git clone git://github.com/pheaver/netlist-verilog.git 47 | 48 | Change directories into the new repository: 49 | 50 | : cd netlist-verilog 51 | 52 | Then, you can install each package like so: 53 | 54 | : (cd netlist && cabal install) 55 | : (cd netlist-to-vhdl && cabal install) 56 | : (cd verilog && cabal install) 57 | : (cd netlist-to-verilog && cabal install) 58 | 59 | * Todo 60 | - Release netlist and netlist-to-vhdl packages on hackage. 61 | - Finish haddock documentation for verilog and netlist-to-verilog, release packages on hackage. 62 | -------------------------------------------------------------------------------- /netlist-to-verilog/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2010, Signali Corp. 2 | 3 | All Rights Reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of other contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /netlist-to-verilog/Language/Netlist/GenVerilog.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Netlist.GenVerilog 4 | -- Copyright : (c) Signali Corp. 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : pweaver@signalicorp.com 8 | -- Stability : experimental 9 | -- Portability : non-portable (DeriveDataTypeable) 10 | -- 11 | -- Translate a Netlist AST into a Verilog AST. 12 | -- 13 | -- The @netlist@ package defines the Netlist AST and the @verilog@ package 14 | -- defines the Verilog AST. 15 | -- 16 | -- Not every Netlist AST is compatible with Verilog. For example, the Netlist 17 | -- AST permits left- and right-rotate operators, which are not supported in 18 | -- Verilog. 19 | -------------------------------------------------------------------------------- 20 | {-# LANGUAGE ViewPatterns #-} 21 | 22 | -- TODO: endianness - currently we're hardcoded to little endian verilog 23 | 24 | module Language.Netlist.GenVerilog ( mk_module 25 | , mk_decl 26 | , mk_stmt 27 | , mk_expr 28 | ) where 29 | 30 | import Numeric ( showIntAtBase ) 31 | 32 | import Language.Netlist.AST 33 | import qualified Language.Verilog.Syntax as V 34 | 35 | -- ----------------------------------------------------------------------------- 36 | 37 | mk_module :: Module -> V.Module 38 | mk_module (Module name ins outs statics decls) 39 | = V.Module (mk_ident name) ports items 40 | where 41 | params= [ V.ParamDeclItem (V.ParamDecl [V.ParamAssign (mk_ident x) (mk_expr expr)]) 42 | | (x, expr) <- statics 43 | ] 44 | ports = map (mk_ident . fst) ins ++ map (mk_ident . fst) outs 45 | items = [ V.InputDeclItem (V.InputDecl (fmap mk_range mb_range) [mk_ident x]) 46 | | (x, mb_range) <- ins ] ++ 47 | 48 | [ V.OutputDeclItem (V.OutputDecl (fmap mk_range mb_range) [mk_ident x]) 49 | | (x, mb_range) <- outs ] ++ 50 | 51 | params ++ 52 | concatMap mk_decl decls 53 | 54 | 55 | mk_decl :: Decl -> [V.Item] 56 | mk_decl (NetDecl x mb_range mb_expr) 57 | = [V.NetDeclItem decl] 58 | where 59 | mb_range' = fmap (V.SimpleRange . mk_range) mb_range 60 | decl = case mb_expr of 61 | Nothing -> V.NetDecl V.Net_wire mb_range' Nothing [mk_ident x] 62 | Just expr -> V.NetDeclAssign V.Net_wire Nothing mb_range' Nothing 63 | [(mk_ident x, mk_expr expr)] 64 | 65 | mk_decl (NetAssign x expr) 66 | = [V.AssignItem Nothing Nothing [mkAssign x expr]] 67 | 68 | mk_decl (MemDecl x mb_range1 mb_range2) 69 | = [V.RegDeclItem (V.RegDecl V.Reg_reg (fmap mk_range mb_range2) 70 | [case mb_range1 of 71 | Nothing -> V.RegVar (mk_ident x) Nothing 72 | Just r -> V.MemVar (mk_ident x) (mk_range r) 73 | ])] 74 | 75 | mk_decl (InstDecl mod_name inst_name params inputs outputs) 76 | = [V.InstanceItem (V.Instance (mk_ident mod_name) v_params [inst])] 77 | where 78 | v_params = Right [ V.Parameter (mk_ident x) (mk_expr expr) 79 | | (x, expr) <- params ] 80 | inst = V.Inst (mk_ident inst_name) Nothing (V.NamedConnections cs) 81 | cs = [ V.NamedConnection (mk_ident x) (mk_expr expr) 82 | | (x, expr) <- inputs ++ outputs ] 83 | 84 | mk_decl (InitProcessDecl stmt) 85 | = [V.InitialItem (mk_stmt stmt)] 86 | 87 | mk_decl (CommentDecl str) 88 | = [V.CommentItem str] 89 | 90 | mk_decl (ProcessDecl (Event (mk_expr -> clk) edge) Nothing stmt) 91 | = [V.AlwaysItem (V.EventControlStmt e (Just s))] 92 | where 93 | e = V.EventControlExpr event 94 | s = V.IfStmt cond (Just (mk_stmt stmt)) Nothing 95 | 96 | (event, cond) = edge_helper edge clk 97 | 98 | mk_decl (ProcessDecl (Event (mk_expr -> clk) clk_edge) 99 | (Just (Event (mk_expr -> reset) reset_edge, reset_stmt)) stmt) 100 | = [V.AlwaysItem (V.EventControlStmt e (Just s1))] 101 | where 102 | e = V.EventControlExpr (V.EventOr clk_event reset_event) 103 | 104 | s1 = V.IfStmt reset_cond (Just (mk_stmt reset_stmt)) (Just s2) 105 | s2 = V.IfStmt clk_cond (Just (mk_stmt stmt)) Nothing 106 | 107 | (clk_event, clk_cond) = edge_helper clk_edge clk 108 | (reset_event, reset_cond) = edge_helper reset_edge reset 109 | 110 | edge_helper :: Edge -> V.Expression -> (V.EventExpr, V.Expression) 111 | edge_helper PosEdge x = (V.EventPosedge x, x) 112 | edge_helper NegEdge x = (V.EventNegedge x, V.ExprUnary V.UBang x) 113 | 114 | mk_range :: Range -> V.Range 115 | mk_range (Range e1 e2) 116 | = V.Range (mk_expr e1) (mk_expr e2) 117 | 118 | mk_stmt :: Stmt -> V.Statement 119 | mk_stmt (Assign x expr) 120 | = V.NonBlockingAssignment (mk_expr x) Nothing (mk_expr expr) 121 | mk_stmt (If cond s1 mb_s2) 122 | = V.IfStmt (mk_expr cond) (Just (mk_stmt s1)) (fmap mk_stmt mb_s2) 123 | mk_stmt (Case e case_items mb_default) 124 | = V.CaseStmt V.Case (mk_expr e) $ 125 | [ V.CaseItem (map mk_expr es) (Just (mk_stmt stmt)) 126 | | (es, stmt) <- case_items ] 127 | ++ 128 | case mb_default of 129 | Just stmt -> [V.CaseDefault (Just (mk_stmt stmt))] 130 | Nothing -> [] 131 | mk_stmt (Seq stmts) 132 | = V.SeqBlock Nothing [] (map mk_stmt stmts) 133 | mk_stmt (FunCallStmt x es) 134 | | head x == '$' 135 | = V.TaskStmt (mk_ident (tail x)) (Just (map mk_expr es)) 136 | | otherwise 137 | = error ("FunCallStmt " ++ x) 138 | 139 | mk_lit :: Maybe Size -> ExprLit -> V.Number 140 | mk_lit mb_sz lit 141 | = V.IntNum Nothing (fmap show mb_sz) mb_base str 142 | -- Note that this does not truncate 'str' if its length is more than the size. 143 | where 144 | hexdigits = "0123456789abcdef" 145 | 146 | (str, mb_base) 147 | = case lit of 148 | ExprNum x 149 | -> case mb_sz of 150 | Just n 151 | | n <= 4 -> (showIntAtBase 2 (hexdigits !!) x "", Just V.BinBase) 152 | | otherwise -> (showIntAtBase 16 (hexdigits !!) x "", Just V.HexBase) 153 | Nothing -> (show x, Nothing) 154 | ExprBit b -> ([bit_char b], Nothing) 155 | ExprBitVector bs -> (map bit_char bs, Just V.BinBase) 156 | 157 | bit_char :: Bit -> Char 158 | bit_char T = '1' 159 | bit_char F = '0' 160 | bit_char U = 'x' 161 | bit_char Z = 'z' 162 | 163 | mk_expr :: Expr -> V.Expression 164 | mk_expr (ExprLit mb_size lit) 165 | = V.ExprNum $ mk_lit mb_size lit 166 | 167 | mk_expr (ExprString x) 168 | = V.ExprString x 169 | mk_expr (ExprVar x) 170 | = expr_var x 171 | mk_expr (ExprIndex x e) 172 | = V.ExprIndex (mk_ident x) (mk_expr e) 173 | mk_expr (ExprSlice x e1 e2) 174 | = V.ExprSlice (mk_ident x) (mk_expr e1) (mk_expr e2) 175 | mk_expr (ExprSliceOff x e i) 176 | = f (mk_ident x) (mk_expr e) (V.intExpr (abs i)) 177 | where 178 | f = if i < 0 then V.ExprSliceMinus else V.ExprSlicePlus 179 | mk_expr (ExprConcat exprs) 180 | = V.ExprConcat (map mk_expr exprs) 181 | mk_expr (ExprUnary op expr) 182 | = V.ExprUnary (unary_op op) (mk_expr expr) 183 | mk_expr (ExprBinary op expr1 expr2) 184 | = V.ExprBinary (binary_op op) (mk_expr expr1) (mk_expr expr2) 185 | mk_expr (ExprCond expr1 expr2 expr3) 186 | = V.ExprCond (mk_expr expr1) (mk_expr expr2) (mk_expr expr3) 187 | mk_expr (ExprFunCall x es) 188 | = V.ExprFunCall (mk_ident x) (map mk_expr es) 189 | 190 | mk_expr ExprCase{} 191 | = error "GenVerilog: Not yet supported: ExprCase" 192 | 193 | mk_ident :: Ident -> V.Ident 194 | mk_ident x = V.Ident x 195 | 196 | expr_var :: Ident -> V.Expression 197 | expr_var x = V.ExprVar (mk_ident x) 198 | 199 | mkAssign :: Ident -> Expr -> V.Assignment 200 | mkAssign ident expr 201 | = V.Assignment (expr_var ident) (mk_expr expr) 202 | 203 | unary_op :: UnaryOp -> V.UnaryOp 204 | unary_op UPlus = V.UPlus 205 | unary_op UMinus = V.UMinus 206 | unary_op LNeg = V.UBang 207 | unary_op Neg = V.UTilde 208 | unary_op UAnd = V.UAnd 209 | unary_op UNand = V.UNand 210 | unary_op UOr = V.UOr 211 | unary_op UNor = V.UNor 212 | unary_op UXor = V.UXor 213 | unary_op UXnor = V.UXnor 214 | 215 | binary_op :: BinaryOp -> V.BinaryOp 216 | binary_op Pow = V.Pow 217 | binary_op Plus = V.Plus 218 | binary_op Minus = V.Minus 219 | binary_op Times = V.Times 220 | binary_op Divide = V.Divide 221 | binary_op Modulo = V.Modulo 222 | binary_op Equals = V.Equals 223 | binary_op NotEquals = V.NotEquals 224 | binary_op CEquals = V.CEquals 225 | binary_op CNotEquals = V.CNotEquals 226 | binary_op LAnd = V.LAnd 227 | binary_op LOr = V.LOr 228 | binary_op LessThan = V.LessThan 229 | binary_op LessEqual = V.LessEqual 230 | binary_op GreaterThan = V.GreaterThan 231 | binary_op GreaterEqual = V.GreaterEqual 232 | binary_op And = V.And 233 | binary_op Nand = V.Nand 234 | binary_op Or = V.Or 235 | binary_op Nor = V.Nor 236 | binary_op Xor = V.Xor 237 | binary_op Xnor = V.Xnor 238 | binary_op ShiftLeft = V.ShiftLeft 239 | binary_op ShiftRight = V.ShiftRight 240 | binary_op RotateLeft = error "GenVerilog: no left-rotate operator in Verilog" 241 | binary_op RotateRight = error "GenVerilog: no right-rotate operator in Verilog" 242 | 243 | -- ----------------------------------------------------------------------------- 244 | -------------------------------------------------------------------------------- /netlist-to-verilog/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /netlist-to-verilog/netlist-to-verilog.cabal: -------------------------------------------------------------------------------- 1 | name: netlist-to-verilog 2 | version: 0.1 3 | synopsis: Convert a Netlist AST to a Verilog AST 4 | description: Convert a Netlist AST to a Verilog AST 5 | category: Language 6 | license: BSD3 7 | license-file: LICENSE 8 | copyright: Copyright (c) 2010 Signali Corp. 9 | Copyright (c) 2010 Philip Weaver 10 | author: Philip Weaver 11 | maintainer: philip.weaver@gmail.com 12 | package-url: git://github.com/pheaver/netlist-verilog.git 13 | build-type: Simple 14 | cabal-version: >=1.6 15 | 16 | flag base4 17 | Description: Compile using base-4 instead of base-3 18 | Default: True 19 | 20 | Library 21 | ghc-options: -Wall 22 | 23 | exposed-modules: Language.Netlist.GenVerilog 24 | 25 | build-depends: netlist == 0.2, verilog == 0.2 26 | 27 | if flag(base4) 28 | build-depends: base == 4.* 29 | else 30 | build-depends: base == 3.* 31 | 32 | -------------------------------------------------------------------------------- /netlist-to-vhdl/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010 The University of Kansas 2 | All rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without 5 | modification, are permitted provided that the following conditions 6 | are met: 7 | 1. Redistributions of source code must retain the above copyright 8 | notice, this list of conditions and the following disclaimer. 9 | 2. Redistributions in binary form must reproduce the above copyright 10 | notice, this list of conditions and the following disclaimer in the 11 | documentation and/or other materials provided with the distribution. 12 | 3. The names of the authors may not be used to endorse or promote products 13 | derived from this software without specific prior written permission. 14 | 15 | THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR 16 | IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES 17 | OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. 18 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, 19 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT 20 | NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 21 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 22 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 23 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF 24 | THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 25 | 26 | -------------------------------------------------------------------------------- /netlist-to-vhdl/Language/Netlist/GenVHDL.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Netlist.GenVHDL 4 | -- Copyright : (c) University of Kansas 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : garrin.kimmell@gmail.com 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Translates a Netlist AST ('Language.Netlist.AST') to VHDL. 12 | -------------------------------------------------------------------------------- 13 | 14 | module Language.Netlist.GenVHDL(genVHDL) where 15 | 16 | import Language.Netlist.AST 17 | 18 | import Text.PrettyPrint 19 | import Data.Maybe(catMaybes) 20 | 21 | 22 | -- | Generate a 'Language.Netlist.AST.Module' as a VHDL file . The ['String'] argument 23 | -- is the list of extra modules to import, typically [\"work.all\"]. 24 | genVHDL :: Module -> [String] -> String 25 | genVHDL m others = render vhdl ++ "\n" 26 | where 27 | vhdl = imports others $$ 28 | entity m $$ 29 | architecture m 30 | 31 | imports :: [String] -> Doc 32 | imports others = vcat 33 | [ text "library IEEE" <> semi 34 | , text "use IEEE.STD_LOGIC_1164.ALL" <> semi 35 | , text "use IEEE.NUMERIC_STD.ALL" <> semi 36 | ] $$ vcat [ 37 | text ("use " ++ other) <> semi 38 | | other <- others 39 | ] 40 | 41 | 42 | entity :: Module -> Doc 43 | entity m = text "entity" <+> text (module_name m) <+> text "is" $$ 44 | nest 2 (text "port" <> parens (vcat $ punctuate semi ports) <> semi) $$ 45 | text "end" <+> text "entity" <+> text (module_name m) <> semi 46 | 47 | where ports = [text i <+> colon <+> text "in" <+> slv_type ran | (i,ran) <- module_inputs m ] ++ 48 | [text i <+> colon <+> text "out" <+> slv_type ran | (i,ran) <- module_outputs m ] 49 | 50 | 51 | architecture :: Module -> Doc 52 | architecture m = text "architecture" <+> text "str" <+> text "of" <+> text (module_name m) <+> text "is" $$ 53 | nest 2 (decls (module_decls m)) $$ 54 | text "begin" $$ 55 | nest 2 (insts (module_decls m)) $$ 56 | text "end" <+> text "architecture" <+> text "str" <> semi 57 | 58 | decls :: [Decl] -> Doc 59 | decls [] = empty 60 | decls ds = (vcat $ punctuate semi $ catMaybes $ map decl ds) <> semi 61 | 62 | decl :: Decl -> Maybe Doc 63 | decl (NetDecl i r Nothing) = Just $ 64 | text "signal" <+> text i <+> colon <+> slv_type r 65 | 66 | decl (NetDecl i r (Just init)) = Just $ 67 | text "signal" <+> text i <+> colon <+> slv_type r <+> text ":=" <+> expr init 68 | 69 | decl (MemDecl i Nothing dsize) = Just $ 70 | text "signal" <+> text i <+> colon <+> slv_type dsize 71 | 72 | decl (MemDecl i (Just asize) dsize) = Just $ 73 | text "type" <+> mtype <+> text "is" <+> 74 | text "array" <+> range asize <+> text "of" <+> slv_type dsize <> semi $$ 75 | text "signal" <+> text i <> text "_ram" <+> colon <+> mtype 76 | where mtype = text i <> text "_memory_type" 77 | 78 | decl _d = Nothing 79 | 80 | insts :: [Decl] -> Doc 81 | insts [] = empty 82 | insts is = case catMaybes $ zipWith inst gensyms is of 83 | [] -> empty 84 | is' -> (vcat $ punctuate semi is') <> semi 85 | where gensyms = ["proc" ++ show i | i <- [(0::Integer)..]] 86 | 87 | inst :: String -> Decl -> Maybe Doc 88 | inst _ (NetAssign i e) = Just $ text i <+> text "<=" <+> expr e 89 | 90 | inst gensym (ProcessDecl (Event clk edge) Nothing s) = Just $ 91 | text gensym <+> colon <+> text "process" <> senlist <+> text "is" $$ 92 | text "begin" $$ 93 | nest 2 (text "if" <+> nest 2 event <+> text "then" $$ 94 | nest 2 (stmt s) $$ 95 | text "end if" <> semi) $$ 96 | text "end process" <+> text gensym 97 | where 98 | senlist = parens $ expr clk 99 | event = case edge of 100 | PosEdge -> text "rising_edge" <> parens (expr clk) 101 | NegEdge -> text "falling_edge" <> parens (expr clk) 102 | 103 | inst gensym (ProcessDecl (Event clk clk_edge) 104 | (Just (Event reset reset_edge, reset_stmt)) s) = Just $ 105 | text gensym <+> colon <+> text "process" <> senlist <+> text "is" $$ 106 | text "begin" $$ 107 | nest 2 (text "if" <+> nest 2 reset_event <+> text "then" $$ 108 | nest 2 (stmt reset_stmt) $$ 109 | text "elsif" <+> nest 2 clk_event <+> text "then" $$ 110 | nest 2 (stmt s) $$ 111 | text "end if" <> semi) $$ 112 | text "end process" <+> text gensym 113 | where 114 | senlist = parens $ cat $ punctuate comma $ map expr [ clk, reset ] 115 | clk_event = case clk_edge of 116 | PosEdge -> text "rising_edge" <> parens (expr clk) 117 | NegEdge -> text "falling_edge" <> parens (expr clk) 118 | reset_event = case reset_edge of 119 | PosEdge -> expr reset <+> text "= '1'" 120 | NegEdge -> expr reset <+> text "= '0'" 121 | 122 | 123 | inst _ (InstDecl nm inst gens ins outs) = Just $ 124 | text inst <+> colon <+> text "entity" <+> text nm $$ 125 | gs $$ 126 | ps 127 | where 128 | gs | null gens = empty 129 | | otherwise = 130 | text "generic map" <+> 131 | (parens (cat (punctuate comma [text i <+> text "=>" <+> expr e | (i,e) <- gens]))) 132 | -- Assume that ports is never null 133 | ps = text "port map" <+> 134 | parens (cat (punctuate comma [text i <+> text "=>" <+> expr e | (i,e) <- (ins ++ outs)])) 135 | 136 | 137 | inst gensym (InitProcessDecl s) = Just $ 138 | text "-- synthesis_off" $$ 139 | text gensym <+> colon <+> text "process" <> senlist <+> text "is" $$ 140 | text "begin" $$ 141 | nest 2 (stmt s) $$ 142 | text "wait" <> semi $$ 143 | text "end process" <+> text gensym $$ 144 | text "-- synthesis_on" 145 | where senlist = parens empty 146 | 147 | -- TODO: get multline working 148 | inst _ (CommentDecl msg) = Just $ 149 | (vcat [ text "--" <+> text m | m <- lines msg ]) 150 | 151 | inst _ _d = Nothing 152 | 153 | stmt :: Stmt -> Doc 154 | stmt (Assign l r) = expr l <+> text "<=" <+> expr r <> semi 155 | stmt (Seq ss) = vcat (map stmt ss) 156 | stmt (If e t Nothing) = 157 | text "if" <+> expr e <+> text "then" $$ 158 | nest 2 (stmt t) $$ 159 | text "end if" <> semi 160 | stmt (If p t (Just e)) = 161 | text "if" <+> expr p <+> text "then" $$ 162 | nest 2 (stmt t) $$ 163 | text "else" $$ 164 | nest 2 (stmt e) $$ 165 | text "end if" <> semi 166 | stmt (Case d ps def) = 167 | text "case" <+> expr d <+> text "of" $$ 168 | vcat (map mkAlt ps) $$ 169 | defDoc $$ 170 | text "end case" <> semi 171 | where defDoc = maybe empty mkDefault def 172 | mkDefault s = text "when others =>" $$ 173 | nest 2 (stmt s) 174 | mkAlt ([g],s) = text "when" <+> expr g <+> text "=>" $$ 175 | nest 2 (stmt s) 176 | 177 | 178 | to_bits :: Integral a => Int -> a -> [Bit] 179 | to_bits size val = map (\x -> if odd x then T else F) 180 | $ reverse 181 | $ take size 182 | $ map (`mod` 2) 183 | $ iterate (`div` 2) 184 | $ val 185 | 186 | bit_char :: Bit -> Char 187 | bit_char T = '1' 188 | bit_char F = '0' 189 | bit_char U = 'U' -- 'U' means uninitialized, 190 | -- 'X' means forced to unknown. 191 | -- not completely sure that 'U' is the right choice here. 192 | bit_char Z = 'Z' 193 | 194 | bits :: [Bit] -> Doc 195 | bits = doubleQuotes . text . map bit_char 196 | 197 | expr_lit :: Maybe Size -> ExprLit -> Doc 198 | expr_lit Nothing (ExprNum i) = int $ fromIntegral i 199 | expr_lit (Just sz) (ExprNum i) = bits (to_bits sz i) 200 | expr_lit _ (ExprBit x) = quotes (char (bit_char x)) 201 | -- ok to ignore the size here? 202 | expr_lit Nothing (ExprBitVector xs) = bits xs 203 | expr_lit (Just sz) (ExprBitVector xs) = bits $ take sz xs 204 | 205 | expr :: Expr -> Doc 206 | expr (ExprLit mb_sz lit) = expr_lit mb_sz lit 207 | expr (ExprVar n) = text n 208 | expr (ExprIndex s i) = text s <> parens (expr i) 209 | expr (ExprSlice s h l) 210 | | h >= l = text s <> parens (expr h <+> text "downto" <+> expr l) 211 | | otherwise = text s <> parens (expr h <+> text "to" <+> expr l) 212 | 213 | expr (ExprConcat ss) = hcat $ punctuate (text " & ") (map expr ss) 214 | expr (ExprUnary op e) = lookupUnary op (expr e) 215 | expr (ExprBinary op a b) = lookupBinary op (expr a) (expr b) 216 | expr (ExprFunCall f args) = text f <> parens (cat $ punctuate comma $ map expr args) 217 | expr (ExprCond c t e) = expr t <+> text "when" <+> expr c <+> text "else" $$ expr e 218 | expr (ExprCase _ [] Nothing) = error "VHDL does not support non-defaulted ExprCase" 219 | expr (ExprCase _ [] (Just e)) = expr e 220 | expr (ExprCase e (([],_):alts) def) = expr (ExprCase e alts def) 221 | expr (ExprCase e ((p:ps,alt):alts) def) = 222 | expr (ExprCond (ExprBinary Equals e p) alt (ExprCase e ((ps,alt):alts) def)) 223 | expr x = text (show x) 224 | 225 | 226 | lookupUnary :: UnaryOp -> Doc -> Doc 227 | lookupUnary op e = text (unOp op) <> parens e 228 | 229 | unOp :: UnaryOp -> String 230 | unOp UPlus = "" 231 | unOp UMinus = "-" 232 | unOp LNeg = "not" 233 | unOp UAnd = "and" 234 | unOp UNand = "nand" 235 | unOp UOr = "or" 236 | unOp UNor = "nor" 237 | unOp UXor = "xor" 238 | unOp UXnor = "xnor" 239 | unOp Neg = "-" 240 | 241 | 242 | -- "(\\(.*\\), text \\(.*\\))," 243 | lookupBinary :: BinaryOp -> Doc -> Doc -> Doc 244 | lookupBinary op a b = parens $ a <+> text (binOp op) <+> b 245 | 246 | binOp :: BinaryOp -> String 247 | binOp Pow = "**" 248 | binOp Plus = "+" 249 | binOp Minus = "-" 250 | binOp Times = "*" 251 | binOp Divide = "/" 252 | binOp Modulo = "mod" 253 | binOp Equals = "=" 254 | binOp NotEquals = "!=" 255 | binOp CEquals = "=" 256 | binOp CNotEquals = "!=" 257 | binOp LAnd = "and" 258 | binOp LOr = "or" 259 | binOp LessThan = "<" 260 | binOp LessEqual = "<=" 261 | binOp GreaterThan = ">" 262 | binOp GreaterEqual = ">=" 263 | binOp And = "and" 264 | binOp Nand = "nand" 265 | binOp Or = "or" 266 | binOp Nor = "nor" 267 | binOp Xor = "xor" 268 | binOp Xnor = "xnor" 269 | binOp ShiftLeft = "sll" 270 | binOp ShiftRight = "srl" 271 | binOp RotateLeft = "rol" 272 | binOp RotateRight = "ror" 273 | 274 | slv_type :: Maybe Range -> Doc 275 | slv_type Nothing = text "std_logic" 276 | slv_type (Just r) = text "std_logic_vector" <> range r 277 | 278 | range :: Range -> Doc 279 | range (Range high low) = parens (expr high <+> text "downto" <+> expr low) 280 | -------------------------------------------------------------------------------- /netlist-to-vhdl/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /netlist-to-vhdl/netlist-to-vhdl.cabal: -------------------------------------------------------------------------------- 1 | name: netlist-to-vhdl 2 | version: 0.2 3 | synopsis: Convert a Netlist AST to VHDL 4 | description: Convert a Netlist AST to VHDL 5 | category: Language 6 | license: BSD3 7 | license-file: LICENSE 8 | copyright: Copyright (c) 2010 University of Kansas 9 | author: Garrin Kimmell 10 | maintainer: garrin.kimmell@gmail.com 11 | package-url: git://github.com/pheaver/netlist-verilog.git 12 | build-type: Simple 13 | cabal-version: >=1.6 14 | 15 | flag base4 16 | Description: Compile using base-4 instead of base-3 17 | Default: True 18 | 19 | Library 20 | ghc-options: -Wall 21 | 22 | exposed-modules: Language.Netlist.GenVHDL 23 | 24 | build-depends: netlist == 0.2, pretty >= 1.0 25 | 26 | if flag(base4) 27 | build-depends: base == 4.* 28 | else 29 | build-depends: base == 3.* 30 | -------------------------------------------------------------------------------- /netlist/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2010, Signali Corp. 2 | 3 | All Rights Reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of other contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /netlist/Language/Netlist/AST.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Netlist.AST 4 | -- Copyright : (c) Signali Corp. 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : pweaver@signalicorp.com 8 | -- Stability : experimental 9 | -- Portability : non-portable (DeriveDataTypeable) 10 | -- 11 | -- An abstract syntax tree (AST) for a generic netlist, kind of like a 12 | -- high-level subset of Verilog and VHDL that is compatible with both languages. 13 | -- 14 | -- There are no definitive semantics assigned to this AST. 15 | -- 16 | -- For example, the user may choose to treat the bindings as recursive, so that 17 | -- expressions can reference variables before their declaration, like in 18 | -- Haskell, which is not supported in Verilog and VHDL. in this case, the user 19 | -- must fix the bindings when converting to an HDL. 20 | -- 21 | -- Also, the user may treat module instantiations and processes as having an 22 | -- implict clock/reset, so that they are not explicitly named in those 23 | -- constructs in this AST. Then, the clock and reset can be inserted when 24 | -- generating HDL. 25 | -- 26 | -- When you instantiate a module but information about that module is missing 27 | -- (e.g. the clock/reset are implicit and you need to know what they are called 28 | -- in that module), you can use ExternDecl (TODO) to declare a module's 29 | -- interface so that you know how to instantiate it, or retrieve the interface 30 | -- from a user-maintained database or by parsing and extracting from an HDL 31 | -- file. 32 | -------------------------------------------------------------------------------- 33 | 34 | {-# LANGUAGE DeriveDataTypeable #-} 35 | {-# OPTIONS_GHC -Wall #-} 36 | {-# OPTIONS_DERIVE --append -d Binary #-} 37 | 38 | module Language.Netlist.AST where 39 | 40 | import Data.Binary ( Binary(..), putWord8, getWord8 ) 41 | import Data.Generics ( Data, Typeable ) 42 | 43 | -- ----------------------------------------------------------------------------- 44 | 45 | -- | A Module corresponds to a \"module\" in Verilog or an \"entity\" in VHDL. 46 | data Module = Module 47 | { module_name :: Ident 48 | , module_inputs :: [(Ident, Maybe Range)] 49 | , module_outputs :: [(Ident, Maybe Range)] 50 | , module_statics :: [(Ident, ConstExpr)] 51 | -- static parameters (VHDL "generic", Verilog "parameter") 52 | , module_decls :: [Decl] 53 | } 54 | deriving (Eq, Ord, Show, Data, Typeable) 55 | 56 | -- | An identifier name. 57 | type Ident = String 58 | 59 | -- | The size of a wire. 60 | type Size = Int 61 | 62 | -- | A declaration, analogous to an \"item\" in the Verilog formal syntax. 63 | data Decl 64 | -- | A net (@wire@ in Verilog) has a continuously assigned value. The net can 65 | -- be declared and assigned at the same time (@Just Expr@), or separately 66 | -- (@Nothing@) in a @NetAssign@. 67 | = NetDecl Ident (Maybe Range) (Maybe Expr) 68 | | NetAssign Ident Expr 69 | 70 | -- | A mem (@reg@ in Verilog) is stateful. It can be assigned by a 71 | -- non-blocking assignment (or blocking, but we don't support those yet) 72 | -- within a process. TODO: support optional initial value 73 | -- 74 | -- The first range is the most significant dimension. 75 | -- So, @MemDecl x (0, 31) (7, 0)@ corresponds to the following in Verilog: 76 | -- @reg [7:0] x [0:31]@ 77 | | MemDecl Ident (Maybe Range) (Maybe Range) 78 | 79 | -- | A module/entity instantiation. The arguments are the name of the module, 80 | -- the name of the instance, the parameter assignments, the input port 81 | -- connections, and the output port connections. 82 | | InstDecl Ident -- name of the module 83 | Ident -- name of the instance 84 | [(Ident, Expr)] -- parameter assignments 85 | [(Ident, Expr)] -- input port connections 86 | [(Ident, Expr)] -- output port connections 87 | 88 | -- declare an external module entity 89 | -- TODO: ExternDecl ExternLang 90 | 91 | -- | A sequential process with clock and (optional) asynchronous reset. 92 | | ProcessDecl Event (Maybe (Event, Stmt)) Stmt 93 | 94 | -- | A statement that executes once at the beginning of simulation. 95 | -- Equivalent to Verilog \"initial\" statement. 96 | | InitProcessDecl Stmt 97 | 98 | -- | A basic comment (typically is placed above a decl of interest). 99 | -- Newlines are allowed, and generate new single line comments. 100 | | CommentDecl String 101 | 102 | deriving (Eq, Ord, Show, Data, Typeable) 103 | 104 | -- | A 'Range' tells us the type of a bit vector. It can count up or down. 105 | data Range 106 | = Range ConstExpr ConstExpr 107 | deriving (Eq, Ord, Show, Data, Typeable) 108 | 109 | -- | A constant expression is simply an expression that must be a constant 110 | -- (i.e. the only free variables are static parameters). This restriction is 111 | -- not made in the AST. 112 | type ConstExpr = Expr 113 | 114 | data Event 115 | = Event Expr Edge 116 | deriving (Eq, Ord, Show, Data, Typeable) 117 | 118 | -- | An event can be triggered by the rising edge ('PosEdge') or falling edge 119 | -- ('NegEdge') of a signal. 120 | data Edge 121 | = PosEdge 122 | | NegEdge 123 | deriving (Eq, Ord, Show, Data, Typeable) 124 | 125 | -- | Expr is a combination of VHDL and Verilog expressions. 126 | -- 127 | -- In VHDL, concatenation is a binary operator, but in Verilog it takes any 128 | -- number of arguments. In this AST, we define it like the Verilog operator. 129 | -- If we translate to VHDL, we have to convert it to the VHDL binary operator. 130 | -- 131 | -- There are some HDL operators that we don't represent here. For example, in 132 | -- Verilog there is a multiple concatenation (a.k.a. replication) operator, 133 | -- which we don't bother to support. 134 | 135 | data Expr 136 | = ExprLit (Maybe Size) ExprLit -- ^ a sized or unsized literal 137 | | ExprVar Ident -- ^ a variable ference 138 | | ExprString String -- ^ a quoted string (useful for parameters) 139 | 140 | | ExprIndex Ident Expr -- ^ @x[e]@ 141 | | ExprSlice Ident Expr Expr -- ^ @x[e1 : e2]@ 142 | | ExprSliceOff Ident Expr Int -- ^ @x[e : e+i]@, where @i@ can be negative 143 | | ExprCase Expr [([ConstExpr], Expr)] (Maybe Expr) 144 | -- ^ case expression. supports multiple matches 145 | -- per result value, and an optional default value 146 | | ExprConcat [Expr] -- ^ concatenation 147 | | ExprCond Expr Expr Expr -- ^ conditional expression 148 | | ExprUnary UnaryOp Expr -- ^ application of a unary operator 149 | | ExprBinary BinaryOp Expr Expr -- ^ application of a binary operator 150 | | ExprFunCall Ident [Expr] -- ^ a function application 151 | deriving (Eq, Ord, Show, Data, Typeable) 152 | 153 | data ExprLit 154 | = ExprNum Integer -- ^ a number 155 | | ExprBit Bit -- ^ a single bit. in vhdl, bits are different than 1-bit bitvectors 156 | | ExprBitVector [Bit] 157 | deriving (Eq, Ord, Show, Data, Typeable) 158 | 159 | data Bit 160 | = T | F | U | Z 161 | deriving (Eq, Ord, Show, Data, Typeable) 162 | 163 | -- | Behavioral sequential statement 164 | data Stmt 165 | = Assign LValue Expr -- ^ non-blocking assignment 166 | | If Expr Stmt (Maybe Stmt) -- ^ @if@ statement 167 | | Case Expr [([Expr], Stmt)] (Maybe Stmt) 168 | -- ^ case statement, with optional default case 169 | | Seq [Stmt] -- ^ multiple statements in sequence 170 | | FunCallStmt Ident [Expr] -- ^ a function call that can appear as a statement, 171 | -- useful for calling Verilog tasks (e.g. $readmem). 172 | deriving (Eq, Ord, Show, Data, Typeable) 173 | 174 | -- | An 'LValue' is something that can appear on the left-hand side of an 175 | -- assignment. We're lazy and do not enforce any restriction, and define this 176 | -- simply to be 'Expr'. 177 | type LValue = Expr 178 | 179 | -- | Unary operators 180 | -- 181 | -- 'LNeg' is logical negation, 'Neg' is bitwise negation. 'UAnd', 'UNand', 182 | -- 'UOr', 'UNor', 'UXor', and 'UXnor' are sometimes called \"reduction 183 | -- operators\". 184 | 185 | data UnaryOp 186 | = UPlus | UMinus | LNeg | Neg | UAnd | UNand | UOr | UNor | UXor | UXnor 187 | deriving (Eq, Ord, Show, Data, Typeable) 188 | 189 | -- | Binary operators. 190 | -- 191 | -- These operators include almost all VHDL and Verilog operators. 192 | -- 193 | -- * precedence and pretty-printing are language specific, and defined elsewhere. 194 | -- 195 | -- * exponentation operators were introduced in Verilog-2001. 196 | -- 197 | -- * some operators are not prefix/infix, such as verilog concatenation and the 198 | -- conditional (@x ? y : z@) operator. those operators are defined in 199 | -- 'Expr'. 200 | -- 201 | -- * VHDL has both \"logical\" and \"barithmetic\" shift operators, which we 202 | -- don't yet distinguish between here. 203 | -- 204 | -- * VHDL has both a @mod@ and a @rem@ operator, but so far we only define 205 | -- 'Modulo'. 206 | -- 207 | -- * VHDL has a concat operator (@&@) that isn't yet supported here. Use 208 | -- 'ExprConcat' instead. 209 | -- 210 | -- * VHDL has an @abs@ operator that isn't yet supported here. 211 | 212 | data BinaryOp 213 | = Pow | Plus | Minus | Times | Divide | Modulo -- arithmetic 214 | | Equals | NotEquals -- logical equality 215 | | CEquals | CNotEquals -- case equality 216 | | LAnd | LOr -- logical and/or 217 | | LessThan | LessEqual | GreaterThan | GreaterEqual -- relational 218 | | And | Nand | Or | Nor | Xor | Xnor -- bitwise 219 | | ShiftLeft | ShiftRight | RotateLeft | RotateRight -- shift/rotate 220 | deriving (Eq, Ord, Show, Data, Typeable) 221 | 222 | -- ----------------------------------------------------------------------------- 223 | -- GENERATED START 224 | 225 | 226 | instance Binary Module where 227 | put (Module x1 x2 x3 x4 x5) 228 | = do put x1 229 | put x2 230 | put x3 231 | put x4 232 | put x5 233 | get 234 | = do x1 <- get 235 | x2 <- get 236 | x3 <- get 237 | x4 <- get 238 | x5 <- get 239 | return (Module x1 x2 x3 x4 x5) 240 | 241 | 242 | instance Binary Decl where 243 | put x 244 | = case x of 245 | NetDecl x1 x2 x3 -> do putWord8 0 246 | put x1 247 | put x2 248 | put x3 249 | NetAssign x1 x2 -> do putWord8 1 250 | put x1 251 | put x2 252 | MemDecl x1 x2 x3 -> do putWord8 2 253 | put x1 254 | put x2 255 | put x3 256 | InstDecl x1 x2 x3 x4 x5 -> do putWord8 3 257 | put x1 258 | put x2 259 | put x3 260 | put x4 261 | put x5 262 | ProcessDecl x1 x2 x3 -> do putWord8 4 263 | put x1 264 | put x2 265 | put x3 266 | InitProcessDecl x1 -> do putWord8 5 267 | put x1 268 | CommentDecl x1 -> do putWord8 6 269 | put x1 270 | get 271 | = do i <- getWord8 272 | case i of 273 | 0 -> do x1 <- get 274 | x2 <- get 275 | x3 <- get 276 | return (NetDecl x1 x2 x3) 277 | 1 -> do x1 <- get 278 | x2 <- get 279 | return (NetAssign x1 x2) 280 | 2 -> do x1 <- get 281 | x2 <- get 282 | x3 <- get 283 | return (MemDecl x1 x2 x3) 284 | 3 -> do x1 <- get 285 | x2 <- get 286 | x3 <- get 287 | x4 <- get 288 | x5 <- get 289 | return (InstDecl x1 x2 x3 x4 x5) 290 | 4 -> do x1 <- get 291 | x2 <- get 292 | x3 <- get 293 | return (ProcessDecl x1 x2 x3) 294 | 5 -> do x1 <- get 295 | return (InitProcessDecl x1) 296 | 6 -> do x1 <- get 297 | return (CommentDecl x1) 298 | _ -> error "Corrupted binary data for Decl" 299 | 300 | 301 | instance Binary Range where 302 | put (Range x1 x2) 303 | = do put x1 304 | put x2 305 | get 306 | = do x1 <- get 307 | x2 <- get 308 | return (Range x1 x2) 309 | 310 | 311 | instance Binary Event where 312 | put (Event x1 x2) 313 | = do put x1 314 | put x2 315 | get 316 | = do x1 <- get 317 | x2 <- get 318 | return (Event x1 x2) 319 | 320 | 321 | instance Binary Edge where 322 | put x 323 | = case x of 324 | PosEdge -> putWord8 0 325 | NegEdge -> putWord8 1 326 | get 327 | = do i <- getWord8 328 | case i of 329 | 0 -> return PosEdge 330 | 1 -> return NegEdge 331 | _ -> error "Corrupted binary data for Edge" 332 | 333 | 334 | instance Binary Expr where 335 | put x 336 | = case x of 337 | ExprLit x1 x2 -> do putWord8 0 338 | put x1 339 | put x2 340 | ExprVar x1 -> do putWord8 1 341 | put x1 342 | ExprString x1 -> do putWord8 2 343 | put x1 344 | ExprIndex x1 x2 -> do putWord8 3 345 | put x1 346 | put x2 347 | ExprSlice x1 x2 x3 -> do putWord8 4 348 | put x1 349 | put x2 350 | put x3 351 | ExprSliceOff x1 x2 x3 -> do putWord8 5 352 | put x1 353 | put x2 354 | put x3 355 | ExprCase x1 x2 x3 -> do putWord8 6 356 | put x1 357 | put x2 358 | put x3 359 | ExprConcat x1 -> do putWord8 7 360 | put x1 361 | ExprCond x1 x2 x3 -> do putWord8 8 362 | put x1 363 | put x2 364 | put x3 365 | ExprUnary x1 x2 -> do putWord8 9 366 | put x1 367 | put x2 368 | ExprBinary x1 x2 x3 -> do putWord8 10 369 | put x1 370 | put x2 371 | put x3 372 | ExprFunCall x1 x2 -> do putWord8 11 373 | put x1 374 | put x2 375 | get 376 | = do i <- getWord8 377 | case i of 378 | 0 -> do x1 <- get 379 | x2 <- get 380 | return (ExprLit x1 x2) 381 | 1 -> do x1 <- get 382 | return (ExprVar x1) 383 | 2 -> do x1 <- get 384 | return (ExprString x1) 385 | 3 -> do x1 <- get 386 | x2 <- get 387 | return (ExprIndex x1 x2) 388 | 4 -> do x1 <- get 389 | x2 <- get 390 | x3 <- get 391 | return (ExprSlice x1 x2 x3) 392 | 5 -> do x1 <- get 393 | x2 <- get 394 | x3 <- get 395 | return (ExprSliceOff x1 x2 x3) 396 | 6 -> do x1 <- get 397 | x2 <- get 398 | x3 <- get 399 | return (ExprCase x1 x2 x3) 400 | 7 -> do x1 <- get 401 | return (ExprConcat x1) 402 | 8 -> do x1 <- get 403 | x2 <- get 404 | x3 <- get 405 | return (ExprCond x1 x2 x3) 406 | 9 -> do x1 <- get 407 | x2 <- get 408 | return (ExprUnary x1 x2) 409 | 10 -> do x1 <- get 410 | x2 <- get 411 | x3 <- get 412 | return (ExprBinary x1 x2 x3) 413 | 11 -> do x1 <- get 414 | x2 <- get 415 | return (ExprFunCall x1 x2) 416 | _ -> error "Corrupted binary data for Expr" 417 | 418 | 419 | instance Binary ExprLit where 420 | put x 421 | = case x of 422 | ExprNum x1 -> do putWord8 0 423 | put x1 424 | ExprBit x1 -> do putWord8 1 425 | put x1 426 | ExprBitVector x1 -> do putWord8 2 427 | put x1 428 | get 429 | = do i <- getWord8 430 | case i of 431 | 0 -> do x1 <- get 432 | return (ExprNum x1) 433 | 1 -> do x1 <- get 434 | return (ExprBit x1) 435 | 2 -> do x1 <- get 436 | return (ExprBitVector x1) 437 | _ -> error "Corrupted binary data for ExprLit" 438 | 439 | 440 | instance Binary Bit where 441 | put x 442 | = case x of 443 | T -> putWord8 0 444 | F -> putWord8 1 445 | U -> putWord8 2 446 | Z -> putWord8 3 447 | get 448 | = do i <- getWord8 449 | case i of 450 | 0 -> return T 451 | 1 -> return F 452 | 2 -> return U 453 | 3 -> return Z 454 | _ -> error "Corrupted binary data for Bit" 455 | 456 | 457 | instance Binary Stmt where 458 | put x 459 | = case x of 460 | Assign x1 x2 -> do putWord8 0 461 | put x1 462 | put x2 463 | If x1 x2 x3 -> do putWord8 1 464 | put x1 465 | put x2 466 | put x3 467 | Case x1 x2 x3 -> do putWord8 2 468 | put x1 469 | put x2 470 | put x3 471 | Seq x1 -> do putWord8 3 472 | put x1 473 | FunCallStmt x1 x2 -> do putWord8 4 474 | put x1 475 | put x2 476 | get 477 | = do i <- getWord8 478 | case i of 479 | 0 -> do x1 <- get 480 | x2 <- get 481 | return (Assign x1 x2) 482 | 1 -> do x1 <- get 483 | x2 <- get 484 | x3 <- get 485 | return (If x1 x2 x3) 486 | 2 -> do x1 <- get 487 | x2 <- get 488 | x3 <- get 489 | return (Case x1 x2 x3) 490 | 3 -> do x1 <- get 491 | return (Seq x1) 492 | 4 -> do x1 <- get 493 | x2 <- get 494 | return (FunCallStmt x1 x2) 495 | _ -> error "Corrupted binary data for Stmt" 496 | 497 | 498 | instance Binary UnaryOp where 499 | put x 500 | = case x of 501 | UPlus -> putWord8 0 502 | UMinus -> putWord8 1 503 | LNeg -> putWord8 2 504 | Neg -> putWord8 3 505 | UAnd -> putWord8 4 506 | UNand -> putWord8 5 507 | UOr -> putWord8 6 508 | UNor -> putWord8 7 509 | UXor -> putWord8 8 510 | UXnor -> putWord8 9 511 | get 512 | = do i <- getWord8 513 | case i of 514 | 0 -> return UPlus 515 | 1 -> return UMinus 516 | 2 -> return LNeg 517 | 3 -> return Neg 518 | 4 -> return UAnd 519 | 5 -> return UNand 520 | 6 -> return UOr 521 | 7 -> return UNor 522 | 8 -> return UXor 523 | 9 -> return UXnor 524 | _ -> error "Corrupted binary data for UnaryOp" 525 | 526 | 527 | instance Binary BinaryOp where 528 | put x 529 | = case x of 530 | Pow -> putWord8 0 531 | Plus -> putWord8 1 532 | Minus -> putWord8 2 533 | Times -> putWord8 3 534 | Divide -> putWord8 4 535 | Modulo -> putWord8 5 536 | Equals -> putWord8 6 537 | NotEquals -> putWord8 7 538 | CEquals -> putWord8 8 539 | CNotEquals -> putWord8 9 540 | LAnd -> putWord8 10 541 | LOr -> putWord8 11 542 | LessThan -> putWord8 12 543 | LessEqual -> putWord8 13 544 | GreaterThan -> putWord8 14 545 | GreaterEqual -> putWord8 15 546 | And -> putWord8 16 547 | Nand -> putWord8 17 548 | Or -> putWord8 18 549 | Nor -> putWord8 19 550 | Xor -> putWord8 20 551 | Xnor -> putWord8 21 552 | ShiftLeft -> putWord8 22 553 | ShiftRight -> putWord8 23 554 | RotateLeft -> putWord8 24 555 | RotateRight -> putWord8 25 556 | get 557 | = do i <- getWord8 558 | case i of 559 | 0 -> return Pow 560 | 1 -> return Plus 561 | 2 -> return Minus 562 | 3 -> return Times 563 | 4 -> return Divide 564 | 5 -> return Modulo 565 | 6 -> return Equals 566 | 7 -> return NotEquals 567 | 8 -> return CEquals 568 | 9 -> return CNotEquals 569 | 10 -> return LAnd 570 | 11 -> return LOr 571 | 12 -> return LessThan 572 | 13 -> return LessEqual 573 | 14 -> return GreaterThan 574 | 15 -> return GreaterEqual 575 | 16 -> return And 576 | 17 -> return Nand 577 | 18 -> return Or 578 | 19 -> return Nor 579 | 20 -> return Xor 580 | 21 -> return Xnor 581 | 22 -> return ShiftLeft 582 | 23 -> return ShiftRight 583 | 24 -> return RotateLeft 584 | 25 -> return RotateRight 585 | _ -> error "Corrupted binary data for BinaryOp" 586 | -- GENERATED STOP 587 | -------------------------------------------------------------------------------- /netlist/Language/Netlist/Examples.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Netlist.Examples 4 | -- Copyright : (c) Signali Corp. 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : pweaver@signalicorp.com 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Examples of Netlist AST. 12 | -------------------------------------------------------------------------------- 13 | 14 | {-# LANGUAGE ParallelListComp #-} 15 | 16 | module Language.Netlist.Examples where 17 | 18 | import Language.Netlist.AST 19 | import Language.Netlist.Util 20 | 21 | -- ----------------------------------------------------------------------------- 22 | 23 | t :: Module 24 | t = Module "foo" (f ins) (f outs) [] ds 25 | where 26 | f xs = [ (x, makeRange Down sz) | (x, sz) <- xs ] 27 | ins = [("clk", 1), ("reset", 1), ("enable", 1), ("x", 16)] 28 | outs = [("z", 16)] 29 | 30 | ds :: [Decl] 31 | ds = [ NetDecl "a" (makeRange Down 16) (Just (ExprVar "x")) 32 | , NetDecl "b" (makeRange Down 16) (Just (sizedInteger 16 10)) 33 | , MemDecl "c" Nothing (makeRange Down 16) 34 | , ProcessDecl (Event (ExprVar "clk") PosEdge) 35 | (Just (Event (ExprVar "reset") PosEdge, (Assign (ExprVar "c") (sizedInteger 16 0)))) 36 | (If (ExprVar "enable") 37 | (Assign (ExprVar "c") (ExprVar "x")) 38 | Nothing) 39 | ] 40 | 41 | var_exprs :: [Expr] 42 | var_exprs = [ ExprVar [x] | x <- "abcdefghijklmnopqrstuvwxyz" ] 43 | 44 | stmts :: [Stmt] 45 | stmts = [ Assign x (unsizedInteger i) | x <- var_exprs | i <- [0..] ] 46 | 47 | if0 :: Stmt 48 | if0 = If e0 s0 $ Just $ 49 | If e1 s1' $ Just $ 50 | If e2 s2' $ Just s3' 51 | where 52 | s1' = Seq [s1, s2, s3] 53 | s2' = Seq [s4, s5, s6] 54 | s3' = s7 55 | (e0:e1:e2:_) = var_exprs 56 | (s0:s1:s2:s3:s4:s5:s6:s7:_) = stmts 57 | 58 | if1 :: Stmt 59 | if1 = If e0 (If e1 s1 Nothing) (Just (If e2 s2 Nothing)) 60 | where 61 | (e0:e1:e2:_) = var_exprs 62 | (_:s1:s2:_) = stmts 63 | 64 | -- ----------------------------------------------------------------------------- 65 | -------------------------------------------------------------------------------- /netlist/Language/Netlist/Inline.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Netlist.Inline 4 | -- Copyright : (c) Signali Corp. 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : pweaver@signalicorp.com 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- A simple inliner for a Netlist AST ('Language.Netlist.AST'). 12 | -------------------------------------------------------------------------------- 13 | 14 | {-# LANGUAGE Rank2Types, PatternGuards #-} 15 | 16 | module Language.Netlist.Inline ( inlineModule ) where 17 | 18 | import Data.Generics 19 | --import Data.List 20 | import Data.Maybe 21 | import Data.Map (Map) 22 | import qualified Data.Map as Map 23 | 24 | import Language.Netlist.AST 25 | 26 | -- ----------------------------------------------------------------------------- 27 | 28 | -- | Produce a new module in which some variables have been inlined. An 29 | -- expression is inlined (and it\'s declaration removed) if it only used in one 30 | -- place in the entire module. 31 | inlineModule :: Module -> Module 32 | inlineModule (Module name inputs outputs statics decls) 33 | = Module name inputs outputs statics decls'' 34 | where 35 | deps = getIdentExprs decls 36 | bs = getBindings decls 37 | bs' = Map.filterWithKey (shouldInline (map fst outputs) deps) bs 38 | decls' = replaceExprs bs' decls 39 | decls'' = removeDecls (Map.keys bs') decls' 40 | 41 | -- given a list of identifier-to-expression bindings, replace the identifiers 42 | -- everywhere in an AST. Note: "everywhere" applies bottom-up. We want 43 | -- everywhere', which is top-down. 44 | replaceExprs :: forall a. (Data a) => Map Ident Expr -> a -> a 45 | replaceExprs bs a = everywhere' (mkT f) a 46 | where 47 | f e 48 | | ExprVar x <- e, Just e' <- Map.lookup x bs 49 | = e' -- replaceExprs bs e' 50 | | otherwise = e 51 | 52 | -- this is essentially a DCE pass. it removes the declarations that have been inlined. 53 | removeDecls :: [Ident] -> [Decl] -> [Decl] 54 | removeDecls xs = mapMaybe f 55 | where 56 | f d@(NetDecl x _ _) 57 | = if elem x xs then Nothing else Just d 58 | f d@(NetAssign x _) 59 | = if elem x xs then Nothing else Just d 60 | f decl 61 | = Just decl 62 | 63 | -- ----------------------------------------------------------------------------- 64 | -- utility functions 65 | 66 | getBindings :: [Decl] -> Map Ident Expr 67 | getBindings = Map.unions . map getDeclBinding 68 | 69 | getDeclBinding :: Decl -> Map Ident Expr 70 | getDeclBinding (NetDecl x _ (Just expr)) 71 | = Map.singleton x expr 72 | getDeclBinding (NetAssign x expr) 73 | = Map.singleton x expr 74 | getDeclBinding _ 75 | = Map.empty 76 | 77 | shouldInline :: [Ident] -> Map Ident [Expr] -> Ident -> Expr -> Bool 78 | shouldInline ignore deps x e 79 | | x `notElem` ignore, Just n <- checkUsers 80 | = case e of 81 | -- always inline trivial expressions regardless of the number of users. 82 | ExprLit _ _ -> True 83 | ExprString _ -> True 84 | ExprVar _ -> True 85 | ExprIndex _ _ -> True 86 | ExprSlice _ _ _ -> True 87 | -- ExprSliceOff _ _ _ -> True 88 | 89 | -- never inline case expressions. as far as we know, there's no case 90 | -- /expression/ in Verilog. we leave ExprCase alone here so that it may 91 | -- be easier to translate to, for example, a case /statement/ in a 92 | -- combinational process in HDL. 93 | ExprCase {} -> False 94 | 95 | -- any complex expressions should only be inlined if they're used once. 96 | _ -> n == 1 97 | 98 | | otherwise 99 | = False 100 | where 101 | -- returns Nothing if this identifier cannot be inlined because it is 102 | -- referred to by a Index/Project/FuncCall. returns Just n if the only 103 | -- users are 'n' number of ExprVar expressions. 104 | checkUsers 105 | = if all checkUser zs then Just (length zs) else Nothing 106 | where 107 | zs = fromMaybe [] (Map.lookup x deps) 108 | checkUser (ExprVar _) = True 109 | checkUser _ = False 110 | 111 | -- map each identifier to every expression that directly refers to that identifier. 112 | getIdentExprs :: forall a. (Data a) => a -> Map Ident [Expr] 113 | getIdentExprs a = f Map.empty (getAll a) 114 | where 115 | f :: Map Ident [Expr] -> [Expr] -> Map Ident [Expr] 116 | f m [] = m 117 | f m (expr:rest) 118 | = f m' rest 119 | where m' = case maybeExprIdent expr of 120 | Just v -> Map.insertWith (++) v [expr] m 121 | Nothing -> m 122 | 123 | -- generically get a list of all terms of a certain type. 124 | getAll :: forall a b. (Data a, Typeable b) => a -> [b] 125 | getAll = listify (\_ -> True) 126 | 127 | -- if an expression references an identifier directly, return the identifier. 128 | -- note that subexpressions are not counted here! 129 | maybeExprIdent :: Expr -> Maybe Ident 130 | maybeExprIdent (ExprVar x) = Just x 131 | maybeExprIdent (ExprIndex x _) = Just x 132 | maybeExprIdent (ExprSlice x _ _) = Just x 133 | maybeExprIdent (ExprSliceOff x _ _) = Just x 134 | maybeExprIdent (ExprFunCall x _) = Just x 135 | maybeExprIdent _ = Nothing 136 | 137 | -- ----------------------------------------------------------------------------- 138 | -------------------------------------------------------------------------------- /netlist/Language/Netlist/Util.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Netlist.Util 4 | -- Copyright : (c) Signali Corp. 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : pweaver@signalicorp.com 8 | -- Stability : experimental 9 | -- Portability : non-portable 10 | -- 11 | -- Utility functions for constructing Netlist AST elements. 12 | -------------------------------------------------------------------------------- 13 | 14 | module Language.Netlist.Util where 15 | 16 | import Language.Netlist.AST 17 | 18 | -- ----------------------------------------------------------------------------- 19 | 20 | data Direction = Up | Down 21 | 22 | unsizedInteger :: Integer -> Expr 23 | unsizedInteger = unsizedIntegral 24 | 25 | unsizedIntegral :: Integral a => a -> Expr 26 | unsizedIntegral = ExprLit Nothing . ExprNum . toInteger 27 | 28 | sizedInteger :: Int -> Integer -> Expr 29 | sizedInteger = sizedIntegral 30 | 31 | sizedIntegral :: Integral a => Int -> a -> Expr 32 | sizedIntegral sz = ExprLit (Just sz) . ExprNum . toInteger 33 | 34 | -- | Given a direction and size, maybe generate a 'Range', where a size of 1 35 | -- yields 'Nothing'. 36 | makeRange :: Direction -> Size -> Maybe Range 37 | makeRange _ 1 = Nothing 38 | makeRange d sz 39 | | sz > 1 40 | = let upper = unsizedIntegral (sz - 1) 41 | lower = unsizedInteger 0 42 | in Just $ case d of 43 | Up -> Range lower upper 44 | Down -> Range upper lower 45 | 46 | | otherwise 47 | = error ("makeRange: invalid size: " ++ show sz) 48 | 49 | -- | Concatenate a list of expressions, unless there is just one expression. 50 | exprConcat :: [Expr] -> Expr 51 | exprConcat [e] = e 52 | exprConcat es = ExprConcat es 53 | 54 | -- | Make a 'Seq' statement from a list of statements, unless there is just one 55 | -- statement. 56 | statements :: [Stmt] -> Stmt 57 | statements [x] = x 58 | statements xs = Seq xs 59 | 60 | -- ----------------------------------------------------------------------------- 61 | 62 | -- | generate a process declaration for a generic register based on the following: 63 | -- 64 | -- * the register name (as an expression) 65 | -- 66 | -- * clock expression 67 | -- 68 | -- * width of the register 69 | -- 70 | -- * optional asynchronous reset and initial value 71 | -- 72 | -- * optional clock enable 73 | -- 74 | -- * optional synchronous restart and initial value 75 | -- 76 | -- * optional load enable 77 | -- 78 | -- * when enabled, the expression to assign to the identifier 79 | -- 80 | -- You can implement a shift register by passing in a concatenation for the 81 | -- register expression and the input expression, though that is not compatible 82 | -- with VHDL. 83 | -- 84 | 85 | -- TODO 86 | -- * support negative-edge triggered clock/reset, active-low reset/restart 87 | -- * support true clock enable (as opposed to load enable)? 88 | 89 | generateReg :: Expr -> Expr -> Maybe (Expr, Expr) -> Maybe (Expr, Expr) -> 90 | Maybe Expr -> Expr -> Decl 91 | generateReg x clk mb_reset mb_restart mb_enable expr 92 | = ProcessDecl (Event clk PosEdge) mb_reset' stmt2 93 | where 94 | mb_reset' = case mb_reset of 95 | Just (reset, initial) -> Just (Event reset PosEdge, Assign x initial) 96 | Nothing -> Nothing 97 | 98 | stmt2 = case mb_restart of 99 | Just (restart, initial) 100 | -> If restart (Assign x initial) (Just stmt1) 101 | Nothing 102 | -> stmt1 103 | 104 | stmt1 = case mb_enable of 105 | Just enable -> If enable stmt0 Nothing 106 | Nothing -> stmt0 107 | 108 | stmt0 = Assign x expr 109 | 110 | -- ----------------------------------------------------------------------------- 111 | -------------------------------------------------------------------------------- /netlist/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /netlist/netlist.cabal: -------------------------------------------------------------------------------- 1 | name: netlist 2 | version: 0.2 3 | synopsis: Netlist AST 4 | description: A very simplified and generic netlist designed to be compatible with 5 | Hardware Description Languages (HDLs) like Verilog and VHDL. 6 | Includes a simple inliner. 7 | category: Language 8 | license: BSD3 9 | license-file: LICENSE 10 | copyright: Copyright (c) 2010 Signali Corp. 11 | Copyright (c) 2010 Philip Weaver 12 | author: Philip Weaver 13 | maintainer: philip.weaver@gmail.com 14 | package-url: git://github.com/pheaver/netlist-verilog.git 15 | build-type: Simple 16 | cabal-version: >=1.6 17 | 18 | flag base4 19 | Description: Compile using base-4 instead of base-3 20 | Default: True 21 | 22 | Library 23 | ghc-options: -Wall 24 | 25 | exposed-modules: Language.Netlist.AST, 26 | Language.Netlist.Inline, 27 | Language.Netlist.Util 28 | other-modules: Language.Netlist.Examples 29 | 30 | build-depends: binary, containers 31 | if flag(base4) 32 | build-depends: base == 4.*, syb 33 | else 34 | build-depends: base == 3.* 35 | -------------------------------------------------------------------------------- /verilog/LICENSE: -------------------------------------------------------------------------------- 1 | Copyright 2010, Signali Corp. 2 | 3 | All Rights Reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of other contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /verilog/Language/Verilog.hs: -------------------------------------------------------------------------------- 1 | -- ----------------------------------------------------------------------------- 2 | -- Copyright (c) 2010 Signali Corp. 3 | -- ----------------------------------------------------------------------------- 4 | 5 | module Language.Verilog ( module Language.Verilog.Syntax 6 | , module Language.Verilog.Parser 7 | , module Language.Verilog.PrettyPrint 8 | ) where 9 | 10 | import Language.Verilog.Syntax 11 | import Language.Verilog.Parser 12 | import Language.Verilog.PrettyPrint 13 | 14 | -- ----------------------------------------------------------------------------- 15 | -------------------------------------------------------------------------------- /verilog/Language/Verilog/ParserTest.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | 3 | module Language.Verilog.ParserTest where 4 | 5 | import Prelude hiding (catch) 6 | 7 | import System.Directory (getDirectoryContents) 8 | import System.FilePath ((), replaceExtension, takeExtension) 9 | import Text.PrettyPrint (render) 10 | import Text.Parsec (parse) 11 | import Text.Parsec.ByteString (parseFromFile) 12 | 13 | import Language.Verilog.Parser 14 | import Language.Verilog.PrettyPrint (ppVerilog) 15 | import Language.Verilog.Syntax (Verilog) 16 | 17 | -------------------------------------------------------------------------------- 18 | 19 | examples_dir :: FilePath 20 | examples_dir = "./verilog/examples" 21 | 22 | check_all :: IO () 23 | check_all 24 | = do files <- getDirectoryContents examples_dir 25 | sequence_ [ check f 26 | | f <- files 27 | , takeExtension f == ".v" 28 | ] 29 | return () 30 | 31 | check :: FilePath -> IO () 32 | check baseName 33 | = do result1 <- parseFromFile verilogFile fp 34 | case result1 of 35 | Left err1 -> do writeFile fp_err1 (show err1 ++ "\n") 36 | putStrLn ("Fail1: " ++ baseName) 37 | Right ast1 -> do let str1 = render (ppVerilog ast1) 38 | writeFile fp1 str1 39 | result2 <- parseFromFile verilogFile fp1 40 | case result2 of 41 | Left err2 -> do writeFile fp_err2 (show err2 ++ "\n") 42 | putStrLn ("Fail2: " ++ baseName) 43 | Right ast2 -> do let str2 = render (ppVerilog ast2) 44 | writeFile fp2 str2 45 | if (ast1 == ast2) 46 | then putStrLn ("Match: " ++ baseName) 47 | else do writeFile fp_err3 "" 48 | putStrLn ("No match: " ++ baseName) 49 | where 50 | fp = examples_dir baseName 51 | fp1 = replaceExtension fp "v.2" 52 | fp2 = replaceExtension fp "v.3" 53 | fp_err1 = replaceExtension fp "err1" 54 | fp_err2 = replaceExtension fp "err2" 55 | fp_err3 = replaceExtension fp "err3" 56 | 57 | parseVerilog :: String -> Verilog 58 | parseVerilog x 59 | = case parse verilogFile "" x of 60 | Left err -> error (show err) 61 | Right y -> y 62 | 63 | test :: FilePath -> IO () 64 | test fp 65 | = do x <- run fp 66 | putStrLn (render (ppVerilog x)) 67 | 68 | run :: FilePath -> IO Verilog 69 | run fp 70 | = do x <- parseFromFile verilogFile fp 71 | case x of 72 | Left err -> error (show err) 73 | Right y -> return y 74 | 75 | -------------------------------------------------------------------------------- 76 | 77 | -------------------------------------------------------------------------------- /verilog/Language/Verilog/PrettyPrint.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Verilog.PrettyPrint 4 | -- Copyright : (c) Signali Corp. 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : pweaver@signalicorp.com 8 | -- Stability : experimental 9 | -- Portability : non-portable (DeriveDataTypeable) 10 | -- 11 | -- A pretty printer for the Verilog AST. 12 | -------------------------------------------------------------------------------- 13 | 14 | {-# OPTIONS_GHC -fno-warn-orphans #-} 15 | 16 | module Language.Verilog.PrettyPrint where 17 | 18 | import Data.Maybe ( fromMaybe ) 19 | import Text.PrettyPrint 20 | 21 | import Language.Verilog.Syntax 22 | 23 | -- ----------------------------------------------------------------------------- 24 | -- some utilities, which should go in a common module elsewhere 25 | 26 | commasep :: [Doc] -> Doc 27 | commasep = fsep . punctuate comma 28 | 29 | mb :: (x -> Doc) -> Maybe x -> Doc 30 | mb = maybe empty 31 | 32 | period :: Doc 33 | period = char '.' 34 | 35 | tick :: Doc 36 | tick = char '\'' 37 | 38 | -- ----------------------------------------------------------------------------- 39 | -- 1. Source Text 40 | 41 | ppVerilog :: Verilog -> Doc 42 | ppVerilog (Verilog ds) 43 | = vcat (map ppDescription ds) 44 | 45 | ppDescription :: Description -> Doc 46 | ppDescription (ModuleDescription m) = ppModule m 47 | ppDescription (UDPDescription udp) = ppUDP udp 48 | 49 | ppModule :: Module -> Doc 50 | ppModule (Module name ports body) 51 | = text "module" <+> ppIdent name <+> ppPorts ports <> semi $$ 52 | nest 2 (vcat (map ppItem body)) $$ 53 | text "endmodule" <> char '\n' 54 | 55 | ppPorts :: [Ident] -> Doc 56 | ppPorts [] = empty 57 | ppPorts xs = parens (ppIdents xs) 58 | 59 | ppItem :: Item -> Doc 60 | ppItem (ParamDeclItem x) = ppParamDecl x 61 | ppItem (InputDeclItem x) = ppInputDecl x 62 | ppItem (OutputDeclItem x) = ppOutputDecl x 63 | ppItem (InOutDeclItem x) = ppInOutDecl x 64 | ppItem (NetDeclItem x) = ppNetDecl x 65 | ppItem (RegDeclItem x) = ppRegDecl x 66 | ppItem (EventDeclItem x) = ppEventDecl x 67 | ppItem (PrimitiveInstItem x) = ppPrimitiveInst x 68 | ppItem (InstanceItem x) = ppInstance x 69 | ppItem (ParamOverrideItem xs) 70 | = text "defparam" <+> ppParamAssigns xs <> semi 71 | ppItem (AssignItem mb_strength mb_delay assignments) 72 | = text "assign" <+> 73 | mb ppDriveStrength mb_strength <+> 74 | mb ppDelay mb_delay <+> 75 | commasep (map ppAssignment assignments) <> semi 76 | ppItem (InitialItem (EventControlStmt ctrl stmt)) 77 | = fsep [ text "initial", ppEventControl ctrl, nest 2 (maybe semi ppStatement stmt) ] 78 | ppItem (InitialItem stmt) 79 | = fsep [ text "initial", nest 2 (ppStatement stmt) ] 80 | ppItem (AlwaysItem (EventControlStmt ctrl stmt)) 81 | = fsep [ text "always", ppEventControl ctrl, nest 2 (maybe semi ppStatement stmt) ] 82 | ppItem (AlwaysItem stmt) 83 | = fsep [ text "always", nest 2 (ppStatement stmt) ] 84 | 85 | ppItem (TaskItem name decls stmt) 86 | = text "task" <+> ppIdent name <> semi $$ 87 | nest 2 (vcat (map ppLocalDecl decls) $$ 88 | ppStatement stmt) $$ 89 | text "endtask" 90 | 91 | ppItem (FunctionItem t name decls stmt) 92 | = text "function" <+> mb ppFunctionType t <+> ppIdent name <> semi $$ 93 | nest 2 (vcat (map ppLocalDecl decls) $$ 94 | ppStatement stmt) $$ 95 | text "endfunction" 96 | 97 | -- (copied from andy's code in GenVHDL) 98 | -- TODO: get multline working 99 | ppItem (CommentItem msg) 100 | = vcat [ text "//" <+> text m | m <- lines msg ] 101 | 102 | ppUDP :: UDP -> Doc 103 | ppUDP (UDP name output_var input_vars decls maybe_initial table_definition) 104 | = text "primitive" <+> ppIdent name <+> 105 | parens (ppIdents (output_var : input_vars)) <> semi $$ 106 | nest 2 ( vcat (map ppUDPDecl decls) $$ 107 | maybe empty ppUDPInitialStatement maybe_initial $$ 108 | ppTableDefinition table_definition 109 | ) $$ 110 | text "endprimitive" 111 | 112 | ppUDPDecl :: UDPDecl -> Doc 113 | ppUDPDecl (UDPOutputDecl d) = ppOutputDecl d 114 | ppUDPDecl (UDPInputDecl d) = ppInputDecl d 115 | ppUDPDecl (UDPRegDecl x) = text "reg" <+> ppIdent x <> semi 116 | 117 | ppUDPInitialStatement :: UDPInitialStatement -> Doc 118 | ppUDPInitialStatement (UDPInitialStatement name value) 119 | = text "initial" <+> ppIdent name <+> equals <+> ppExpr value <> semi 120 | 121 | ppTableDefinition :: TableDefinition -> Doc 122 | ppTableDefinition table 123 | = text "table" $$ 124 | nest 2 (vcat xs) $$ 125 | text "endtable" 126 | where 127 | xs = case table of 128 | CombinationalTable entries -> map ppCombinationalEntry entries 129 | SequentialTable entries -> map ppSequentialEntry entries 130 | 131 | ppCombinationalEntry :: CombinationalEntry -> Doc 132 | ppCombinationalEntry (CombinationalEntry inputs output) 133 | = hsep (map ppLevelSymbol inputs) <+> colon <+> ppOutputSymbol output <> semi 134 | 135 | ppSequentialEntry :: SequentialEntry -> Doc 136 | ppSequentialEntry (SequentialEntry inputs state next_state) 137 | = hsep (map (either ppLevelSymbol ppEdge) inputs) <+> colon <+> 138 | ppLevelSymbol state <+> colon <+> ppNextState next_state <> semi 139 | 140 | ppEdge :: Edge -> Doc 141 | ppEdge (EdgeLevels x y) 142 | = parens (ppLevelSymbol x <+> ppLevelSymbol y) 143 | ppEdge (EdgeSymbol x) 144 | = ppEdgeSymbol x 145 | 146 | ppOutputSymbol :: OutputSymbol -> Doc 147 | ppOutputSymbol x 148 | | validOutputSymbol x = char x 149 | | otherwise = error ("ppOutputSymbol: invalid character: " ++ [x]) 150 | 151 | ppLevelSymbol :: LevelSymbol -> Doc 152 | ppLevelSymbol x 153 | | validLevelSymbol x = char x 154 | | otherwise = error ("ppLevelSymbol: invalid character: " ++ [x]) 155 | 156 | ppNextState :: NextState -> Doc 157 | ppNextState x 158 | | validNextState x = char x 159 | | otherwise = error ("ppNextState: invalid character: " ++ [x]) 160 | 161 | ppEdgeSymbol :: EdgeSymbol -> Doc 162 | ppEdgeSymbol x 163 | | validEdgeSymbol x = char x 164 | | otherwise = error ("ppEdgeSymbol: invalid character: " ++ [x]) 165 | 166 | -- ----------------------------------------------------------------------------- 167 | -- 2. Declarations 168 | 169 | ppFunctionType :: FunctionType -> Doc 170 | ppFunctionType (FunctionTypeRange r) = ppRange r 171 | ppFunctionType FunctionTypeInteger = text "integer" 172 | ppFunctionType FunctionTypeReal = text "real" 173 | 174 | ppLocalDecl :: LocalDecl -> Doc 175 | ppLocalDecl (LocalParamDecl x) = ppParamDecl x 176 | ppLocalDecl (LocalInputDecl x) = ppInputDecl x 177 | ppLocalDecl (LocalOutputDecl x) = ppOutputDecl x 178 | ppLocalDecl (LocalInOutDecl x) = ppInOutDecl x 179 | ppLocalDecl (LocalRegDecl x) = ppRegDecl x 180 | 181 | ppParamDecl :: ParamDecl -> Doc 182 | ppParamDecl (ParamDecl paramAssigns) 183 | = text "parameter" <+> ppParamAssigns paramAssigns <> semi 184 | 185 | ppInputDecl :: InputDecl -> Doc 186 | ppInputDecl (InputDecl mb_range vars) 187 | = text "input" <+> mb ppRange mb_range <+> ppIdents vars <> semi 188 | 189 | ppOutputDecl :: OutputDecl -> Doc 190 | ppOutputDecl (OutputDecl mb_range vars) 191 | = text "output" <+> mb ppRange mb_range <+> ppIdents vars <> semi 192 | 193 | ppInOutDecl :: InOutDecl -> Doc 194 | ppInOutDecl (InOutDecl mb_range vars) 195 | = text "inout" <+> mb ppRange mb_range <+> ppIdents vars <> semi 196 | 197 | ppNetDecl :: NetDecl -> Doc 198 | ppNetDecl (NetDecl t mb_range mb_delay vars) 199 | = text (show t) <+> 200 | mb ppExpandRange mb_range <+> 201 | mb ppDelay mb_delay <+> 202 | ppIdents vars <> semi 203 | ppNetDecl (NetDeclAssign t mb_strength mb_range mb_delay assignments) 204 | = text (show t) <+> 205 | mb ppDriveStrength mb_strength <+> 206 | mb ppExpandRange mb_range <+> 207 | mb ppDelay mb_delay <+> 208 | commasep [ ppIdent x <+> equals <+> ppExpr e 209 | | (x, e) <- assignments 210 | ] <> semi 211 | 212 | ppRegDecl :: RegDecl -> Doc 213 | ppRegDecl (RegDecl reg_type mb_range vars) 214 | = text (show reg_type) <+> mb ppRange mb_range <+> ppRegVars vars <> semi 215 | 216 | ppRegVar :: RegVar -> Doc 217 | ppRegVar (RegVar x Nothing) 218 | = ppIdent x 219 | ppRegVar (RegVar x (Just e)) 220 | = ppIdent x <+> equals <+> ppExpr e 221 | ppRegVar (MemVar x r) 222 | = ppIdent x <+> ppRange r 223 | 224 | ppRegVars :: [RegVar] -> Doc 225 | ppRegVars = commasep . map ppRegVar 226 | 227 | ppEventDecl :: EventDecl -> Doc 228 | ppEventDecl (EventDecl vars) 229 | = text "event" <+> ppIdents vars <> semi 230 | 231 | -- ----------------------------------------------------------------------------- 232 | -- 3. Primitive Instances 233 | 234 | ppPrimitiveInst :: PrimitiveInst -> Doc 235 | ppPrimitiveInst (PrimitiveInst prim_type strength delay insts) 236 | = text (show prim_type) <+> mb ppDriveStrength strength <+> 237 | mb ppDelay delay <+> commasep (map ppPrimInst insts) <> semi 238 | 239 | ppPrimInst :: PrimInst -> Doc 240 | ppPrimInst (PrimInst prim_name es) 241 | = mb ppPrimName prim_name <+> parens (commasep (map ppExpr es)) 242 | 243 | ppPrimName :: PrimInstName -> Doc 244 | ppPrimName (PrimInstName x r) 245 | = ppIdent x <> mb ppRange r 246 | 247 | -- ----------------------------------------------------------------------------- 248 | -- 4. Module Instantiations 249 | 250 | ppInstance :: Instance -> Doc 251 | ppInstance (Instance name delays_or_params insts) 252 | = ppIdent name <+> ppDelaysOrParams delays_or_params $$ 253 | nest 2 (ppInsts insts) <> semi 254 | 255 | ppDelaysOrParams :: Either [Expression] [Parameter] -> Doc 256 | ppDelaysOrParams (Left []) = empty 257 | ppDelaysOrParams (Right []) = empty 258 | ppDelaysOrParams (Left es) 259 | = char '#' <> parens (commasep (map ppExpr es)) 260 | ppDelaysOrParams (Right ps) 261 | = char '#' <> parens (commasep (map ppParameter ps)) 262 | 263 | ppParameter :: Parameter -> Doc 264 | ppParameter (Parameter x expr) 265 | = period <> ppIdent x <> parens (ppExpr expr) 266 | 267 | ppInsts :: [Inst] -> Doc 268 | ppInsts insts 269 | = vcat (punctuate comma (map ppInst insts)) 270 | 271 | ppInst :: Inst -> Doc 272 | ppInst (Inst x r cs) 273 | = ppIdent x <> mb ppRange r <> parens (commasep ppCs) 274 | where 275 | ppCs = case cs of 276 | Connections exprs -> map ppExpr exprs 277 | NamedConnections ncs -> map ppNamedConnection ncs 278 | 279 | -- this is used for both port connections and parameter assignments 280 | ppNamedConnection :: NamedConnection -> Doc 281 | ppNamedConnection (NamedConnection x expr) 282 | = period <> ppIdent x <> parens (ppExpr expr) 283 | 284 | -- ---------------------------------------------------------------------------- 285 | -- 5. Behavioral Statements 286 | 287 | ppStatement :: Statement -> Doc 288 | ppStatement (BlockingAssignment x ctrl expr) 289 | = ppLValue x <+> equals <+> mb ppAssignmentControl ctrl <+> ppExpr expr <> semi 290 | ppStatement (NonBlockingAssignment x ctrl expr) 291 | = ppLValue x <+> text "<=" <+> mb ppAssignmentControl ctrl <+> ppExpr expr <> semi 292 | 293 | -- we have to add a begin-end pair in order to avoid ambiguity, otherwise in the 294 | -- concrete syntax the else-branch (if2) will be associated with if1 instead of 295 | -- the outer if-statement. 296 | ppStatement (IfStmt expr (Just if1@IfStmt {}) (Just if2@IfStmt {})) 297 | = ppStatement (IfStmt expr (Just if1') (Just if2)) 298 | where 299 | if1' = SeqBlock Nothing [] [if1] 300 | ppStatement (IfStmt expr stmt1 stmt2) 301 | = (text "if" <+> parens (ppExpr expr)) `nestStmt` (maybe semi ppStatement stmt1) $$ 302 | case stmt2 of 303 | Just stmt -> ppElseBranch stmt 304 | Nothing -> empty 305 | where 306 | ppElseBranch (IfStmt e s1 s2) 307 | = (text "else if" <+> parens (ppExpr e)) `nestStmt` (maybe semi ppStatement s1) $$ 308 | case s2 of 309 | Just s -> ppElseBranch s 310 | Nothing -> empty 311 | ppElseBranch s 312 | = text "else" `nestStmt` ppStatement s 313 | 314 | ppStatement (CaseStmt case_type expr case_items) 315 | = text (show case_type) <+> parens (ppExpr expr) $$ 316 | nest 2 (vcat (map ppCaseItem case_items)) $$ 317 | text "endcase" 318 | ppStatement (ForeverStmt stmt) 319 | = text "forever" `nestStmt` ppStatement stmt 320 | ppStatement (RepeatStmt expr stmt) 321 | = (text "repeat" <+> parens (ppExpr expr)) `nestStmt` ppStatement stmt 322 | ppStatement (WhileStmt expr stmt) 323 | = (text "while" <+> parens (ppExpr expr)) `nestStmt` ppStatement stmt 324 | ppStatement (ForStmt init_assign expr_cond loop_assign stmt) 325 | = x `nestStmt` ppStatement stmt 326 | where 327 | x = text "for" <+> parens (ppAssignment init_assign <> semi <+> 328 | ppExpr expr_cond <> semi <+> 329 | ppAssignment loop_assign) 330 | ppStatement (DelayStmt delay mb_stmt) 331 | = ppDelay delay <+> maybe semi ppStatement mb_stmt 332 | ppStatement (EventControlStmt ctrl mb_stmt) 333 | = case mb_stmt of 334 | Just stmt -> ppEventControl ctrl `nestStmt` ppStatement stmt 335 | Nothing -> ppEventControl ctrl <> semi 336 | ppStatement (WaitStmt expr stmt) 337 | = (text "wait" <+> parens (ppExpr expr)) `nestStmt` maybe semi ppStatement stmt 338 | ppStatement (SeqBlock mb_name decls stmts) 339 | = text "begin" <+> x $$ 340 | nest 2 (vcat (map ppBlockDecl decls ++ map ppStatement stmts)) $$ 341 | text "end" 342 | where x = case mb_name of 343 | Just name -> colon <+> ppIdent name 344 | Nothing -> empty 345 | ppStatement (ParBlock mb_name decls stmts) 346 | = text "fork" <+> x $$ 347 | nest 2 (vcat (map ppBlockDecl decls ++ map ppStatement stmts)) $$ 348 | text "join" 349 | where x = case mb_name of 350 | Just name -> colon <+> ppIdent name 351 | Nothing -> empty 352 | ppStatement (TaskStmt x mb_es) 353 | = char '$' <> ppIdent x <> maybe empty (parens . commasep . map ppExpr) mb_es <> semi 354 | ppStatement (TaskEnableStmt name exprs) 355 | | null exprs = ppIdent name <> semi 356 | | otherwise = ppIdent name <+> parens (commasep (map ppExpr exprs)) 357 | {- 358 | ppStatement (SystemTaskEnableStmt name exprs) 359 | | null exprs = char '$' <> ppIdent name <> semi 360 | | otherwise = char '$' <> ppIdent name <+> parens (commasep (map ppExpr exprs)) 361 | -} 362 | ppStatement (DisableStmt name) 363 | = text "disable" <+> ppIdent name <> semi 364 | ppStatement (AssignStmt assignment) 365 | = text "assign" <+> ppAssignment assignment <> semi 366 | ppStatement (DeAssignStmt x) 367 | = text "deassign" <+> ppLValue x <> semi 368 | ppStatement (ForceStmt assignment) 369 | = text "force" <+> ppAssignment assignment <> semi 370 | ppStatement (ReleaseStmt x) 371 | = text "release" <+> ppLValue x <> semi 372 | 373 | -- a helper for pretty-printing statement. 'fsep' chooses whether to put the 374 | -- statement on the same line as 'x', or nest it on the next line if it doesn't 375 | -- fit on the same line. 376 | nestStmt :: Doc -> Doc -> Doc 377 | nestStmt x stmt 378 | = fsep [x, nest 2 stmt ] 379 | 380 | ppAssignment :: Assignment -> Doc 381 | ppAssignment (Assignment x expr) 382 | = ppLValue x <+> equals <+> ppExpr expr 383 | 384 | ppCaseItem :: CaseItem -> Doc 385 | ppCaseItem (CaseItem es mb_stmt) 386 | = fsep [ commasep (map ppExpr es) <+> colon, maybe semi ppStatement mb_stmt ] 387 | ppCaseItem (CaseDefault mb_stmt) 388 | = fsep [ text "default" <+> colon, maybe semi ppStatement mb_stmt ] 389 | 390 | ppBlockDecl :: BlockDecl -> Doc 391 | ppBlockDecl (ParamDeclBlock x) = ppParamDecl x 392 | ppBlockDecl (RegDeclBlock x) = ppRegDecl x 393 | ppBlockDecl (EventDeclBlock x) = ppEventDecl x 394 | 395 | -- ----------------------------------------------------------------------------- 396 | -- 7. Expressions 397 | 398 | ppLValue :: LValue -> Doc 399 | ppLValue = ppExpr 400 | 401 | ppExpr :: Expression -> Doc 402 | ppExpr = ppExpr' 0 403 | 404 | -- precedence-aware expression pretty printer - adds parens when it needs to 405 | ppExpr' :: Int -> Expression -> Doc 406 | ppExpr' _ (ExprNum x) 407 | = text (show x) 408 | 409 | ppExpr' _ (ExprVar x) 410 | = ppIdent x 411 | ppExpr' _ (ExprString x) 412 | = text (show x) 413 | ppExpr' _ (ExprIndex x expr) 414 | = ppIdent x <> brackets (ppExpr expr) 415 | ppExpr' _ (ExprSlice x e1 e2) 416 | = ppIdent x <> brackets (ppExpr e1 <> colon <> ppExpr e2) 417 | ppExpr' _ (ExprSlicePlus x e1 e2) 418 | = ppIdent x <> brackets (ppExpr e1 <> text "+:" <> ppExpr e2) 419 | ppExpr' _ (ExprSliceMinus x e1 e2) 420 | = ppIdent x <> brackets (ppExpr e1 <> text "-:" <> ppExpr e2) 421 | ppExpr' _ (ExprConcat es) 422 | = braces (commasep (map ppExpr es)) 423 | ppExpr' _ (ExprMultiConcat e es) 424 | = braces (ppExpr e <> braces (commasep (map ppExpr es))) 425 | ppExpr' prec (ExprUnary op expr) 426 | = if prec >= unary_prec then parens e else e 427 | where 428 | e = text x <> ppExpr' unary_prec expr 429 | x = lookupOp op unary_op_table 430 | ppExpr' prec (ExprBinary op expr1 expr2) 431 | = if prec > op_prec then parens e else e 432 | where 433 | e = fsep [ppExpr' op_prec expr1, text x, ppExpr' (op_prec + 1) expr2 ] 434 | (x, op_prec) = lookupOp op binary_op_table 435 | 436 | -- this adds unnecessary parens, but it makes the concrete syntax much easier to 437 | -- read 438 | {- 439 | ppExpr' prec (ExprCond e1 e2 e3) 440 | = if prec > cond_prec then parens x else x 441 | where 442 | x = fsep [ pp e1, char '?', pp e2, colon, pp e3 ] 443 | 444 | pp e 445 | | add_parens e = parens (ppExpr e) 446 | | otherwise = ppExpr e 447 | 448 | add_parens :: Expression -> Bool 449 | add_parens ExprCond{} = True 450 | add_parens _ = False 451 | -} 452 | 453 | ppExpr' prec (ExprCond e1 e2 e3) 454 | = if prec > cond_prec then parens e else e 455 | where 456 | e = fsep [ ppExpr e1, char '?', ppExpr e2, colon, ppExpr e3 ] 457 | 458 | ppExpr' _ (ExprFunCall x es) 459 | = ppIdent x <+> parens (commasep (map ppExpr es)) 460 | 461 | cond_prec, unary_prec :: Int 462 | cond_prec = 1 463 | unary_prec = 11 464 | 465 | lookupOp :: (Eq op, Show op) => op -> [(op, x)] -> x 466 | lookupOp op table 467 | = fromMaybe (error msg) (lookup op table) 468 | where msg = "showOp: cannot find operator: " ++ show op 469 | 470 | -- precedence tables, also for showing. 471 | -- these tables could also be used for parsing operators. 472 | unary_op_table :: [(UnaryOp, String)] 473 | unary_op_table 474 | = [ (UPlus, "+"), (UMinus, "-"), (UBang, "!"), (UTilde, "~") 475 | , (UAnd, "&"), (UNand, "~&"), (UOr, "|"), (UNor, "~|") 476 | , (UXor, "^"), (UXnor, "~^"), (UXnor, "^~") 477 | ] 478 | 479 | binary_op_table :: [(BinaryOp, (String, Int))] 480 | binary_op_table 481 | = [ (LOr, ("||", 2)) 482 | , (LAnd, ("&&", 3)) 483 | , (Or, ("|", 4)), (Nor, ("~|", 4)) 484 | , (And, ("&", 5)), (Nand, ("~&", 5)), (Xor, ("^", 5)), (Xnor, ("^~", 5)), (Xnor, ("~^", 5)) 485 | , (Equals, ("==", 6)), (NotEquals, ("!=", 6)), (CEquals, ("===", 6)), (CNotEquals, ("!==", 6)) 486 | , (LessThan, ("<", 7)), (LessEqual, ("<=", 7)), (GreaterThan, (">", 7)), (GreaterEqual, (">=", 7)) 487 | , (ShiftLeft, ("<<", 8)), (ShiftRight, (">>", 8)) 488 | , (Plus, ("+", 9)), (Minus, ("-", 9)) 489 | , (Times, ("*", 10)), (Divide, ("/", 10)), (Modulo, ("%", 10)) 490 | ] 491 | 492 | -- ----------------------------------------------------------------------------- 493 | -- Miscellaneous 494 | 495 | ppParamAssigns :: [ParamAssign] -> Doc 496 | ppParamAssigns paramAssigns 497 | = commasep (map ppParamAssign paramAssigns) 498 | 499 | ppParamAssign :: ParamAssign -> Doc 500 | ppParamAssign (ParamAssign ident expr) 501 | = ppIdent ident <+> equals <+> ppExpr expr 502 | 503 | ppExpandRange :: ExpandRange -> Doc 504 | ppExpandRange (SimpleRange r) 505 | = ppRange r 506 | ppExpandRange (ScalaredRange r) 507 | = text "scalared" <+> ppRange r 508 | ppExpandRange (VectoredRange r) 509 | = text "vectored" <+> ppRange r 510 | 511 | ppRange :: Range -> Doc 512 | ppRange (Range e1 e2) 513 | = brackets (ppExpr e1 <> colon <> ppExpr e2) 514 | 515 | ppAssignmentControl :: AssignmentControl -> Doc 516 | ppAssignmentControl (DelayControl delay) 517 | = ppDelay delay 518 | ppAssignmentControl (EventControl ctrl) 519 | = ppEventControl ctrl 520 | ppAssignmentControl (RepeatControl e ctrl) 521 | = text "repear" <> parens (ppExpr e) <+> ppEventControl ctrl 522 | 523 | ppDelayControl :: DelayControl -> Doc 524 | ppDelayControl = ppDelay 525 | 526 | ppEventControl :: EventControl -> Doc 527 | ppEventControl ctrl 528 | = char '@' <> 529 | case ctrl of 530 | EventControlIdent x -> ppIdent x 531 | EventControlExpr e -> parens (ppEventExpr e) 532 | EventControlWildCard -> char '*' 533 | 534 | ppDelay :: Delay -> Doc 535 | ppDelay x = char '#' <> ppExpr x 536 | 537 | ppEventExpr :: EventExpr -> Doc 538 | ppEventExpr (EventExpr expr) 539 | = ppExpr expr 540 | ppEventExpr (EventPosedge expr) 541 | = text "posedge" <+> ppExpr expr 542 | ppEventExpr (EventNegedge expr) 543 | = text "negedge" <+> ppExpr expr 544 | ppEventExpr (EventOr expr1 expr2) 545 | = ppEventExpr expr1 <+> text "or" <+> ppEventExpr expr2 546 | 547 | -- TODO: check if the string is a valid Verilog identifier. 548 | -- throw error, or convert it into a valid identifier. 549 | ppIdent :: Ident -> Doc 550 | ppIdent (Ident x) = text x 551 | 552 | ppIdents :: [Ident] -> Doc 553 | ppIdents = commasep . map ppIdent 554 | 555 | ppDriveStrength :: DriveStrength -> Doc 556 | ppDriveStrength (Strength01 s0 s1) 557 | = parens (ppStrength0 s0 <> comma <+> ppStrength1 s1) 558 | ppDriveStrength (Strength10 s1 s0) 559 | = parens (ppStrength1 s1 <> comma <+> ppStrength0 s0) 560 | 561 | ppStrength0 :: Strength0 -> Doc 562 | ppStrength0 = text . show 563 | 564 | ppStrength1 :: Strength1 -> Doc 565 | ppStrength1 = text . show 566 | 567 | -- ----------------------------------------------------------------------------- 568 | -------------------------------------------------------------------------------- /verilog/Language/Verilog/Syntax.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Verilog.Syntax 4 | -- Copyright : (c) Signali Corp. 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : pweaver@signalicorp.com 8 | -- Stability : experimental 9 | -- Portability : ghc 10 | -- 11 | -- Verilog syntax: the abstract syntax tree (AST) and related modules. 12 | -------------------------------------------------------------------------------- 13 | 14 | module Language.Verilog.Syntax 15 | ( 16 | -- * Abstract syntax tree 17 | module Language.Verilog.Syntax.AST, 18 | ) where 19 | 20 | import Language.Verilog.Syntax.AST 21 | 22 | -------------------------------------------------------------------------------- 23 | -------------------------------------------------------------------------------- /verilog/Language/Verilog/Syntax/Expression.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Verilog.Syntax.Expression 4 | -- Copyright : (c) Signali Corp. 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : pweaver@signalicorp.com 8 | -- Stability : experimental 9 | -- Portability : ghc 10 | -- 11 | -- Abstract syntax tree definitions for Verilog expressions, operators, and 12 | -- constants. 13 | -------------------------------------------------------------------------------- 14 | 15 | {-# LANGUAGE DeriveDataTypeable, TypeOperators #-} 16 | {-# OPTIONS_DERIVE --append -d Binary #-} 17 | 18 | module Language.Verilog.Syntax.Expression 19 | ( -- * Identifiers 20 | Ident(..), 21 | 22 | -- * Expressions 23 | Expression, ConstExpr, Expression'(..), ConstExpr', 24 | Number(..), Base(..), Sign(..), intExpr, 25 | 26 | -- * Unary Operators 27 | UnaryOp(..), 28 | 29 | -- * Binary Operators 30 | BinaryOp(..), 31 | ) where 32 | 33 | import Data.Generics ( Data, Typeable ) 34 | import Data.Binary ( Binary(..), putWord8, getWord8 ) 35 | import Data.Maybe ( fromMaybe ) 36 | 37 | import Language.Verilog.Syntax.Ident 38 | 39 | -------------------------------------------------------------------------------- 40 | -- expressions 41 | 42 | -- | Expressions. The AST uses 'Number' to represent literals, which is a 43 | -- rather unstructured type (most values are left as strings). This type is 44 | -- parametrized over the type for literals so that the user can instantiate it 45 | -- with a more structured type, for example if they want to build a simulator or 46 | -- compiler. 47 | data Expression' x 48 | = ExprNum x 49 | -- | A variable reference 50 | | ExprVar Ident 51 | -- | A literal string, in quotes. Used for parameter values. 52 | | ExprString String 53 | -- | Index operator, e.g. @x[y]@. 54 | | ExprIndex Ident (Expression' x) 55 | -- | A slice operation of a range of indices, e.g. x[10:15]. 56 | | ExprSlice Ident (ConstExpr' x) (ConstExpr' x) 57 | -- | e.g. @x[y +: 10]@ 58 | | ExprSlicePlus Ident (Expression' x) (ConstExpr' x) 59 | -- | e.g. @x[y -: 10]@ 60 | | ExprSliceMinus Ident (Expression' x) (ConstExpr' x) 61 | -- | Concatenation, e.g. @{a, b, c}@ 62 | | ExprConcat [Expression' x] 63 | -- | Replication, e.g. @{10,{a, b, c}}@ 64 | | ExprMultiConcat (Expression' x) [Expression' x] 65 | -- TODO: 66 | -- | Application of a unary operator 67 | | ExprUnary UnaryOp (Expression' x) 68 | -- | Application of a binary operator 69 | | ExprBinary BinaryOp (Expression' x) (Expression' x) 70 | -- | Conditional expression, e.g. @x ? y : z@ 71 | | ExprCond (Expression' x) (Expression' x) (Expression' x) 72 | -- | Function call, e.g. @f(a, b, c)@ 73 | | ExprFunCall Ident [Expression' x] 74 | deriving (Eq, Ord, Show, Data, Typeable) 75 | 76 | type ConstExpr' x = Expression' x 77 | 78 | type ConstExpr = ConstExpr' Number 79 | type Expression = Expression' Number 80 | 81 | data Sign 82 | = Pos | Neg 83 | deriving (Eq, Ord, Data, Typeable) 84 | 85 | instance Show Sign where 86 | show Pos = "+" 87 | show Neg = "-" 88 | 89 | intExpr :: Integral a => a -> Expression 90 | intExpr x = ExprNum (IntNum Nothing Nothing Nothing (show x)) 91 | 92 | data Number 93 | -- | An integral value: sign, size, and base. 94 | = IntNum (Maybe Sign) (Maybe String) (Maybe Base) String 95 | -- | A real number: sign, integral integral, fractional part, exponent sign, 96 | -- and exponent value 97 | | RealNum (Maybe Sign) String (Maybe String) (Maybe (Maybe Sign, String)) 98 | deriving (Eq, Ord, Data, Typeable) 99 | 100 | instance Show Number where 101 | show (IntNum maybe_sign maybe_size maybe_base value) 102 | = maybe "" show maybe_sign ++ 103 | fromMaybe "" maybe_size ++ 104 | maybe "" show maybe_base ++ 105 | value 106 | 107 | show (RealNum maybe_sign int_part maybe_fract_part maybe_exponent) 108 | = maybe "" show maybe_sign ++ 109 | int_part ++ 110 | maybe "" ("."++) maybe_fract_part ++ 111 | case maybe_exponent of 112 | Just (mb_sign, e) -> "e" ++ (maybe "" show mb_sign) ++ e 113 | Nothing -> "" 114 | 115 | data Base = BinBase | OctBase | DecBase | HexBase 116 | deriving (Eq, Ord, Data, Typeable) 117 | 118 | instance Show Base where 119 | show x = ['\'', case x of 120 | BinBase -> 'b' 121 | OctBase -> 'o' 122 | DecBase -> 'd' 123 | HexBase -> 'h' 124 | ] 125 | 126 | -------------------------------------------------------------------------------- 127 | -- operators 128 | 129 | -- | Unary operators. @Uand@, @UNand@, @UOr@, @UNor@, @UXor@, and @UXnor@ are 130 | -- known as \"reduction operators\". They work just like Haskell\'s @fold@ 131 | -- function. 132 | data UnaryOp 133 | -- UTilde (~) is bitwise negation, UBang (!) is logical negation 134 | -- UAnd/UNand/UOr/UNor/UXor/UXnor are sometimes called "reduction operators" 135 | = UPlus -- ^ Unary plus operator: @+@ 136 | | UMinus -- ^ Unary 2\'s complement negation: @-@ 137 | | UBang -- ^ Logical negation, a.k.a NOT: @!@ 138 | | UTilde -- ^ Bitwise negation, a.k.a. 1\'s complement: @~@ 139 | | UAnd -- ^ @AND@ reduction operator: @&@ 140 | | UNand -- ^ @NAND@ reduction operator: @~&@ 141 | | UOr -- ^ @OR@ eduction operator: @|@ 142 | | UNor -- ^ @NOR@ reduction operator: @~|@ 143 | | UXor -- ^ @XOR@ reduction operator: @^@ 144 | | UXnor -- ^ @XNOR@ reduction operator: @^~@ or @~^@ 145 | deriving (Eq, Ord, Data, Typeable) 146 | 147 | instance Show UnaryOp where 148 | show UPlus = "+" 149 | show UMinus = "-" 150 | show UBang = "!" 151 | show UTilde = "~" 152 | show UAnd = "&" 153 | show UNand = "~&" 154 | show UOr = "|" 155 | show UNor = "~|" 156 | show UXor = "^" 157 | show UXnor = "^~" -- "~^" is also valid 158 | 159 | -- | Binary operators. 160 | data BinaryOp 161 | = Pow -- ^ Arithmetic exponentiation: @**@. Introduced in Verilog-2001. 162 | | Plus -- ^ Arithmetic addition: @+@. 163 | | Minus -- ^ Arithmetic subtraction: @-@ 164 | | Times -- ^ Arithmetic multiplication: @*@ 165 | | Divide -- ^ Arithmetic division: @/@ 166 | | Modulo -- ^ Arithmetic modulo: @%@ 167 | | Equals -- ^ Logical equality: @==@ 168 | | NotEquals -- ^ Logical inequality: @!=@ 169 | | CEquals -- ^ Case equality: @===@. 4-state logic, where @x@ and @z@ are 170 | -- taken literally. 171 | | CNotEquals -- ^ Case inequality: @!==@. 4-state logic, where @x@ and @z@ 172 | -- are taken literally. 173 | | LAnd -- ^ Logical @AND@ operation: @&&@ 174 | | LOr -- ^ Logical @OR@ operation: @||@ 175 | | LessThan -- ^ Less than: @<@ 176 | | LessEqual -- ^ Less than or equal to: @<=@ 177 | | GreaterThan -- ^ Greater than: @>@ 178 | | GreaterEqual -- ^ Greater than or equal to: @>=@ 179 | | And -- ^ Bitwise @AND@ operation: @&@ 180 | | Nand -- ^ Bitwise @NAND@ operation: @~&@ 181 | | Or -- ^ Bitwise @OR@ operation: @|@ 182 | | Nor -- ^ Bitwise @NOR@ operation: @~|@ 183 | | Xor -- ^ Bitwise @XOR@ operation: @^@ 184 | | Xnor -- ^ Bitwise @XNOR@ operation: @^~@ or @~^@ 185 | | ShiftLeft -- ^ Logical left shift: @<<@ 186 | | ShiftRight -- ^ Logical right shift: @>>@ 187 | deriving (Eq, Ord, Data, Typeable) 188 | 189 | instance Show BinaryOp where 190 | show Pow = "**" 191 | show Plus = "+" 192 | show Minus = "-" 193 | show Times = "*" 194 | show Divide = "/" 195 | show Modulo = "%" 196 | show Equals = "==" 197 | show NotEquals = "!=" 198 | show CEquals = "===" 199 | show CNotEquals = "!==" 200 | show LAnd = "&&" 201 | show LOr = "||" 202 | show LessThan = "<" 203 | show LessEqual = "<=" 204 | show GreaterThan = ">" 205 | show GreaterEqual = ">=" 206 | show And = "&" 207 | show Nand = "~&" 208 | show Or = "|" 209 | show Nor = "~|" 210 | show Xor = "^" 211 | show Xnor = "^~" 212 | show ShiftLeft = "<<" 213 | show ShiftRight = ">>" 214 | 215 | -------------------------------------------------------------------------------- 216 | -- GENERATED START 217 | 218 | 219 | instance (Binary x) => Binary (Expression' x) where 220 | put x 221 | = case x of 222 | ExprNum x1 -> do putWord8 0 223 | put x1 224 | ExprVar x1 -> do putWord8 1 225 | put x1 226 | ExprString x1 -> do putWord8 2 227 | put x1 228 | ExprIndex x1 x2 -> do putWord8 3 229 | put x1 230 | put x2 231 | ExprSlice x1 x2 x3 -> do putWord8 4 232 | put x1 233 | put x2 234 | put x3 235 | ExprSlicePlus x1 x2 x3 -> do putWord8 5 236 | put x1 237 | put x2 238 | put x3 239 | ExprSliceMinus x1 x2 x3 -> do putWord8 6 240 | put x1 241 | put x2 242 | put x3 243 | ExprConcat x1 -> do putWord8 7 244 | put x1 245 | ExprMultiConcat x1 x2 -> do putWord8 8 246 | put x1 247 | put x2 248 | ExprUnary x1 x2 -> do putWord8 9 249 | put x1 250 | put x2 251 | ExprBinary x1 x2 x3 -> do putWord8 10 252 | put x1 253 | put x2 254 | put x3 255 | ExprCond x1 x2 x3 -> do putWord8 11 256 | put x1 257 | put x2 258 | put x3 259 | ExprFunCall x1 x2 -> do putWord8 12 260 | put x1 261 | put x2 262 | get 263 | = do i <- getWord8 264 | case i of 265 | 0 -> do x1 <- get 266 | return (ExprNum x1) 267 | 1 -> do x1 <- get 268 | return (ExprVar x1) 269 | 2 -> do x1 <- get 270 | return (ExprString x1) 271 | 3 -> do x1 <- get 272 | x2 <- get 273 | return (ExprIndex x1 x2) 274 | 4 -> do x1 <- get 275 | x2 <- get 276 | x3 <- get 277 | return (ExprSlice x1 x2 x3) 278 | 5 -> do x1 <- get 279 | x2 <- get 280 | x3 <- get 281 | return (ExprSlicePlus x1 x2 x3) 282 | 6 -> do x1 <- get 283 | x2 <- get 284 | x3 <- get 285 | return (ExprSliceMinus x1 x2 x3) 286 | 7 -> do x1 <- get 287 | return (ExprConcat x1) 288 | 8 -> do x1 <- get 289 | x2 <- get 290 | return (ExprMultiConcat x1 x2) 291 | 9 -> do x1 <- get 292 | x2 <- get 293 | return (ExprUnary x1 x2) 294 | 10 -> do x1 <- get 295 | x2 <- get 296 | x3 <- get 297 | return (ExprBinary x1 x2 x3) 298 | 11 -> do x1 <- get 299 | x2 <- get 300 | x3 <- get 301 | return (ExprCond x1 x2 x3) 302 | 12 -> do x1 <- get 303 | x2 <- get 304 | return (ExprFunCall x1 x2) 305 | _ -> error "Corrupted binary data for Expression'" 306 | 307 | 308 | instance Binary Sign where 309 | put x 310 | = case x of 311 | Pos -> putWord8 0 312 | Neg -> putWord8 1 313 | get 314 | = do i <- getWord8 315 | case i of 316 | 0 -> return Pos 317 | 1 -> return Neg 318 | _ -> error "Corrupted binary data for Sign" 319 | 320 | 321 | instance Binary Number where 322 | put x 323 | = case x of 324 | IntNum x1 x2 x3 x4 -> do putWord8 0 325 | put x1 326 | put x2 327 | put x3 328 | put x4 329 | RealNum x1 x2 x3 x4 -> do putWord8 1 330 | put x1 331 | put x2 332 | put x3 333 | put x4 334 | get 335 | = do i <- getWord8 336 | case i of 337 | 0 -> do x1 <- get 338 | x2 <- get 339 | x3 <- get 340 | x4 <- get 341 | return (IntNum x1 x2 x3 x4) 342 | 1 -> do x1 <- get 343 | x2 <- get 344 | x3 <- get 345 | x4 <- get 346 | return (RealNum x1 x2 x3 x4) 347 | _ -> error "Corrupted binary data for Number" 348 | 349 | 350 | instance Binary Base where 351 | put x 352 | = case x of 353 | BinBase -> putWord8 0 354 | OctBase -> putWord8 1 355 | DecBase -> putWord8 2 356 | HexBase -> putWord8 3 357 | get 358 | = do i <- getWord8 359 | case i of 360 | 0 -> return BinBase 361 | 1 -> return OctBase 362 | 2 -> return DecBase 363 | 3 -> return HexBase 364 | _ -> error "Corrupted binary data for Base" 365 | 366 | 367 | instance Binary UnaryOp where 368 | put x 369 | = case x of 370 | UPlus -> putWord8 0 371 | UMinus -> putWord8 1 372 | UBang -> putWord8 2 373 | UTilde -> putWord8 3 374 | UAnd -> putWord8 4 375 | UNand -> putWord8 5 376 | UOr -> putWord8 6 377 | UNor -> putWord8 7 378 | UXor -> putWord8 8 379 | UXnor -> putWord8 9 380 | get 381 | = do i <- getWord8 382 | case i of 383 | 0 -> return UPlus 384 | 1 -> return UMinus 385 | 2 -> return UBang 386 | 3 -> return UTilde 387 | 4 -> return UAnd 388 | 5 -> return UNand 389 | 6 -> return UOr 390 | 7 -> return UNor 391 | 8 -> return UXor 392 | 9 -> return UXnor 393 | _ -> error "Corrupted binary data for UnaryOp" 394 | 395 | 396 | instance Binary BinaryOp where 397 | put x 398 | = case x of 399 | Pow -> putWord8 0 400 | Plus -> putWord8 1 401 | Minus -> putWord8 2 402 | Times -> putWord8 3 403 | Divide -> putWord8 4 404 | Modulo -> putWord8 5 405 | Equals -> putWord8 6 406 | NotEquals -> putWord8 7 407 | CEquals -> putWord8 8 408 | CNotEquals -> putWord8 9 409 | LAnd -> putWord8 10 410 | LOr -> putWord8 11 411 | LessThan -> putWord8 12 412 | LessEqual -> putWord8 13 413 | GreaterThan -> putWord8 14 414 | GreaterEqual -> putWord8 15 415 | And -> putWord8 16 416 | Nand -> putWord8 17 417 | Or -> putWord8 18 418 | Nor -> putWord8 19 419 | Xor -> putWord8 20 420 | Xnor -> putWord8 21 421 | ShiftLeft -> putWord8 22 422 | ShiftRight -> putWord8 23 423 | get 424 | = do i <- getWord8 425 | case i of 426 | 0 -> return Pow 427 | 1 -> return Plus 428 | 2 -> return Minus 429 | 3 -> return Times 430 | 4 -> return Divide 431 | 5 -> return Modulo 432 | 6 -> return Equals 433 | 7 -> return NotEquals 434 | 8 -> return CEquals 435 | 9 -> return CNotEquals 436 | 10 -> return LAnd 437 | 11 -> return LOr 438 | 12 -> return LessThan 439 | 13 -> return LessEqual 440 | 14 -> return GreaterThan 441 | 15 -> return GreaterEqual 442 | 16 -> return And 443 | 17 -> return Nand 444 | 18 -> return Or 445 | 19 -> return Nor 446 | 20 -> return Xor 447 | 21 -> return Xnor 448 | 22 -> return ShiftLeft 449 | 23 -> return ShiftRight 450 | _ -> error "Corrupted binary data for BinaryOp" 451 | -- GENERATED STOP 452 | -------------------------------------------------------------------------------- /verilog/Language/Verilog/Syntax/Ident.hs: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Language.Verilog.Syntax.Ident 4 | -- Copyright : (c) Signali Corp. 2010 5 | -- License : All rights reserved 6 | -- 7 | -- Maintainer : pweaver@signalicorp.com 8 | -- Stability : experimental 9 | -- Portability : ghc 10 | -- 11 | -- Definition of Verilog identifiers. 12 | -------------------------------------------------------------------------------- 13 | 14 | {-# LANGUAGE DeriveDataTypeable #-} 15 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 16 | 17 | module Language.Verilog.Syntax.Ident 18 | ( -- * Identifier 19 | Ident(..) 20 | ) where 21 | 22 | import Data.Binary ( Binary ) 23 | import Data.Generics ( Data, Typeable ) 24 | 25 | -------------------------------------------------------------------------------- 26 | 27 | -- TODO check if an identifier is valid; convert to valid identifier 28 | 29 | newtype Ident = Ident String 30 | deriving (Eq, Ord, Show, Binary, Data, Typeable) 31 | 32 | -------------------------------------------------------------------------------- 33 | -------------------------------------------------------------------------------- /verilog/Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /verilog/examples/GrayCounter.v: -------------------------------------------------------------------------------- 1 | //========================================== 2 | // Function : Code Gray counter. 3 | // Coder : Alex Claros F. 4 | // Date : 15/May/2005. 5 | //======================================= 6 | 7 | `timescale 1ns/1ps 8 | 9 | module GrayCounter 10 | #(parameter COUNTER_WIDTH = 4) 11 | 12 | (output reg [COUNTER_WIDTH-1:0] GrayCount_out, //'Gray' code count output. 13 | 14 | input wire Enable_in, //Count enable. 15 | input wire Clear_in, //Count reset. 16 | 17 | input wire Clk); 18 | 19 | /////////Internal connections & variables/////// 20 | reg [COUNTER_WIDTH-1:0] BinaryCount; 21 | 22 | /////////Code/////////////////////// 23 | 24 | always @ (posedge Clk) 25 | if (Clear_in) begin 26 | BinaryCount <= {COUNTER_WIDTH{1'b 0}} + 1; //Gray count begins @ '1' with 27 | GrayCount_out <= {COUNTER_WIDTH{1'b 0}}; // first 'Enable_in'. 28 | end 29 | else if (Enable_in) begin 30 | BinaryCount <= BinaryCount + 1; 31 | GrayCount_out <= {BinaryCount[COUNTER_WIDTH-1], 32 | BinaryCount[COUNTER_WIDTH-2:0] ^ BinaryCount[COUNTER_WIDTH-1:1]}; 33 | end 34 | 35 | endmodule 36 | -------------------------------------------------------------------------------- /verilog/examples/README: -------------------------------------------------------------------------------- 1 | This directory contains some example Verilog files that are used to test the 2 | parser and pretty-printer. They were downloaded from 3 | http://www.asic-world.com/examples/verilog/index.html 4 | 5 | Copyright (c) 1998-2010 Deepak Kumar Tala 6 | All rights reserved 7 | deepak@asic-world.com 8 | -------------------------------------------------------------------------------- /verilog/examples/aFifo.v: -------------------------------------------------------------------------------- 1 | //========================================== 2 | // Function : Asynchronous FIFO (w/ 2 asynchronous clocks). 3 | // Coder : Alex Claros F. 4 | // Date : 15/May/2005. 5 | // Notes : This implementation is based on the article 6 | // 'Asynchronous FIFO in Virtex-II FPGAs' 7 | // writen by Peter Alfke. This TechXclusive 8 | // article can be downloaded from the 9 | // Xilinx website. It has some minor modifications. 10 | //========================================= 11 | 12 | `timescale 1ns/1ps 13 | 14 | module aFifo 15 | #(parameter DATA_WIDTH = 8, 16 | ADDRESS_WIDTH = 4, 17 | FIFO_DEPTH = (1 << ADDRESS_WIDTH)) 18 | //Reading port 19 | (output reg [DATA_WIDTH-1:0] Data_out, 20 | output reg Empty_out, 21 | input wire ReadEn_in, 22 | input wire RClk, 23 | //Writing port. 24 | input wire [DATA_WIDTH-1:0] Data_in, 25 | output reg Full_out, 26 | input wire WriteEn_in, 27 | input wire WClk, 28 | 29 | input wire Clear_in); 30 | 31 | /////Internal connections & variables////// 32 | reg [DATA_WIDTH-1:0] Mem [FIFO_DEPTH-1:0]; 33 | wire [ADDRESS_WIDTH-1:0] pNextWordToWrite, pNextWordToRead; 34 | wire EqualAddresses; 35 | wire NextWriteAddressEn, NextReadAddressEn; 36 | wire Set_Status, Rst_Status; 37 | reg Status; 38 | wire PresetFull, PresetEmpty; 39 | 40 | //////////////Code/////////////// 41 | //Data ports logic: 42 | //(Uses a dual-port RAM). 43 | //'Data_out' logic: 44 | always @ (posedge RClk) 45 | if (ReadEn_in & !Empty_out) 46 | Data_out <= Mem[pNextWordToRead]; 47 | 48 | //'Data_in' logic: 49 | always @ (posedge WClk) 50 | if (WriteEn_in & !Full_out) 51 | Mem[pNextWordToWrite] <= Data_in; 52 | 53 | //Fifo addresses support logic: 54 | //'Next Addresses' enable logic: 55 | assign NextWriteAddressEn = WriteEn_in & ~Full_out; 56 | assign NextReadAddressEn = ReadEn_in & ~Empty_out; 57 | 58 | //Addreses (Gray counters) logic: 59 | GrayCounter GrayCounter_pWr 60 | (.GrayCount_out(pNextWordToWrite), 61 | 62 | .Enable_in(NextWriteAddressEn), 63 | .Clear_in(Clear_in), 64 | 65 | .Clk(WClk) 66 | ); 67 | 68 | GrayCounter GrayCounter_pRd 69 | (.GrayCount_out(pNextWordToRead), 70 | .Enable_in(NextReadAddressEn), 71 | .Clear_in(Clear_in), 72 | .Clk(RClk) 73 | ); 74 | 75 | 76 | //'EqualAddresses' logic: 77 | assign EqualAddresses = (pNextWordToWrite == pNextWordToRead); 78 | 79 | //'Quadrant selectors' logic: 80 | assign Set_Status = (pNextWordToWrite[ADDRESS_WIDTH-2] ~^ pNextWordToRead[ADDRESS_WIDTH-1]) & 81 | (pNextWordToWrite[ADDRESS_WIDTH-1] ^ pNextWordToRead[ADDRESS_WIDTH-2]); 82 | 83 | assign Rst_Status = (pNextWordToWrite[ADDRESS_WIDTH-2] ^ pNextWordToRead[ADDRESS_WIDTH-1]) & 84 | (pNextWordToWrite[ADDRESS_WIDTH-1] ~^ pNextWordToRead[ADDRESS_WIDTH-2]); 85 | 86 | //'Status' latch logic: 87 | always @ (Set_Status, Rst_Status, Clear_in) //D Latch w/ Asynchronous Clear & Preset. 88 | if (Rst_Status | Clear_in) 89 | Status = 0; //Going 'Empty'. 90 | else if (Set_Status) 91 | Status = 1; //Going 'Full'. 92 | 93 | //'Full_out' logic for the writing port: 94 | assign PresetFull = Status & EqualAddresses; //'Full' Fifo. 95 | 96 | always @ (posedge WClk, posedge PresetFull) //D Flip-Flop w/ Asynchronous Preset. 97 | if (PresetFull) 98 | Full_out <= 1; 99 | else 100 | Full_out <= 0; 101 | 102 | //'Empty_out' logic for the reading port: 103 | assign PresetEmpty = ~Status & EqualAddresses; //'Empty' Fifo. 104 | 105 | always @ (posedge RClk, posedge PresetEmpty) //D Flip-Flop w/ Asynchronous Preset. 106 | if (PresetEmpty) 107 | Empty_out <= 1; 108 | else 109 | Empty_out <= 0; 110 | 111 | endmodule 112 | -------------------------------------------------------------------------------- /verilog/examples/arbiter.v: -------------------------------------------------------------------------------- 1 | //---------------------------------------------------- 2 | // A four level, round-robin arbiter. This was 3 | // orginally coded by WD Peterson in VHDL. 4 | //---------------------------------------------------- 5 | module arbiter ( 6 | clk, 7 | rst, 8 | req3, 9 | req2, 10 | req1, 11 | req0, 12 | gnt3, 13 | gnt2, 14 | gnt1, 15 | gnt0 16 | ); 17 | // --------------Port Declaration----------------------- 18 | input clk; 19 | input rst; 20 | input req3; 21 | input req2; 22 | input req1; 23 | input req0; 24 | output gnt3; 25 | output gnt2; 26 | output gnt1; 27 | output gnt0; 28 | 29 | //--------------Internal Registers---------------------- 30 | wire [1:0] gnt ; 31 | wire comreq ; 32 | wire beg ; 33 | wire [1:0] lgnt ; 34 | wire lcomreq ; 35 | reg lgnt0 ; 36 | reg lgnt1 ; 37 | reg lgnt2 ; 38 | reg lgnt3 ; 39 | reg lasmask ; 40 | reg lmask0 ; 41 | reg lmask1 ; 42 | reg ledge ; 43 | 44 | //--------------Code Starts Here----------------------- 45 | always @ (posedge clk) 46 | if (rst) begin 47 | lgnt0 <= 0; 48 | lgnt1 <= 0; 49 | lgnt2 <= 0; 50 | lgnt3 <= 0; 51 | end else begin 52 | lgnt0 <=(~lcomreq & ~lmask1 & ~lmask0 & ~req3 & ~req2 & ~req1 & req0) 53 | | (~lcomreq & ~lmask1 & lmask0 & ~req3 & ~req2 & req0) 54 | | (~lcomreq & lmask1 & ~lmask0 & ~req3 & req0) 55 | | (~lcomreq & lmask1 & lmask0 & req0 ) 56 | | ( lcomreq & lgnt0 ); 57 | lgnt1 <=(~lcomreq & ~lmask1 & ~lmask0 & req1) 58 | | (~lcomreq & ~lmask1 & lmask0 & ~req3 & ~req2 & req1 & ~req0) 59 | | (~lcomreq & lmask1 & ~lmask0 & ~req3 & req1 & ~req0) 60 | | (~lcomreq & lmask1 & lmask0 & req1 & ~req0) 61 | | ( lcomreq & lgnt1); 62 | lgnt2 <=(~lcomreq & ~lmask1 & ~lmask0 & req2 & ~req1) 63 | | (~lcomreq & ~lmask1 & lmask0 & req2) 64 | | (~lcomreq & lmask1 & ~lmask0 & ~req3 & req2 & ~req1 & ~req0) 65 | | (~lcomreq & lmask1 & lmask0 & req2 & ~req1 & ~req0) 66 | | ( lcomreq & lgnt2); 67 | lgnt3 <=(~lcomreq & ~lmask1 & ~lmask0 & req3 & ~req2 & ~req1) 68 | | (~lcomreq & ~lmask1 & lmask0 & req3 & ~req2) 69 | | (~lcomreq & lmask1 & ~lmask0 & req3) 70 | | (~lcomreq & lmask1 & lmask0 & req3 & ~req2 & ~req1 & ~req0) 71 | | ( lcomreq & lgnt3); 72 | end 73 | 74 | //---------------------------------------------------- 75 | // lasmask state machine. 76 | //---------------------------------------------------- 77 | assign beg = (req3 | req2 | req1 | req0) & ~lcomreq; 78 | always @ (posedge clk) 79 | begin 80 | lasmask <= (beg & ~ledge & ~lasmask); 81 | ledge <= (beg & ~ledge & lasmask) 82 | | (beg & ledge & ~lasmask); 83 | end 84 | 85 | //---------------------------------------------------- 86 | // comreq logic. 87 | //---------------------------------------------------- 88 | assign lcomreq = ( req3 & lgnt3 ) 89 | | ( req2 & lgnt2 ) 90 | | ( req1 & lgnt1 ) 91 | | ( req0 & lgnt0 ); 92 | 93 | //---------------------------------------------------- 94 | // Encoder logic. 95 | //---------------------------------------------------- 96 | assign lgnt = {(lgnt3 | lgnt2),(lgnt3 | lgnt1)}; 97 | 98 | //---------------------------------------------------- 99 | // lmask register. 100 | //---------------------------------------------------- 101 | always @ (posedge clk ) 102 | if( rst ) begin 103 | lmask1 <= 0; 104 | lmask0 <= 0; 105 | end else if(lasmask) begin 106 | lmask1 <= lgnt[1]; 107 | lmask0 <= lgnt[0]; 108 | end else begin 109 | lmask1 <= lmask1; 110 | lmask0 <= lmask0; 111 | end 112 | 113 | assign comreq = lcomreq; 114 | assign gnt = lgnt; 115 | //---------------------------------------------------- 116 | // Drive the outputs 117 | //---------------------------------------------------- 118 | assign gnt3 = lgnt3; 119 | assign gnt2 = lgnt2; 120 | assign gnt1 = lgnt1; 121 | assign gnt0 = lgnt0; 122 | 123 | endmodule 124 | -------------------------------------------------------------------------------- /verilog/examples/arbiter_tb.v: -------------------------------------------------------------------------------- 1 | `include "arbiter.v" 2 | module top (); 3 | 4 | reg clk; 5 | reg rst; 6 | reg req3; 7 | reg req2; 8 | reg req1; 9 | reg req0; 10 | wire gnt3; 11 | wire gnt2; 12 | wire gnt1; 13 | wire gnt0; 14 | 15 | // Clock generator 16 | always #1 clk = ~clk; 17 | 18 | initial begin 19 | $dumpfile ("arbiter.vcd"); 20 | $dumpvars(); 21 | clk = 0; 22 | rst = 1; 23 | req0 = 0; 24 | req1 = 0; 25 | req2 = 0; 26 | req3 = 0; 27 | #10 rst = 0; 28 | repeat (1) @ (posedge clk); 29 | req0 <= 1; 30 | repeat (1) @ (posedge clk); 31 | req0 <= 0; 32 | repeat (1) @ (posedge clk); 33 | req0 <= 1; 34 | req1 <= 1; 35 | repeat (1) @ (posedge clk); 36 | req2 <= 1; 37 | req1 <= 0; 38 | repeat (1) @ (posedge clk); 39 | req3 <= 1; 40 | req2 <= 0; 41 | repeat (1) @ (posedge clk); 42 | req3 <= 0; 43 | repeat (1) @ (posedge clk); 44 | req0 <= 0; 45 | repeat (1) @ (posedge clk); 46 | #10 $finish; 47 | end 48 | 49 | // Connect the DUT 50 | arbiter U ( 51 | clk, 52 | rst, 53 | req3, 54 | req2, 55 | req1, 56 | req0, 57 | gnt3, 58 | gnt2, 59 | gnt1, 60 | gnt0 61 | ); 62 | 63 | endmodule 64 | -------------------------------------------------------------------------------- /verilog/examples/cam.v: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------- 2 | // Design Name : cam 3 | // File Name : cam.v 4 | // Function : CAM 5 | // Coder : Deepak Kumar Tala 6 | //----------------------------------------------------- 7 | module cam ( 8 | clk , // Cam clock 9 | cam_enable , // Cam enable 10 | cam_data_in , // Cam data to match 11 | cam_hit_out , // Cam match has happened 12 | cam_addr_out // Cam output address 13 | ); 14 | 15 | parameter ADDR_WIDTH = 8; 16 | parameter DEPTH = 1 << ADDR_WIDTH; 17 | //------------Input Ports-------------- 18 | input clk; 19 | input cam_enable; 20 | input [DEPTH-1:0] cam_data_in; 21 | //----------Output Ports-------------- 22 | output cam_hit_out; 23 | output [ADDR_WIDTH-1:0] cam_addr_out; 24 | //------------Internal Variables-------- 25 | reg [ADDR_WIDTH-1:0] cam_addr_out; 26 | reg cam_hit_out; 27 | reg [ADDR_WIDTH-1:0] cam_addr_combo; 28 | reg cam_hit_combo; 29 | reg found_match; 30 | integer i; 31 | //-------------Code Starts Here------- 32 | always @(cam_data_in) begin 33 | cam_addr_combo = {ADDR_WIDTH{1'b0}}; 34 | found_match = 1'b0; 35 | cam_hit_combo = 1'b0; 36 | for (i=0; i 0 && rx_cnt < 9) begin 95 | rx_reg[rx_cnt - 1] <= rx_d2; 96 | end 97 | if (rx_cnt == 9) begin 98 | rx_busy <= 0; 99 | // Check if End of frame received correctly 100 | if (rx_d2 == 0) begin 101 | rx_frame_err <= 1; 102 | end else begin 103 | rx_empty <= 0; 104 | rx_frame_err <= 0; 105 | // Check if last rx data was not unloaded, 106 | rx_over_run <= (rx_empty) ? 0 : 1; 107 | end 108 | end 109 | end 110 | end 111 | end 112 | end 113 | if (!rx_enable) begin 114 | rx_busy <= 0; 115 | end 116 | end 117 | 118 | // UART TX Logic 119 | always @ (posedge txclk or posedge reset) 120 | if (reset) begin 121 | tx_reg <= 0; 122 | tx_empty <= 1; 123 | tx_over_run <= 0; 124 | tx_out <= 1; 125 | tx_cnt <= 0; 126 | end else begin 127 | if (ld_tx_data) begin 128 | if (!tx_empty) begin 129 | tx_over_run <= 0; 130 | end else begin 131 | tx_reg <= tx_data; 132 | tx_empty <= 0; 133 | end 134 | end 135 | if (tx_enable && !tx_empty) begin 136 | tx_cnt <= tx_cnt + 1; 137 | if (tx_cnt == 0) begin 138 | tx_out <= 0; 139 | end 140 | if (tx_cnt > 0 && tx_cnt < 9) begin 141 | tx_out <= tx_reg[tx_cnt -1]; 142 | end 143 | if (tx_cnt == 9) begin 144 | tx_out <= 1; 145 | tx_cnt <= 0; 146 | tx_empty <= 1; 147 | end 148 | end 149 | if (!tx_enable) begin 150 | tx_cnt <= 0; 151 | end 152 | end 153 | 154 | endmodule 155 | -------------------------------------------------------------------------------- /verilog/examples/up_counter.v: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pheaver/netlist-verilog/9bc9e7864f64fadf74dffd628243cc2543abcd8d/verilog/examples/up_counter.v -------------------------------------------------------------------------------- /verilog/examples/up_counter_load.v: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------- 2 | // Design Name : up_counter_load 3 | // File Name : up_counter_load.v 4 | // Function : Up counter with load 5 | // Coder : Deepak Kumar Tala 6 | //----------------------------------------------------- 7 | module up_counter_load ( 8 | out , // Output of the counter 9 | data , // Parallel load for the counter 10 | load , // Parallel load enable 11 | enable , // Enable counting 12 | clk , // clock input 13 | reset // reset input 14 | ); 15 | //----------Output Ports-------------- 16 | output [7:0] out; 17 | //------------Input Ports-------------- 18 | input [7:0] data; 19 | input load, enable, clk, reset; 20 | //------------Internal Variables-------- 21 | reg [7:0] out; 22 | //-------------Code Starts Here------- 23 | always @(posedge clk) 24 | if (reset) begin 25 | out <= 8'b0 ; 26 | end else if (load) begin 27 | out <= data; 28 | end else if (enable) begin 29 | out <= out + 1; 30 | end 31 | 32 | endmodule 33 | -------------------------------------------------------------------------------- /verilog/examples/up_down_counter.v: -------------------------------------------------------------------------------- 1 | //----------------------------------------------------- 2 | // Design Name : up_down_counter 3 | // File Name : up_down_counter.v 4 | // Function : Up down counter 5 | // Coder : Deepak Kumar Tala 6 | //----------------------------------------------------- 7 | module up_down_counter ( 8 | out , // Output of the counter 9 | up_down , // up_down control for counter 10 | clk , // clock input 11 | reset // reset input 12 | ); 13 | //----------Output Ports-------------- 14 | output [7:0] out; 15 | //------------Input Ports-------------- 16 | input [7:0] data; 17 | input up_down, clk, reset; 18 | //------------Internal Variables-------- 19 | reg [7:0] out; 20 | //-------------Code Starts Here------- 21 | always @(posedge clk) 22 | if (reset) begin // active high reset 23 | out <= 8'b0 ; 24 | end else if (up_down) begin 25 | out <= out + 1; 26 | end else begin 27 | out <= out - 1; 28 | end 29 | 30 | endmodule 31 | -------------------------------------------------------------------------------- /verilog/examples/xor2_input.v: -------------------------------------------------------------------------------- 1 | primitive xor2_input (c,a,b); 2 | output c; 3 | input a,b; 4 | table 5 | 0 0 : 0; 6 | 0 1 : 1; 7 | 1 0 : 1; 8 | 1 1 : 0; 9 | x 1 : x; 10 | 1 x : x; 11 | x 0 : x; 12 | 0 x : x; 13 | x x : x; 14 | endtable 15 | endprimitive 16 | -------------------------------------------------------------------------------- /verilog/examples/xor_switch.v: -------------------------------------------------------------------------------- 1 | module nor2_switch (a,b,y); 2 | input a, b; 3 | output y; 4 | 5 | supply1 power; 6 | supply0 ground; 7 | 8 | wire connect; 9 | 10 | nmos (y,ground,a); 11 | nmos (y,ground,b); 12 | pmos (y,connect,b); 13 | pmos (power,connect,a); 14 | 15 | endmodule 16 | -------------------------------------------------------------------------------- /verilog/verilog.cabal: -------------------------------------------------------------------------------- 1 | name: verilog 2 | version: 0.2 3 | synopsis: Verilog AST and pretty printer 4 | description: Verilog AST and pretty printer -- parser to come later 5 | category: Language 6 | license: BSD3 7 | license-file: LICENSE 8 | copyright: Copyright (c) 2010 Signali Corp. 9 | Copyright (c) 2010 Philip Weaver 10 | author: Philip Weaver 11 | maintainer: philip.weaver@gmail.com 12 | package-url: git://github.com/pheaver/netlist-verilog.git 13 | build-type: Simple 14 | cabal-version: >=1.6 15 | 16 | flag base4 17 | Description: Compile using base-4 instead of base-3 18 | Default: True 19 | 20 | Library 21 | ghc-options: -Wall 22 | 23 | exposed-modules: Language.Verilog.Syntax, 24 | Language.Verilog.Syntax.Expression, 25 | Language.Verilog.Syntax.Ident, 26 | Language.Verilog.Syntax.AST, 27 | Language.Verilog.Parser, 28 | Language.Verilog.PrettyPrint, 29 | Language.Verilog 30 | 31 | build-depends: binary, pretty, parsec == 3.*, mtl 32 | if flag(base4) 33 | build-depends: base == 4.*, syb 34 | else 35 | build-depends: base == 3.* 36 | --------------------------------------------------------------------------------