Skip to content

S
sv2v
Commit 363ca80a by Zachary Snow
Options

Initial commit: fork of https://github.com/tomahawkins/verilog

parents
Showing with 1848 additions and 0 deletions
Data/BitVec.hs 0 → 100644
-- | 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
LICENSE 0 → 100644
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.
Language/Verilog.hs 0 → 100644
-- | A parser for Verilog.
module Language.Verilog
( module Language.Verilog.AST
, module Language.Verilog.Parser
) where
import Language.Verilog.AST
import Language.Verilog.Parser
Language/Verilog/AST.hs 0 → 100644
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)
Language/Verilog/Parser.hs 0 → 100644
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
Language/Verilog/Parser/Lex.x 0 → 100644
{
{-# 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
}
Language/Verilog/Parser/Parse.y 0 → 100644
{
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
}
Language/Verilog/Parser/Preprocess.hs 0 → 100644
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
Language/Verilog/Parser/Tokens.hs 0 → 100644
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
-}
Language/Verilog/Simulator.hs 0 → 100644
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 ()
Setup.hs 0 → 100644
module Main (main) where
import Distribution.Simple (defaultMain)
main :: IO ()
main = defaultMain
verilog.cabal 0 → 100644
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 <tomahawkins@gmail.com>
maintainer: Tom Hawkins <tomahawkins@gmail.com>
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment