mirror of https://github.com/zachjs/sv2v.git
Initial commit: fork of https://github.com/tomahawkins/verilog
This commit is contained in:
Zachary Snow
commit
363ca80af2
|
|
@ -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
|
||||
|
||||
|
|
@ -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.
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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)
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
}
|
||||
|
||||
|
|
@ -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
|
||||
|
||||
|
|
@ -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
|
||||
-}
|
||||
|
|
@ -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 ()
|
||||
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
module Main (main) where
|
||||
|
||||
import Distribution.Simple (defaultMain)
|
||||
|
||||
main :: IO ()
|
||||
main = defaultMain
|
||||
|
|
@ -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 <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
|
||||
|
||||
Loading…
Reference in New Issue