From 363ca80af20229a887931f57e2809a876cbf5599 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Thu, 7 Feb 2019 23:49:12 -0500 Subject: [PATCH] Initial commit: fork of https://github.com/tomahawkins/verilog --- Data/BitVec.hs | 63 +++ LICENSE | 27 ++ Language/Verilog.hs | 9 + Language/Verilog/AST.hs | 292 +++++++++++++ Language/Verilog/Parser.hs | 19 + Language/Verilog/Parser/Lex.x | 188 ++++++++ Language/Verilog/Parser/Parse.y | 366 ++++++++++++++++ Language/Verilog/Parser/Preprocess.hs | 72 ++++ Language/Verilog/Parser/Tokens.hs | 588 ++++++++++++++++++++++++++ Language/Verilog/Simulator.hs | 171 ++++++++ Setup.hs | 6 + verilog.cabal | 47 ++ 12 files changed, 1848 insertions(+) create mode 100644 Data/BitVec.hs create mode 100644 LICENSE create mode 100644 Language/Verilog.hs create mode 100644 Language/Verilog/AST.hs create mode 100644 Language/Verilog/Parser.hs create mode 100644 Language/Verilog/Parser/Lex.x create mode 100644 Language/Verilog/Parser/Parse.y create mode 100644 Language/Verilog/Parser/Preprocess.hs create mode 100644 Language/Verilog/Parser/Tokens.hs create mode 100644 Language/Verilog/Simulator.hs create mode 100644 Setup.hs create mode 100644 verilog.cabal diff --git a/Data/BitVec.hs b/Data/BitVec.hs new file mode 100644 index 0000000..c94e5fb --- /dev/null +++ b/Data/BitVec.hs @@ -0,0 +1,63 @@ +-- | Unsigned bit vectors. +module Data.BitVec + ( BitVec + , bitVec + , select + , width + , value + ) where + +import Data.Bits + +data BitVec = BitVec Int Integer deriving (Show, Eq) + +instance Num BitVec where + BitVec w1 v1 + BitVec w2 v2 = bitVec (max w1 w2) (v1 + v2) + BitVec w1 v1 - BitVec w2 v2 = bitVec (max w1 w2) (v1 - v2) + BitVec w1 v1 * BitVec w2 v2 = bitVec (max w1 w2) (v1 * v2) + abs = id + signum (BitVec _ v) = if v == 0 then bitVec 1 0 else bitVec 1 1 + fromInteger i = bitVec (width i) i + where + width :: Integer -> Int + width a + | a == 0 = 0 + | a == -1 = 1 + | otherwise = 1 + width (shiftR a 1) + +instance Bits BitVec where + BitVec w1 v1 .&. BitVec w2 v2 = bitVec (max w1 w2) (v1 .&. v2) + BitVec w1 v1 .|. BitVec w2 v2 = bitVec (max w1 w2) (v1 .|. v2) + BitVec w1 v1 `xor` BitVec w2 v2 = bitVec (max w1 w2) (v1 `xor` v2) + complement (BitVec w v) = bitVec w $ complement v + shift (BitVec w v) i = bitVec w $ shift v i + rotate _ _ = undefined --XXX To lazy to implemented it now. + bit i = fromInteger $ bit i + testBit (BitVec _ v) i = testBit v i + bitSize (BitVec w _) = w + bitSizeMaybe (BitVec w _) = Just w + isSigned _ = False + popCount (BitVec _ v) = popCount v + +instance Monoid BitVec where + mempty = BitVec 0 0 + mappend (BitVec w1 v1) (BitVec w2 v2) = BitVec (w1 + w2) (shiftL v1 w2 .|. v2) + +-- | BitVec construction, given width and value. +bitVec :: Int -> Integer -> BitVec +bitVec w v = BitVec w' $ v .&. ((2 ^ fromIntegral w') - 1) + where + w' = max w 0 + +-- | Bit seclection. LSB is 0. +select :: BitVec -> (BitVec, BitVec) -> BitVec +select (BitVec _ v) (msb, lsb) = bitVec (fromIntegral $ value $ msb - lsb + 1) $ shiftR v (fromIntegral $ value $ lsb) + +-- | Width of a 'BitVec'. +width :: BitVec -> Int +width (BitVec w _) = w + +-- | Value of a 'BitVec'. +value :: BitVec -> Integer +value (BitVec _ v) = v + diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..f85f519 --- /dev/null +++ b/LICENSE @@ -0,0 +1,27 @@ +Copyright (c) Tom Hawkins 2011 - 2015 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions +are met: +1. Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in the + documentation and/or other materials provided with the distribution. +3. Neither the name of the author nor the names of his contributors + may be used to endorse or promote products derived from this software + without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE +ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS +OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) +HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT +LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY +OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF +SUCH DAMAGE. diff --git a/Language/Verilog.hs b/Language/Verilog.hs new file mode 100644 index 0000000..c2067d5 --- /dev/null +++ b/Language/Verilog.hs @@ -0,0 +1,9 @@ +-- | A parser for Verilog. +module Language.Verilog + ( module Language.Verilog.AST + , module Language.Verilog.Parser + ) where + +import Language.Verilog.AST +import Language.Verilog.Parser + diff --git a/Language/Verilog/AST.hs b/Language/Verilog/AST.hs new file mode 100644 index 0000000..972e90c --- /dev/null +++ b/Language/Verilog/AST.hs @@ -0,0 +1,292 @@ +module Language.Verilog.AST + ( Identifier + , Module (..) + , ModuleItem (..) + , Stmt (..) + , LHS (..) + , Expr (..) + , UniOp (..) + , BinOp (..) + , Sense (..) + , Call (..) + , PortBinding + , Case + , Range + ) where + +import Data.Bits +import Data.List +import Data.Maybe +import Text.Printf + +import Data.BitVec + +type Identifier = String + +data Module = Module Identifier [Identifier] [ModuleItem] deriving Eq + +instance Show Module where + show (Module name ports items) = unlines + [ "module " ++ name ++ (if null ports then "" else "(" ++ commas ports ++ ")") ++ ";" + , unlines' $ map show items + , "endmodule" + ] + +data ModuleItem + = Comment String + | Parameter (Maybe Range) Identifier Expr + | Localparam (Maybe Range) Identifier Expr + | Input (Maybe Range) [Identifier] + | Output (Maybe Range) [Identifier] + | Inout (Maybe Range) [Identifier] + | Wire (Maybe Range) [(Identifier, Maybe Expr)] + | Reg (Maybe Range) [(Identifier, Maybe Range)] + | Integer [Identifier] + | Initial Stmt + | Always (Maybe Sense) Stmt + | Assign LHS Expr + | Instance Identifier [PortBinding] Identifier [PortBinding] + deriving Eq + +type PortBinding = (Identifier, Maybe Expr) + +instance Show ModuleItem where + show a = case a of + Comment a -> "// " ++ a + Parameter r n e -> printf "parameter %s%s = %s;" (showRange r) n (showExprConst e) + Localparam r n e -> printf "localparam %s%s = %s;" (showRange r) n (showExprConst e) + Input r a -> printf "input %s%s;" (showRange r) (commas a) + Output r a -> printf "output %s%s;" (showRange r) (commas a) + Inout r a -> printf "inout %s%s;" (showRange r) (commas a) + Wire r a -> printf "wire %s%s;" (showRange r) (commas [ a ++ showAssign r | (a, r) <- a ]) + Reg r a -> printf "reg %s%s;" (showRange r) (commas [ a ++ showRange r | (a, r) <- a ]) + Integer a -> printf "integer %s;" $ commas a + Initial a -> printf "initial\n%s" $ indent $ show a + Always Nothing b -> printf "always\n%s" $ indent $ show b + Always (Just a) b -> printf "always @(%s)\n%s" (show a) $ indent $ show b + Assign a b -> printf "assign %s = %s;" (show a) (show b) + Instance m params i ports + | null params -> printf "%s %s %s;" m i (showPorts show ports) + | otherwise -> printf "%s #%s %s %s;" m (showPorts showExprConst params) i (showPorts show ports) + where + showPorts :: (Expr -> String) -> [(Identifier, Maybe Expr)] -> String + showPorts s ports = printf "(%s)" $ commas [ printf ".%s(%s)" i (if isJust arg then s $ fromJust arg else "") | (i, arg) <- ports ] + showAssign :: Maybe Expr -> String + showAssign a = case a of + Nothing -> "" + Just a -> printf " = %s" $ show a + +showRange :: Maybe Range -> String +showRange Nothing = "" +showRange (Just (h, l)) = printf "[%s:%s] " (showExprConst h) (showExprConst l) + +indent :: String -> String +indent a = '\t' : f a + where + f [] = [] + f (a : rest) + | a == '\n' = "\n\t" ++ f rest + | otherwise = a : f rest + +unlines' :: [String] -> String +unlines' = intercalate "\n" + +data Expr + = String String + | Number BitVec + | ConstBool Bool + | Ident Identifier + | IdentRange Identifier Range + | IdentBit Identifier Expr + | Repeat Expr [Expr] + | Concat [Expr] + | ExprCall Call + | UniOp UniOp Expr + | BinOp BinOp Expr Expr + | Mux Expr Expr Expr + | Bit Expr Int + deriving Eq + +data UniOp = Not | BWNot | UAdd | USub deriving Eq + +instance Show UniOp where + show a = case a of + Not -> "!" + BWNot -> "~" + UAdd -> "+" + USub -> "-" + +data BinOp + = And + | Or + | BWAnd + | BWXor + | BWOr + | Mul + | Div + | Mod + | Add + | Sub + | ShiftL + | ShiftR + | Eq + | Ne + | Lt + | Le + | Gt + | Ge + deriving Eq + +instance Show BinOp where + show a = case a of + And -> "&&" + Or -> "||" + BWAnd -> "&" + BWXor -> "^" + BWOr -> "|" + Mul -> "*" + Div -> "/" + Mod -> "%" + Add -> "+" + Sub -> "-" + ShiftL -> "<<" + ShiftR -> ">>" + Eq -> "==" + Ne -> "!=" + Lt -> "<" + Le -> "<=" + Gt -> ">" + Ge -> ">=" + +showBitVecDefault :: BitVec -> String +showBitVecDefault a = printf "%d'h%x" (width a) (value a) + +showBitVecConst :: BitVec -> String +showBitVecConst a = show $ value a + +instance Show Expr where show = showExpr showBitVecDefault + +showExprConst :: Expr -> String +showExprConst = showExpr showBitVecConst + +showExpr :: (BitVec -> String) -> Expr -> String +showExpr bv a = case a of + String a -> printf "\"%s\"" a + Number a -> bv a + ConstBool a -> printf "1'b%s" (if a then "1" else "0") + Ident a -> a + IdentBit a b -> printf "%s[%s]" a (showExprConst b) + IdentRange a (b, c) -> printf "%s[%s:%s]" a (showExprConst b) (showExprConst c) + Repeat a b -> printf "{%s {%s}}" (showExprConst a) (commas $ map s b) + Concat a -> printf "{%s}" (commas $ map show a) + ExprCall a -> show a + UniOp a b -> printf "(%s %s)" (show a) (s b) + BinOp a b c -> printf "(%s %s %s)" (s b) (show a) (s c) + Mux a b c -> printf "(%s ? %s : %s)" (s a) (s b) (s c) + Bit a b -> printf "(%s [%d])" (s a) b + where + s = showExpr bv + +instance Num Expr where + (+) = BinOp Add + (-) = BinOp Sub + (*) = BinOp Mul + negate = UniOp USub + abs = undefined + signum = undefined + fromInteger = Number . fromInteger + +instance Bits Expr where + (.&.) = BinOp BWAnd + (.|.) = BinOp BWOr + xor = BinOp BWXor + complement = UniOp BWNot + isSigned _ = False + shift = error "Not supported: shift" + rotate = error "Not supported: rotate" + bitSize = error "Not supported: bitSize" + bitSizeMaybe = error "Not supported: bitSizeMaybe" + testBit = error "Not supported: testBit" + bit = error "Not supported: bit" + popCount = error "Not supported: popCount" + + +instance Monoid Expr where + mempty = 0 + mappend a b = mconcat [a, b] + mconcat = Concat + +data LHS + = LHS Identifier + | LHSBit Identifier Expr + | LHSRange Identifier Range + | LHSConcat [LHS] + deriving Eq + +instance Show LHS where + show a = case a of + LHS a -> a + LHSBit a b -> printf "%s[%s]" a (showExprConst b) + LHSRange a (b, c) -> printf "%s[%s:%s]" a (showExprConst b) (showExprConst c) + LHSConcat a -> printf "{%s}" (commas $ map show a) + +data Stmt + = Block (Maybe Identifier) [Stmt] + | StmtReg (Maybe Range) [(Identifier, Maybe Range)] + | StmtInteger [Identifier] + | Case Expr [Case] (Maybe Stmt) + | BlockingAssignment LHS Expr + | NonBlockingAssignment LHS Expr + | For (Identifier, Expr) Expr (Identifier, Expr) Stmt + | If Expr Stmt Stmt + | StmtCall Call + | Delay Expr Stmt + | Null + deriving Eq + +commas :: [String] -> String +commas = intercalate ", " + +instance Show Stmt where + show a = case a of + Block Nothing b -> printf "begin\n%s\nend" $ indent $ unlines' $ map show b + Block (Just a) b -> printf "begin : %s\n%s\nend" a $ indent $ unlines' $ map show b + StmtReg a b -> printf "reg %s%s;" (showRange a) (commas [ a ++ showRange r | (a, r) <- b ]) + StmtInteger a -> printf "integer %s;" $ commas a + Case a b Nothing -> printf "case (%s)\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) + Case a b (Just c) -> printf "case (%s)\n%s\n\tdefault:\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b) (indent $ indent $ show c) + BlockingAssignment a b -> printf "%s = %s;" (show a) (show b) + NonBlockingAssignment a b -> printf "%s <= %s;" (show a) (show b) + For (a, b) c (d, e) f -> printf "for (%s = %s; %s; %s = %s)\n%s" a (show b) (show c) d (show e) $ indent $ show f + If a b Null -> printf "if (%s)\n%s" (show a) (indent $ show b) + If a b c -> printf "if (%s)\n%s\nelse\n%s" (show a) (indent $ show b) (indent $ show c) + StmtCall a -> printf "%s;" (show a) + Delay a b -> printf "#%s %s" (showExprConst a) (show b) + Null -> ";" + +type Case = ([Expr], Stmt) + +showCase :: Case -> String +showCase (a, b) = printf "%s:\n%s" (commas $ map show a) (indent $ show b) + +data Call = Call Identifier [Expr] deriving Eq + +instance Show Call where + show (Call a b) = printf "%s(%s)" a (commas $ map show b) + +data Sense + = Sense LHS + | SenseOr Sense Sense + | SensePosedge LHS + | SenseNegedge LHS + deriving Eq + +instance Show Sense where + show a = case a of + Sense a -> show a + SenseOr a b -> printf "%s or %s" (show a) (show b) + SensePosedge a -> printf "posedge %s" (show a) + SenseNegedge a -> printf "negedge %s" (show a) + +type Range = (Expr, Expr) + diff --git a/Language/Verilog/Parser.hs b/Language/Verilog/Parser.hs new file mode 100644 index 0000000..3e6aa98 --- /dev/null +++ b/Language/Verilog/Parser.hs @@ -0,0 +1,19 @@ +module Language.Verilog.Parser + ( parseFile + , preprocess + ) where + +import Language.Verilog.AST +import Language.Verilog.Parser.Lex +import Language.Verilog.Parser.Parse +import Language.Verilog.Parser.Preprocess +import Language.Verilog.Parser.Tokens + +-- | Parses a file given a table of predefined macros, the file name, and the file contents. +parseFile :: [(String, String)] -> FilePath -> String -> [Module] +parseFile env file content = modules tokens + where + tokens = map relocate $ alexScanTokens $ preprocess env file content + relocate :: Token -> Token + relocate (Token t s (Position _ l c)) = Token t s $ Position file l c + diff --git a/Language/Verilog/Parser/Lex.x b/Language/Verilog/Parser/Lex.x new file mode 100644 index 0000000..7621f61 --- /dev/null +++ b/Language/Verilog/Parser/Lex.x @@ -0,0 +1,188 @@ +{ +{-# OPTIONS_GHC -w #-} +module Language.Verilog.Parser.Lex + ( alexScanTokens + ) where + +import Language.Verilog.Parser.Tokens + +} + +%wrapper "posn" + +-- Numbers + +$nonZeroDecimalDigit = [1-9] +$decimalDigit = [0-9] +@binaryDigit = [0-1] +@octalDigit = [0-7] +@hexDigit = [0-9a-fA-F] + +@decimalBase = "'" [dD] +@binaryBase = "'" [bB] +@octalBase = "'" [oO] +@hexBase = "'" [hH] + +@binaryValue = @binaryDigit ("_" | @binaryDigit)* +@octalValue = @octalDigit ("_" | @octalDigit)* +@hexValue = @hexDigit ("_" | @hexDigit)* + +@unsignedNumber = $decimalDigit ("_" | $decimalDigit)* + +@size = @unsignedNumber + +@decimalNumber + = @unsignedNumber + | @size? @decimalBase @unsignedNumber + +@binaryNumber = @size? @binaryBase @binaryValue +@octalNumber = @size? @octalBase @octalValue +@hexNumber = @size? @hexBase @hexValue + +-- $exp = [eE] +-- $sign = [\+\-] +-- @realNumber = unsignedNumber "." unsignedNumber | unsignedNumber ( "." unsignedNumber)? exp sign? unsignedNumber +@number = @decimalNumber | @octalNumber | @binaryNumber | @hexNumber + +-- Strings + +@string = \" [^\r\n]* \" + +-- Identifiers + +@escapedIdentifier = "\" ($printable # $white)+ $white +@simpleIdentifier = [a-zA-Z_] [a-zA-Z0-9_\$]* +@systemIdentifier = "$" [a-zA-Z0-9_\$]+ + + +tokens :- + + "always" { tok KW_always } + "assign" { tok KW_assign } + "begin" { tok KW_begin } + "case" { tok KW_case } + "default" { tok KW_default } + "else" { tok KW_else } + "end" { tok KW_end } + "endcase" { tok KW_endcase } + "endmodule" { tok KW_endmodule } + "for" { tok KW_for } + "if" { tok KW_if } + "initial" { tok KW_initial } + "inout" { tok KW_inout } + "input" { tok KW_input } + "integer" { tok KW_integer } + "localparam" { tok KW_localparam } + "module" { tok KW_module } + "negedge" { tok KW_negedge } + "or" { tok KW_or } + "output" { tok KW_output } + "parameter" { tok KW_parameter } + "posedge" { tok KW_posedge } + "reg" { tok KW_reg } + "wire" { tok KW_wire } + + @simpleIdentifier { tok Id_simple } + @escapedIdentifier { tok Id_escaped } + @systemIdentifier { tok Id_system } + + @number { tok Lit_number } + @string { tok Lit_string } + + "(" { tok Sym_paren_l } + ")" { tok Sym_paren_r } + "[" { tok Sym_brack_l } + "]" { tok Sym_brack_r } + "{" { tok Sym_brace_l } + "}" { tok Sym_brace_r } + "~" { tok Sym_tildy } + "!" { tok Sym_bang } + "@" { tok Sym_at } + "#" { tok Sym_pound } + "%" { tok Sym_percent } + "^" { tok Sym_hat } + "&" { tok Sym_amp } + "|" { tok Sym_bar } + "*" { tok Sym_aster } + "." { tok Sym_dot } + "," { tok Sym_comma } + ":" { tok Sym_colon } + ";" { tok Sym_semi } + "=" { tok Sym_eq } + "<" { tok Sym_lt } + ">" { tok Sym_gt } + "+" { tok Sym_plus } + "-" { tok Sym_dash } + "?" { tok Sym_question } + "/" { tok Sym_slash } + "$" { tok Sym_dollar } + "'" { tok Sym_s_quote } + + "~&" { tok Sym_tildy_amp } + "~|" { tok Sym_tildy_bar } + "~^" { tok Sym_tildy_hat } + "^~" { tok Sym_hat_tildy } + "==" { tok Sym_eq_eq } + "!=" { tok Sym_bang_eq } + "&&" { tok Sym_amp_amp } + "||" { tok Sym_bar_bar } + "**" { tok Sym_aster_aster } + "<=" { tok Sym_lt_eq } + ">=" { tok Sym_gt_eq } + ">>" { tok Sym_gt_gt } + "<<" { tok Sym_lt_lt } + "++" { tok Sym_plus_plus } + "--" { tok Sym_dash_dash } + "+=" { tok Sym_plus_eq } + "-=" { tok Sym_dash_eq } + "*=" { tok Sym_aster_eq } + "/=" { tok Sym_slash_eq } + "%=" { tok Sym_percent_eq } + "&=" { tok Sym_amp_eq } + "|=" { tok Sym_bar_eq } + "^=" { tok Sym_hat_eq } + "+:" { tok Sym_plus_colon } + "-:" { tok Sym_dash_colon } + "::" { tok Sym_colon_colon } + ".*" { tok Sym_dot_aster } + "->" { tok Sym_dash_gt } + ":=" { tok Sym_colon_eq } + ":/" { tok Sym_colon_slash } + "##" { tok Sym_pound_pound } + "[*" { tok Sym_brack_l_aster } + "[=" { tok Sym_brack_l_eq } + "=>" { tok Sym_eq_gt } + "@*" { tok Sym_at_aster } + "(*" { tok Sym_paren_l_aster } + "*)" { tok Sym_aster_paren_r } + "*>" { tok Sym_aster_gt } + + "===" { tok Sym_eq_eq_eq } + "!==" { tok Sym_bang_eq_eq } + "=?=" { tok Sym_eq_question_eq } + "!?=" { tok Sym_bang_question_eq } + ">>>" { tok Sym_gt_gt_gt } + "<<<" { tok Sym_lt_lt_lt } + "<<=" { tok Sym_lt_lt_eq } + ">>=" { tok Sym_gt_gt_eq } + "|->" { tok Sym_bar_dash_gt } + "|=>" { tok Sym_bar_eq_gt } + "[->" { tok Sym_brack_l_dash_gt } + "@@(" { tok Sym_at_at_paren_l } + "(*)" { tok Sym_paren_l_aster_paren_r } + "->>" { tok Sym_dash_gt_gt } + "&&&" { tok Sym_amp_amp_amp } + + "<<<=" { tok Sym_lt_lt_lt_eq } + ">>>=" { tok Sym_gt_gt_gt_eq } + + $white ; + + . { tok Unknown } + +{ +tok :: TokenName -> AlexPosn -> String -> Token +tok t (AlexPn _ l c) s = Token t s $ Position "" l c +} + + diff --git a/Language/Verilog/Parser/Parse.y b/Language/Verilog/Parser/Parse.y new file mode 100644 index 0000000..94030dc --- /dev/null +++ b/Language/Verilog/Parser/Parse.y @@ -0,0 +1,366 @@ +{ +module Language.Verilog.Parser.Parse (modules) where + +import Data.Bits +import Data.List + +import Data.BitVec +import Language.Verilog.AST +import Language.Verilog.Parser.Tokens +} + +%name modules +%tokentype { Token } +%error { parseError } + +%expect 0 + +%token + +"always" { Token KW_always _ _ } +"assign" { Token KW_assign _ _ } +"begin" { Token KW_begin _ _ } +"case" { Token KW_case _ _ } +"casez" { Token KW_casez _ _ } +"default" { Token KW_default _ _ } +"else" { Token KW_else _ _ } +"end" { Token KW_end _ _ } +"endcase" { Token KW_endcase _ _ } +"endmodule" { Token KW_endmodule _ _ } +"for" { Token KW_for _ _ } +"if" { Token KW_if _ _ } +"initial" { Token KW_initial _ _ } +"inout" { Token KW_inout _ _ } +"input" { Token KW_input _ _ } +"integer" { Token KW_integer _ _ } +"localparam" { Token KW_localparam _ _ } +"module" { Token KW_module _ _ } +"negedge" { Token KW_negedge _ _ } +"or" { Token KW_or _ _ } +"output" { Token KW_output _ _ } +"parameter" { Token KW_parameter _ _ } +"posedge" { Token KW_posedge _ _ } +"reg" { Token KW_reg _ _ } +"wire" { Token KW_wire _ _ } + +simpleIdentifier { Token Id_simple _ _ } +escapedIdentifier { Token Id_escaped _ _ } +systemIdentifier { Token Id_system _ _ } +number { Token Lit_number _ _ } +string { Token Lit_string _ _ } + +"(" { Token Sym_paren_l _ _ } +")" { Token Sym_paren_r _ _ } +"[" { Token Sym_brack_l _ _ } +"]" { Token Sym_brack_r _ _ } +"{" { Token Sym_brace_l _ _ } +"}" { Token Sym_brace_r _ _ } +"~" { Token Sym_tildy _ _ } +"!" { Token Sym_bang _ _ } +"@" { Token Sym_at _ _ } +"#" { Token Sym_pound _ _ } +"%" { Token Sym_percent _ _ } +"^" { Token Sym_hat _ _ } +"&" { Token Sym_amp _ _ } +"|" { Token Sym_bar _ _ } +"*" { Token Sym_aster _ _ } +"." { Token Sym_dot _ _ } +"," { Token Sym_comma _ _ } +":" { Token Sym_colon _ _ } +";" { Token Sym_semi _ _ } +"=" { Token Sym_eq _ _ } +"<" { Token Sym_lt _ _ } +">" { Token Sym_gt _ _ } +"+" { Token Sym_plus _ _ } +"-" { Token Sym_dash _ _ } +"?" { Token Sym_question _ _ } +"/" { Token Sym_slash _ _ } +"$" { Token Sym_dollar _ _ } +"'" { Token Sym_s_quote _ _ } +"~&" { Token Sym_tildy_amp _ _ } +"~|" { Token Sym_tildy_bar _ _ } +"~^" { Token Sym_tildy_hat _ _ } +"^~" { Token Sym_hat_tildy _ _ } +"==" { Token Sym_eq_eq _ _ } +"!=" { Token Sym_bang_eq _ _ } +"&&" { Token Sym_amp_amp _ _ } +"||" { Token Sym_bar_bar _ _ } +"**" { Token Sym_aster_aster _ _ } +"<=" { Token Sym_lt_eq _ _ } +">=" { Token Sym_gt_eq _ _ } +">>" { Token Sym_gt_gt _ _ } +"<<" { Token Sym_lt_lt _ _ } +"++" { Token Sym_plus_plus _ _ } +"--" { Token Sym_dash_dash _ _ } +"+=" { Token Sym_plus_eq _ _ } +"-=" { Token Sym_dash_eq _ _ } +"*=" { Token Sym_aster_eq _ _ } +"/=" { Token Sym_slash_eq _ _ } +"%=" { Token Sym_percent_eq _ _ } +"&=" { Token Sym_amp_eq _ _ } +"|=" { Token Sym_bar_eq _ _ } +"^=" { Token Sym_hat_eq _ _ } +"+:" { Token Sym_plus_colon _ _ } +"-:" { Token Sym_dash_colon _ _ } +"::" { Token Sym_colon_colon _ _ } +".*" { Token Sym_dot_aster _ _ } +"->" { Token Sym_dash_gt _ _ } +":=" { Token Sym_colon_eq _ _ } +":/" { Token Sym_colon_slash _ _ } +"##" { Token Sym_pound_pound _ _ } +"[*" { Token Sym_brack_l_aster _ _ } +"[=" { Token Sym_brack_l_eq _ _ } +"=>" { Token Sym_eq_gt _ _ } +"@*" { Token Sym_at_aster _ _ } +"(*" { Token Sym_paren_l_aster _ _ } +"*)" { Token Sym_aster_paren_r _ _ } +"*>" { Token Sym_aster_gt _ _ } +"===" { Token Sym_eq_eq_eq _ _ } +"!==" { Token Sym_bang_eq_eq _ _ } +"=?=" { Token Sym_eq_question_eq _ _ } +"!?=" { Token Sym_bang_question_eq _ _ } +">>>" { Token Sym_gt_gt_gt _ _ } +"<<<" { Token Sym_lt_lt_lt _ _ } +"<<=" { Token Sym_lt_lt_eq _ _ } +">>=" { Token Sym_gt_gt_eq _ _ } +"|->" { Token Sym_bar_dash_gt _ _ } +"|=>" { Token Sym_bar_eq_gt _ _ } +"[->" { Token Sym_brack_l_dash_gt _ _ } +"@@(" { Token Sym_at_at_paren_l _ _ } +"(*)" { Token Sym_paren_l_aster_paren_r _ _ } +"->>" { Token Sym_dash_gt_gt _ _ } +"&&&" { Token Sym_amp_amp_amp _ _ } +"<<<=" { Token Sym_lt_lt_lt_eq _ _ } +">>>=" { Token Sym_gt_gt_gt_eq _ _ } + +%nonassoc NoElse +%nonassoc "else" +%right "?" ":" +%left "||" +%left "&&" +%left "|" "~|" +%left "^" "^~" +%left "&" "~&" +%left "==" "!=" "===" "!==" +%left "<" "<=" ">" ">=" +%left "<<" ">>" +%left "+" "-" +%left "*" "/" "%" +%left UPlus UMinus "!" "~" + + +%% + +Modules :: { [Module] } +: { [] } +| Modules Module { $1 ++ [$2] } + +Module :: { Module } +: "module" Identifier ModulePortList ";" ModuleItems "endmodule"{ Module $2 $3 $5 } + +Identifier :: { Identifier } +: simpleIdentifier { tokenString $1 } +| escapedIdentifier { tokenString $1 } +| systemIdentifier { tokenString $1 } + +ModulePortList :: { [Identifier] } +: { [] } +| "(" ")" { [] } +| "(" ModulePortList1 ")" { $2 } + +ModulePortList1 :: { [Identifier] } +: Identifier { [$1] } +| ModulePortList1 "," Identifier { $1 ++ [$3] } + +ModuleItems :: { [ModuleItem] } +: { [] } +| ModuleItems ModuleItem { $1 ++ [$2] } + +ModuleItem :: { ModuleItem } +: "parameter" MaybeRange Identifier "=" Expr ";" { Parameter $2 $3 $5 } +| "localparam" MaybeRange Identifier "=" Expr ";" { Localparam $2 $3 $5 } +| "input" MaybeRange Identifiers ";" { Input $2 $3 } +| "output" MaybeRange Identifiers ";" { Output $2 $3 } +| "inout" MaybeRange Identifiers ";" { Inout $2 $3 } +| "reg" MaybeRange RegDeclarations ";" { Reg $2 $3 } +| "wire" MaybeRange WireDeclarations ";" { Wire $2 $3 } +| "integer" Identifiers ";" { Integer $2 } +| "assign" LHS "=" Expr ";" { Assign $2 $4 } +| "initial" Stmt { Initial $2 } +| "always" Stmt { Always Nothing $2 } +| "always" "@" "(" Sense ")" Stmt { Always (Just $4) $6 } +| Identifier ParameterBindings Identifier Bindings ";" { Instance $1 $2 $3 $4 } + +Identifiers :: { [Identifier] } +: Identifier { [$1] } +| Identifiers "," Identifier { $1 ++ [$3] } + +RegDeclarations :: { [(Identifier, Maybe Range)] } +: Identifier MaybeRange { [($1, $2)] } +| RegDeclarations "," Identifier MaybeRange { $1 ++ [($3, $4)] } + +WireDeclarations :: { [(Identifier, Maybe Expr)] } +: WireDeclaration { [$1] } +| WireDeclarations "," WireDeclaration { $1 ++ [$3] } + +WireDeclaration :: { (Identifier, Maybe Expr) } +: Identifier { ($1, Nothing) } +| Identifier "=" Expr { ($1, Just $3) } + +MaybeRange :: { Maybe Range } +: { Nothing } +| Range { Just $1 } + +Range :: { Range } +: "[" Expr ":" Expr "]" { ($2, $4) } + +LHS :: { LHS } +: Identifier { LHS $1 } +| Identifier Range { LHSRange $1 $2 } +| Identifier "[" Expr "]" { LHSBit $1 $3 } +| "{" LHSs "}" { LHSConcat $2 } + +LHSs :: { [LHS] } +: LHS { [$1] } +| LHSs "," LHS { $1 ++ [$3] } + +Sense :: { Sense } +: Sense1 { $1 } +| Sense "or" Sense1 { SenseOr $1 $3 } + +Sense1 :: { Sense } +: LHS { Sense $1 } +| "posedge" LHS { SensePosedge $2 } +| "negedge" LHS { SenseNegedge $2 } + +Bindings :: { [(Identifier, Maybe Expr)] } +: "(" Bindings1 ")" { $2 } + +Bindings1 :: { [(Identifier, Maybe Expr)] } +: Binding { [$1] } +| Bindings1 "," Binding { $1 ++ [$3] } + +Binding :: { (Identifier, Maybe Expr) } +: "." Identifier "(" MaybeExpr ")" { ($2, $4) } +| "." Identifier { ($2, Just $ Ident $2) } + +ParameterBindings :: { [(Identifier, Maybe Expr)] } +: { [] } +| "#" Bindings { $2 } + +Stmts :: { [Stmt] } +: { [] } +| Stmts Stmt { $1 ++ [$2] } + +Stmt :: { Stmt } +: ";" { Null } +| "begin" Stmts "end" { Block Nothing $2 } +| "begin" ":" Identifier Stmts "end" { Block (Just $3) $4 } +| "reg" MaybeRange RegDeclarations ";" { StmtReg $2 $3 } +| "integer" Identifiers ";" { StmtInteger $2 } +| "if" "(" Expr ")" Stmt "else" Stmt { If $3 $5 $7 } +| "if" "(" Expr ")" Stmt %prec NoElse { If $3 $5 Null } +| "for" "(" Identifier "=" Expr ";" Expr ";" Identifier "=" Expr ")" Stmt { For ($3, $5) $7 ($9, $11) $13 } +| LHS "=" Expr ";" { BlockingAssignment $1 $3 } +| LHS "<=" Expr ";" { NonBlockingAssignment $1 $3 } +| "#" Expr Stmt { Delay $2 $3 } +| Call ";" { StmtCall $1 } +| "case" "(" Expr ")" Cases CaseDefault "endcase" { Case $3 $5 $6 } + +Cases :: { [Case] } +: { [] } +| Cases Case { $1 ++ [$2] } + +Case :: { Case } +: Exprs ":" Stmt { ($1, $3) } + +CaseDefault :: { Maybe Stmt } +: { Nothing } +| "default" ":" Stmt { Just $3 } + +Number :: { BitVec } +: number { toNumber $1 } + +String :: { String } +: string { toString $1 } + +Call :: { Call } +: Identifier "(" CallArgs ")" { Call $1 $3 } + +CallArgs :: { [Expr] } +CallArgs +: Expr { [$1] } +| CallArgs "," Expr { $1 ++ [$3] } + +MaybeExpr :: { Maybe Expr } +: { Nothing } +| Expr { Just $1 } + +Exprs :: { [Expr] } +: Expr { [$1] } +| Exprs "," Expr { $1 ++ [$3] } + +Expr :: { Expr } +: "(" Expr ")" { $2 } +| String { String $1 } +| Number { Number $1 } +| Call { ExprCall $1 } +| Identifier { Ident $1 } +| Identifier Range { IdentRange $1 $2 } +| Identifier "[" Expr "]" { IdentBit $1 $3 } +| "{" Expr "{" Exprs "}" "}" { Repeat $2 $4 } +| "{" Exprs "}" { Concat $2 } +| Expr "?" Expr ":" Expr { Mux $1 $3 $5 } +| Expr "||" Expr { BinOp Or $1 $3 } +| Expr "&&" Expr { BinOp And $1 $3 } +| Expr "|" Expr { BinOp BWOr $1 $3 } +| Expr "^" Expr { BinOp BWXor $1 $3 } +| Expr "&" Expr { BinOp BWAnd $1 $3 } +| Expr "==" Expr { BinOp Eq $1 $3 } +| Expr "!=" Expr { BinOp Ne $1 $3 } +| Expr "<" Expr { BinOp Lt $1 $3 } +| Expr "<=" Expr { BinOp Le $1 $3 } +| Expr ">" Expr { BinOp Gt $1 $3 } +| Expr ">=" Expr { BinOp Ge $1 $3 } +| Expr "<<" Expr { BinOp ShiftL $1 $3 } +| Expr ">>" Expr { BinOp ShiftR $1 $3 } +| Expr "+" Expr { BinOp Add $1 $3 } +| Expr "-" Expr { BinOp Sub $1 $3 } +| Expr "*" Expr { BinOp Mul $1 $3 } +| Expr"/" Expr { BinOp Div $1 $3 } +| Expr "%" Expr { BinOp Mod $1 $3 } +| "!" Expr { UniOp Not $2 } +| "~" Expr { UniOp BWNot $2 } +| "+" Expr %prec UPlus { UniOp UAdd $2 } +| "-" Expr %prec UMinus { UniOp USub $2 } + + +{ +parseError :: [Token] -> a +parseError a = case a of + [] -> error "Parse error: no tokens left to parse." + Token t s p : _ -> error $ "Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ") at " ++ show p ++ "." + +toString :: Token -> String +toString = tail . init . tokenString + +toNumber :: Token -> BitVec +toNumber = number . tokenString + where + number :: String -> BitVec + number a + | all (flip elem ['0' .. '9']) a = fromInteger $ read a + | head a == '\'' = fromInteger $ f a + | isInfixOf "'" a = bitVec (read w) (f b) + | otherwise = error $ "Invalid number format: " ++ a + where + w = takeWhile (/= '\'') a + b = dropWhile (/= '\'') a + f a + | isPrefixOf "'d" a = read $ drop 2 a + | isPrefixOf "'h" a = read $ "0x" ++ drop 2 a + | isPrefixOf "'b" a = foldl (\ n b -> shiftL n 1 .|. (if b == '1' then 1 else 0)) 0 (drop 2 a) + | otherwise = error $ "Invalid number format: " ++ a + +} + diff --git a/Language/Verilog/Parser/Preprocess.hs b/Language/Verilog/Parser/Preprocess.hs new file mode 100644 index 0000000..a5a20cc --- /dev/null +++ b/Language/Verilog/Parser/Preprocess.hs @@ -0,0 +1,72 @@ +module Language.Verilog.Parser.Preprocess + ( uncomment + , preprocess + ) where + +-- | Remove comments from code. +uncomment :: FilePath -> String -> String +uncomment file a = uncomment a + where + uncomment a = case a of + "" -> "" + '/' : '/' : rest -> " " ++ removeEOL rest + '/' : '*' : rest -> " " ++ remove rest + '"' : rest -> '"' : ignoreString rest + a : rest -> a : uncomment rest + + removeEOL a = case a of + "" -> "" + '\n' : rest -> '\n' : uncomment rest + '\t' : rest -> '\t' : removeEOL rest + _ : rest -> ' ' : removeEOL rest + + remove a = case a of + "" -> error $ "File ended without closing comment (*/): " ++ file + '"' : rest -> removeString rest + '\n' : rest -> '\n' : remove rest + '\t' : rest -> '\t' : remove rest + '*' : '/' : rest -> " " ++ uncomment rest + _ : rest -> " " ++ remove rest + + removeString a = case a of + "" -> error $ "File ended without closing string: " ++ file + '"' : rest -> " " ++ remove rest + '\\' : '"' : rest -> " " ++ removeString rest + '\n' : rest -> '\n' : removeString rest + '\t' : rest -> '\t' : removeString rest + _ : rest -> ' ' : removeString rest + + ignoreString a = case a of + "" -> error $ "File ended without closing string: " ++ file + '"' : rest -> '"' : uncomment rest + '\\' : '"' : rest -> "\\\"" ++ ignoreString rest + a : rest -> a : ignoreString rest + +-- | A simple `define preprocessor. +preprocess :: [(String, String)] -> FilePath -> String -> String +preprocess env file content = unlines $ pp True [] env $ lines $ uncomment file content + where + pp :: Bool -> [Bool] -> [(String, String)] -> [String] -> [String] + pp _ _ _ [] = [] + pp on stack env (a : rest) = case words a of + "`define" : name : value -> "" : pp on stack (if on then (name, ppLine env $ unwords value) : env else env) rest + "`ifdef" : name : _ -> "" : pp (on && (elem name $ fst $ unzip env)) (on : stack) env rest + "`ifndef" : name : _ -> "" : pp (on && (notElem name $ fst $ unzip env)) (on : stack) env rest + "`else" : _ + | not $ null stack -> "" : pp (head stack && not on) stack env rest + | otherwise -> error $ "`else without associated `ifdef/`ifndef: " ++ file + "`endif" : _ + | not $ null stack -> "" : pp (head stack) (tail stack) env rest + | otherwise -> error $ "`endif without associated `ifdef/`ifndef: " ++ file + _ -> (if on then ppLine env a else "") : pp on stack env rest + +ppLine :: [(String, String)] -> String -> String +ppLine _ "" = "" +ppLine env ('`' : a) = case lookup name env of + Just value -> value ++ ppLine env rest + Nothing -> error $ "Undefined macro: `" ++ name ++ " Env: " ++ show env + where + name = takeWhile (flip elem $ ['A' .. 'Z'] ++ ['a' .. 'z'] ++ ['0' .. '9'] ++ ['_']) a + rest = drop (length name) a +ppLine env (a : b) = a : ppLine env b + diff --git a/Language/Verilog/Parser/Tokens.hs b/Language/Verilog/Parser/Tokens.hs new file mode 100644 index 0000000..7b9a78b --- /dev/null +++ b/Language/Verilog/Parser/Tokens.hs @@ -0,0 +1,588 @@ +module Language.Verilog.Parser.Tokens + ( Token (..) + , TokenName (..) + , Position (..) + , tokenString + ) where + +import Text.Printf + +tokenString :: Token -> String +tokenString (Token _ s _) = s + +data Position = Position String Int Int deriving Eq + +instance Show Position where + show (Position f l c) = printf "%s:%d:%d" f l c + +data Token = Token TokenName String Position deriving (Show, Eq) + +data TokenName + = KW_alias + | KW_always + | KW_always_comb + | KW_always_ff + | KW_always_latch + | KW_and + | KW_assert + | KW_assign + | KW_assume + | KW_automatic + | KW_before + | KW_begin + | KW_bind + | KW_bins + | KW_binsof + | KW_bit + | KW_break + | KW_buf + | KW_bufif0 + | KW_bufif1 + | KW_byte + | KW_case + | KW_casex + | KW_casez + | KW_cell + | KW_chandle + | KW_class + | KW_clocking + | KW_cmos + | KW_config + | KW_const + | KW_constraint + | KW_context + | KW_continue + | KW_cover + | KW_covergroup + | KW_coverpoint + | KW_cross + | KW_deassign + | KW_default + | KW_defparam + | KW_design + | KW_disable + | KW_dist + | KW_do + | KW_edge + | KW_else + | KW_end + | KW_endcase + | KW_endclass + | KW_endclocking + | KW_endconfig + | KW_endfunction + | KW_endgenerate + | KW_endgroup + | KW_endinterface + | KW_endmodule + | KW_endpackage + | KW_endprimitive + | KW_endprogram + | KW_endproperty + | KW_endspecify + | KW_endsequence + | KW_endtable + | KW_endtask + | KW_enum + | KW_event + | KW_expect + | KW_export + | KW_extends + | KW_extern + | KW_final + | KW_first_match + | KW_for + | KW_force + | KW_foreach + | KW_forever + | KW_fork + | KW_forkjoin + | KW_function + | KW_function_prototype + | KW_generate + | KW_genvar + | KW_highz0 + | KW_highz1 + | KW_if + | KW_iff + | KW_ifnone + | KW_ignore_bins + | KW_illegal_bins + | KW_import + | KW_incdir + | KW_include + | KW_initial + | KW_inout + | KW_input + | KW_inside + | KW_instance + | KW_int + | KW_integer + | KW_interface + | KW_intersect + | KW_join + | KW_join_any + | KW_join_none + | KW_large + | KW_liblist + | KW_library + | KW_local + | KW_localparam + | KW_logic + | KW_longint + | KW_macromodule + | KW_matches + | KW_medium + | KW_modport + | KW_module + | KW_nand + | KW_negedge + | KW_new + | KW_nmos + | KW_nor + | KW_noshowcancelled + | KW_not + | KW_notif0 + | KW_notif1 + | KW_null + | KW_option + | KW_or + | KW_output + | KW_package + | KW_packed + | KW_parameter + | KW_pathpulse_dollar + | KW_pmos + | KW_posedge + | KW_primitive + | KW_priority + | KW_program + | KW_property + | KW_protected + | KW_pull0 + | KW_pull1 + | KW_pulldown + | KW_pullup + | KW_pulsestyle_onevent + | KW_pulsestyle_ondetect + | KW_pure + | KW_rand + | KW_randc + | KW_randcase + | KW_randsequence + | KW_rcmos + | KW_real + | KW_realtime + | KW_ref + | KW_reg + | KW_release + | KW_repeat + | KW_return + | KW_rnmos + | KW_rpmos + | KW_rtran + | KW_rtranif0 + | KW_rtranif1 + | KW_scalared + | KW_sequence + | KW_shortint + | KW_shortreal + | KW_showcancelled + | KW_signed + | KW_small + | KW_solve + | KW_specify + | KW_specparam + | KW_static + | KW_strength0 + | KW_strength1 + | KW_string + | KW_strong0 + | KW_strong1 + | KW_struct + | KW_super + | KW_supply0 + | KW_supply1 + | KW_table + | KW_tagged + | KW_task + | KW_this + | KW_throughout + | KW_time + | KW_timeprecision + | KW_timeunit + | KW_tran + | KW_tranif0 + | KW_tranif1 + | KW_tri + | KW_tri0 + | KW_tri1 + | KW_triand + | KW_trior + | KW_trireg + | KW_type + | KW_typedef + | KW_type_option + | KW_union + | KW_unique + | KW_unsigned + | KW_use + | KW_var + | KW_vectored + | KW_virtual + | KW_void + | KW_wait + | KW_wait_order + | KW_wand + | KW_weak0 + | KW_weak1 + | KW_while + | KW_wildcard + | KW_wire + | KW_with + | KW_within + | KW_wor + | KW_xnor + | KW_xor + | Id_simple + | Id_escaped + | Id_system + | Lit_number_unsigned + | Lit_number + | Lit_string + | Sym_paren_l + | Sym_paren_r + | Sym_brack_l + | Sym_brack_r + | Sym_brace_l + | Sym_brace_r + | Sym_tildy + | Sym_bang + | Sym_at + | Sym_pound + | Sym_percent + | Sym_hat + | Sym_amp + | Sym_bar + | Sym_aster + | Sym_dot + | Sym_comma + | Sym_colon + | Sym_semi + | Sym_eq + | Sym_lt + | Sym_gt + | Sym_plus + | Sym_dash + | Sym_question + | Sym_slash + | Sym_dollar + | Sym_s_quote + | Sym_tildy_amp + | Sym_tildy_bar + | Sym_tildy_hat + | Sym_hat_tildy + | Sym_eq_eq + | Sym_bang_eq + | Sym_amp_amp + | Sym_bar_bar + | Sym_aster_aster + | Sym_lt_eq + | Sym_gt_eq + | Sym_gt_gt + | Sym_lt_lt + | Sym_plus_plus + | Sym_dash_dash + | Sym_plus_eq + | Sym_dash_eq + | Sym_aster_eq + | Sym_slash_eq + | Sym_percent_eq + | Sym_amp_eq + | Sym_bar_eq + | Sym_hat_eq + | Sym_plus_colon + | Sym_dash_colon + | Sym_colon_colon + | Sym_dot_aster + | Sym_dash_gt + | Sym_colon_eq + | Sym_colon_slash + | Sym_pound_pound + | Sym_brack_l_aster + | Sym_brack_l_eq + | Sym_eq_gt + | Sym_at_aster + | Sym_paren_l_aster + | Sym_aster_paren_r + | Sym_aster_gt + | Sym_eq_eq_eq + | Sym_bang_eq_eq + | Sym_eq_question_eq + | Sym_bang_question_eq + | Sym_gt_gt_gt + | Sym_lt_lt_lt + | Sym_lt_lt_eq + | Sym_gt_gt_eq + | Sym_bar_dash_gt + | Sym_bar_eq_gt + | Sym_brack_l_dash_gt + | Sym_at_at_paren_l + | Sym_paren_l_aster_paren_r + | Sym_dash_gt_gt + | Sym_amp_amp_amp + | Sym_lt_lt_lt_eq + | Sym_gt_gt_gt_eq + | Unknown + deriving (Show, Eq) + +{- +keywordOrId :: String -> TokenName +keywordOrId s = findWithDefault Id_simple s keywords + +keywords :: Map String TokenName +keywords = fromList + [ ("alias", KW_alias) + , ("always", KW_always) + , ("always_comb", KW_always_comb) + , ("always_ff", KW_always_ff) + , ("always_latch", KW_always_latch) + , ("and", KW_and) + , ("assert", KW_assert) + , ("assign", KW_assign) + , ("assume", KW_assume) + , ("automatic", KW_automatic) + , ("before", KW_before) + , ("begin", KW_begin) + , ("bind", KW_bind) + , ("bins", KW_bins) + , ("binsof", KW_binsof) + , ("bit", KW_bit) + , ("break", KW_break) + , ("buf", KW_buf) + , ("bufif0", KW_bufif0) + , ("bufif1", KW_bufif1) + , ("byte", KW_byte) + , ("case", KW_case) + , ("casex", KW_casex) + , ("casez", KW_casez) + , ("cell", KW_cell) + , ("chandle", KW_chandle) + , ("class", KW_class) + , ("clocking", KW_clocking) + , ("cmos", KW_cmos) + , ("config", KW_config) + , ("const", KW_const) + , ("constraint", KW_constraint) + , ("context", KW_context) + , ("continue", KW_continue) + , ("cover", KW_cover) + , ("covergroup", KW_covergroup) + , ("coverpoint", KW_coverpoint) + , ("cross", KW_cross) + , ("deassign", KW_deassign) + , ("default", KW_default) + , ("defparam", KW_defparam) + , ("design", KW_design) + , ("disable", KW_disable) + , ("dist", KW_dist) + , ("do", KW_do) + , ("edge", KW_edge) + , ("else", KW_else) + , ("end", KW_end) + , ("endcase", KW_endcase) + , ("endclass", KW_endclass) + , ("endclocking", KW_endclocking) + , ("endconfig", KW_endconfig) + , ("endfunction", KW_endfunction) + , ("endgenerate", KW_endgenerate) + , ("endgroup", KW_endgroup) + , ("endinterface", KW_endinterface) + , ("endmodule", KW_endmodule) + , ("endpackage", KW_endpackage) + , ("endprimitive", KW_endprimitive) + , ("endprogram", KW_endprogram) + , ("endproperty", KW_endproperty) + , ("endspecify", KW_endspecify) + , ("endsequence", KW_endsequence) + , ("endtable", KW_endtable) + , ("endtask", KW_endtask) + , ("enum", KW_enum) + , ("event", KW_event) + , ("expect", KW_expect) + , ("export", KW_export) + , ("extends", KW_extends) + , ("extern", KW_extern) + , ("final", KW_final) + , ("first_match", KW_first_match) + , ("for", KW_for) + , ("force", KW_force) + , ("foreach", KW_foreach) + , ("forever", KW_forever) + , ("fork", KW_fork) + , ("forkjoin", KW_forkjoin) + , ("function", KW_function) + , ("function_prototype", KW_function_prototype) + , ("generate", KW_generate) + , ("genvar", KW_genvar) + , ("highz0", KW_highz0) + , ("highz1", KW_highz1) + , ("if", KW_if) + , ("iff", KW_iff) + , ("ifnone", KW_ifnone) + , ("ignore_bins", KW_ignore_bins) + , ("illegal_bins", KW_illegal_bins) + , ("import", KW_import) + , ("incdir", KW_incdir) + , ("include", KW_include) + , ("initial", KW_initial) + , ("inout", KW_inout) + , ("input", KW_input) + , ("inside", KW_inside) + , ("instance", KW_instance) + , ("int", KW_int) + , ("integer", KW_integer) + , ("interface", KW_interface) + , ("intersect", KW_intersect) + , ("join", KW_join) + , ("join_any", KW_join_any) + , ("join_none", KW_join_none) + , ("large", KW_large) + , ("liblist", KW_liblist) + , ("library", KW_library) + , ("local", KW_local) + , ("localparam", KW_localparam) + , ("logic", KW_logic) + , ("longint", KW_longint) + , ("macromodule", KW_macromodule) + , ("matches", KW_matches) + , ("medium", KW_medium) + , ("modport", KW_modport) + , ("module", KW_module) + , ("nand", KW_nand) + , ("negedge", KW_negedge) + , ("new", KW_new) + , ("nmos", KW_nmos) + , ("nor", KW_nor) + , ("noshowcancelled", KW_noshowcancelled) + , ("not", KW_not) + , ("notif0", KW_notif0) + , ("notif1", KW_notif1) + , ("null", KW_null) + , ("option", KW_option) + , ("or", KW_or) + , ("output", KW_output) + , ("package", KW_package) + , ("packed", KW_packed) + , ("parameter", KW_parameter) + , ("pathpulse_dollar", KW_pathpulse_dollar) + , ("pmos", KW_pmos) + , ("posedge", KW_posedge) + , ("primitive", KW_primitive) + , ("priority", KW_priority) + , ("program", KW_program) + , ("property", KW_property) + , ("protected", KW_protected) + , ("pull0", KW_pull0) + , ("pull1", KW_pull1) + , ("pulldown", KW_pulldown) + , ("pullup", KW_pullup) + , ("pulsestyle_onevent", KW_pulsestyle_onevent) + , ("pulsestyle_ondetect", KW_pulsestyle_ondetect) + , ("pure", KW_pure) + , ("rand", KW_rand) + , ("randc", KW_randc) + , ("randcase", KW_randcase) + , ("randsequence", KW_randsequence) + , ("rcmos", KW_rcmos) + , ("real", KW_real) + , ("realtime", KW_realtime) + , ("ref", KW_ref) + , ("reg", KW_reg) + , ("release", KW_release) + , ("repeat", KW_repeat) + , ("return", KW_return) + , ("rnmos", KW_rnmos) + , ("rpmos", KW_rpmos) + , ("rtran", KW_rtran) + , ("rtranif0", KW_rtranif0) + , ("rtranif1", KW_rtranif1) + , ("scalared", KW_scalared) + , ("sequence", KW_sequence) + , ("shortint", KW_shortint) + , ("shortreal", KW_shortreal) + , ("showcancelled", KW_showcancelled) + , ("signed", KW_signed) + , ("small", KW_small) + , ("solve", KW_solve) + , ("specify", KW_specify) + , ("specparam", KW_specparam) + , ("static", KW_static) + , ("strength0", KW_strength0) + , ("strength1", KW_strength1) + , ("string", KW_string) + , ("strong0", KW_strong0) + , ("strong1", KW_strong1) + , ("struct", KW_struct) + , ("super", KW_super) + , ("supply0", KW_supply0) + , ("supply1", KW_supply1) + , ("table", KW_table) + , ("tagged", KW_tagged) + , ("task", KW_task) + , ("this", KW_this) + , ("throughout", KW_throughout) + , ("time", KW_time) + , ("timeprecision", KW_timeprecision) + , ("timeunit", KW_timeunit) + , ("tran", KW_tran) + , ("tranif0", KW_tranif0) + , ("tranif1", KW_tranif1) + , ("tri", KW_tri) + , ("tri0", KW_tri0) + , ("tri1", KW_tri1) + , ("triand", KW_triand) + , ("trior", KW_trior) + , ("trireg", KW_trireg) + , ("type", KW_type) + , ("typedef", KW_typedef) + , ("type_option", KW_type_option) + , ("union", KW_union) + , ("unique", KW_unique) + , ("unsigned", KW_unsigned) + , ("use", KW_use) + , ("var", KW_var) + , ("vectored", KW_vectored) + , ("virtual", KW_virtual) + , ("void", KW_void) + , ("wait", KW_wait) + , ("wait_order", KW_wait_order) + , ("wand", KW_wand) + , ("weak0", KW_weak0) + , ("weak1", KW_weak1) + , ("while", KW_while) + , ("wildcard", KW_wildcard) + , ("wire", KW_wire) + , ("with", KW_with) + , ("within", KW_within) + , ("wor", KW_wor) + , ("xnor", KW_xnor) + , ("xor", KW_xor) + ] + + -- \$fullskew + -- \$hold + -- \$nochange + -- \$period + -- \$randomize + -- \$recovery + -- \$recrem + -- \$removal + -- \$root + -- \$setup + -- \$setuphold + -- \$skew + -- \$timeskew + -- \$unit + -- \$width +-} diff --git a/Language/Verilog/Simulator.hs b/Language/Verilog/Simulator.hs new file mode 100644 index 0000000..11061a8 --- /dev/null +++ b/Language/Verilog/Simulator.hs @@ -0,0 +1,171 @@ +module Language.Verilog.Simulator + ( Simulator + , SimCommand (..) + , SimResponse (..) + , simulator + ) where + +import Control.Monad (when) +import Data.Array.IO +import Data.Bits +import Data.IORef +import Data.Monoid +import System.IO + +import Data.VCD hiding (Var, step) +import qualified Data.VCD as VCD + +import Data.BitVec +import Language.Verilog.Netlist + +--check msg = putStrLn msg >> hFlush stdout + +-- | A Simulator executes 'SimCommand's. +type Simulator = SimCommand -> IO (Maybe SimResponse) + +-- | Simulation commands. +data SimCommand + = Init (Maybe FilePath) + | Step + | GetSignalId Path + | GetSignal NetId + | Close + +-- | Simulation responses. +data SimResponse + = Id NetId -- ^ Response to GetSignalId. + | Value BitVec -- ^ Response to GetSignal. + +-- | Builds a 'Simulator' given a 'Netlist'. +simulator :: Netlist BlackBoxInit -> IO Simulator +simulator netlist' = do + let netlist = sortTopo netlist' + memory <- memory netlist + vcd <- newIORef Nothing + sample <- newIORef $ return () + step <- newIORef $ return () + return $ \ cmd -> case cmd of + Init file -> initialize netlist memory vcd file sample step + Step -> readIORef step >>= id >> return Nothing + GetSignalId path -> return $ getSignalId netlist path + GetSignal id -> readArray memory id >>= return . Just . Value + Close -> close vcd sample step >> return Nothing + +getSignalId :: Netlist BlackBoxInit -> Path -> Maybe SimResponse +getSignalId netlist path = case lookup path paths' of + Nothing -> Nothing + Just i -> Just $ Id i + where + paths = [ (paths, id) | Reg id _ paths _ <- netlist ] ++ [ (paths, id) | Var id _ paths _ <- netlist ] + paths' = [ (path, id) | (paths, id) <- paths, path <- paths ] + +type Memory = IOArray Int BitVec + +memory :: Netlist BlackBoxInit -> IO Memory +memory netlist + | null netlist = error "Empty netlist, nothing to simulate." + | otherwise = newArray (0, maximum ids) 0 + where + ids = concatMap f netlist + f a = case a of + Var a _ _ _ -> [a] + Reg a _ _ _ -> [a] + BBox _ _ _ -> [] + +initialize :: Netlist BlackBoxInit -> Memory -> IORef (Maybe VCDHandle) -> Maybe FilePath -> IORef (IO ()) -> IORef (IO ()) -> IO (Maybe SimResponse) +initialize netlist memory vcd file sample step = do + close vcd sample step + mapM_ (initializeNet memory) netlist + case file of + Nothing -> return () + Just file -> do + h <- openFile file WriteMode + vcd' <- newVCD h S + writeIORef vcd $ Just vcd' + writeIORef sample $ VCD.step vcd' 1 + mapM_ (f memory vcd' sample) netlist + netlist <- mapM initializeBBox netlist + initializeStep netlist memory sample step + return Nothing + where + f :: Memory -> VCDHandle -> IORef (IO ()) -> Net BlackBoxInit -> IO () + f memory vcd sample a = case a of + BBox _ _ _ -> return () + _ -> mapM_ (\ signal -> do + sample' <- var vcd signal $ bitVec width 0 + modifyIORef sample (>> (readArray memory i >>= sample')) + ) signals + where + (i, width, signals) = case a of + Reg i w p _ -> (i, w, p) + Var i w p _ -> (i, w, p) + BBox _ _ _ -> undefined + +initializeNet :: Memory -> Net BlackBoxInit -> IO () +initializeNet memory a = case a of + Var i w _ _ -> writeArray memory i $ bitVec w 0 + Reg i w _ _ -> writeArray memory i $ bitVec w 0 + BBox _ _ _ -> return () + +initializeBBox :: Net BlackBoxInit -> IO (Net BlackBoxStep) +initializeBBox a = case a of + Var a b c d -> return $ Var a b c d + Reg a b c d -> return $ Reg a b c d + BBox i o init -> init >>= return . BBox i o + +initializeStep :: Netlist BlackBoxStep -> Memory -> IORef (IO ()) -> IORef (IO ()) -> IO () +initializeStep netlist memory sample step = do + let steps = map stepNet netlist + writeIORef step $ do + sequence_ steps + readIORef sample >>= id + where + read = readArray memory + write' = writeMemory memory + stepNet :: Net BlackBoxStep -> IO () + stepNet a = case a of + BBox inputs outputs f -> do + outs <- mapM read inputs >>= f + sequence_ [ write' a b | (a, b) <- zip outputs outs ] + Reg q _ _ d -> read d >>= write' q + Var i _ _ expr -> case expr of + AInput -> return () + AVar a -> read a >>= write + AConst a -> write a + ASelect a b c -> do { a <- read a; b <- read b; c <- read c; write $ select a (b, c) } + ABWNot a -> read a >>= write . complement + ABWAnd a b -> do { a <- read a; b <- read b; write $ a .&. b } + ABWXor a b -> do { a <- read a; b <- read b; write $ a `xor` b } + ABWOr a b -> do { a <- read a; b <- read b; write $ a .|. b } + AMul a b -> do { a <- read a; b <- read b; write $ a * b } + AAdd a b -> do { a <- read a; b <- read b; write $ a + b } + ASub a b -> do { a <- read a; b <- read b; write $ a - b } + AShiftL a b -> do { a <- read a; b <- read b; write $ shiftL a $ fromIntegral $ value b } + AShiftR a b -> do { a <- read a; b <- read b; write $ shiftR a $ fromIntegral $ value b } + AEq a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a == value b then 1 else 0) } + ANe a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a /= value b then 1 else 0) } + ALt a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a < value b then 1 else 0) } + ALe a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a <= value b then 1 else 0) } + AGt a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a > value b then 1 else 0) } + AGe a b -> do { a <- read a; b <- read b; write $ bitVec 1 (if value a >= value b then 1 else 0) } + AMux a b c -> do { a <- read a; b <- read b; c <- read c; write (if value a /= 0 then b else c) } + AConcat a b -> do { a <- read a; b <- read b; write $ mappend a b } + where + write = write' i + +writeMemory :: Memory -> Int -> BitVec -> IO () +writeMemory memory i a = do + b <- readArray memory i + when (width b /= width a) $ error $ "Memory update with different bit-vector width: index: " ++ show i ++ " old: " ++ show b ++ " new: " ++ show a + writeArray memory i a + +close :: IORef (Maybe VCDHandle) -> IORef (IO ()) -> IORef (IO ()) -> IO () +close vcd sample step = do + vcd' <- readIORef vcd + case vcd' of + Nothing -> return () + Just vcd -> hClose $ handle vcd + writeIORef vcd $ Nothing + writeIORef sample $ return () + writeIORef step $ return () + diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..a7ad455 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Distribution.Simple (defaultMain) + +main :: IO () +main = defaultMain diff --git a/verilog.cabal b/verilog.cabal new file mode 100644 index 0000000..9185677 --- /dev/null +++ b/verilog.cabal @@ -0,0 +1,47 @@ +name: verilog +version: 0.0.12 + +category: Language, Hardware, Embedded + +synopsis: Verilog preprocessor, parser, and AST. + +description: + A parser and supporting a small subset of Verilog. + Intended for machine generated, synthesizable code. + +author: Tom Hawkins +maintainer: Tom Hawkins + +license: BSD3 +license-file: LICENSE + +homepage: http://github.com/tomahawkins/verilog + +build-type: Simple +cabal-version: >= 1.10 + +library + default-language: Haskell2010 + build-tools: + alex >= 3 && < 4, + happy >= 1 && < 2 + build-depends: + base >= 4.8.2.0 && < 5.0, + array >= 0.5.1.0 && < 0.6 + + exposed-modules: + Data.BitVec + Language.Verilog + Language.Verilog.AST + Language.Verilog.Parser + Language.Verilog.Parser.Lex + Language.Verilog.Parser.Parse + Language.Verilog.Parser.Preprocess + Language.Verilog.Parser.Tokens + + ghc-options: -W + +source-repository head + type: git + location: git://github.com/tomahawkins/verilog.git +