mirror of https://github.com/zachjs/sv2v.git
350 lines
10 KiB
Haskell
350 lines
10 KiB
Haskell
module Language.SystemVerilog.AST
|
|
( Identifier
|
|
, Module (..)
|
|
, ModuleItem (..)
|
|
, Direction (..)
|
|
, Type (..)
|
|
, 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
|
|
|
|
-- Note: Verilog allows modules to be declared with either a simple list of
|
|
-- ports _identifiers_, or a list of port _declarations_. If only the
|
|
-- identifiers are used, they must be declared with a type and direction
|
|
-- (potentially separately!) within the module itself.
|
|
|
|
-- Note: This AST will allow for the representation of syntactically invalid
|
|
-- things, like input regs. We might want to have a function for doing some
|
|
-- basing invariant checks. I want to avoid making a full type-checker though,
|
|
-- as we should only be given valid SystemVerilog input files.
|
|
|
|
data Module
|
|
= Module Identifier [Identifier] [ModuleItem]
|
|
deriving Eq
|
|
|
|
instance Show Module where
|
|
showList modules _ = intercalate "\n" $ map show modules
|
|
show (Module name ports items) = unlines
|
|
[ "module " ++ name ++ portsStr ++ ";"
|
|
, indent $ unlines' $ map show items
|
|
, "endmodule" ]
|
|
where
|
|
portsStr =
|
|
if null ports
|
|
then ""
|
|
else indentedParenList ports
|
|
|
|
data Direction
|
|
= Input
|
|
| Output
|
|
| Inout
|
|
deriving Eq
|
|
|
|
instance Show Direction where
|
|
show Input = "input"
|
|
show Output = "output"
|
|
show Inout = "inout"
|
|
|
|
-- TODO: Support for arrays (multi-dimensional, too!)
|
|
data Type
|
|
= Reg (Maybe Range)
|
|
| Wire (Maybe Range)
|
|
deriving Eq
|
|
|
|
instance Show Type where
|
|
show (Reg r) = "reg " ++ (showRange r)
|
|
show (Wire r) = "wire " ++ (showRange r)
|
|
|
|
data ModuleItem
|
|
= Comment String
|
|
| Parameter (Maybe Range) Identifier Expr
|
|
| Localparam (Maybe Range) Identifier Expr
|
|
| PortDecl Direction (Maybe Range) Identifier
|
|
| LocalNet Type Identifier (Maybe Expr)
|
|
| 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 thing = case thing of
|
|
Comment c -> "// " ++ c
|
|
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)
|
|
PortDecl d r x -> printf "%s %s%s;" (show d) (showRange r) x
|
|
LocalNet t x v -> (show t) ++ " " ++ x ++ assignment ++ ";"
|
|
where
|
|
assignment =
|
|
if v == Nothing
|
|
then ""
|
|
else " = " ++ show (fromJust v)
|
|
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 = indentedParenList [ if i == "" then show (fromJust arg) else printf ".%s(%s)" i (if isJust arg then s $ fromJust arg else "") | (i, arg) <- ports ]
|
|
|
|
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 (x : xs)
|
|
| x == '\n' = "\n\t" ++ f xs
|
|
| otherwise = x : f xs
|
|
|
|
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
|
|
| RedAnd
|
|
| RedNand
|
|
| RedOr
|
|
| RedNor
|
|
| RedXor
|
|
| RedXnor
|
|
deriving Eq
|
|
|
|
instance Show UniOp where
|
|
show Not = "!"
|
|
show BWNot = "~"
|
|
show UAdd = "+"
|
|
show USub = "-"
|
|
show RedAnd = "&"
|
|
show RedNand = "~&"
|
|
show RedOr = "|"
|
|
show RedNor = "~|"
|
|
show RedXor = "^"
|
|
show RedXnor = "~^"
|
|
|
|
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 x = case x 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 Semigroup Expr where
|
|
(<>) = mappend
|
|
|
|
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 (LHS a ) = a
|
|
show (LHSBit a b ) = printf "%s[%s]" a (showExprConst b)
|
|
show (LHSRange a (b, c)) = printf "%s[%s:%s]" a (showExprConst b) (showExprConst c)
|
|
show (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 (Block Nothing b ) = printf "begin\n%s\nend" $ indent $ unlines' $ map show b
|
|
show (Block (Just a) b ) = printf "begin : %s\n%s\nend" a $ indent $ unlines' $ map show b
|
|
show (StmtReg a b ) = printf "reg %s%s;" (showRange a) (commas [ x ++ showRange r | (x, r) <- b ])
|
|
show (StmtInteger a ) = printf "integer %s;" $ commas a
|
|
show (Case a b Nothing ) = printf "case (%s)\n%s\nendcase" (show a) (indent $ unlines' $ map showCase b)
|
|
show (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)
|
|
show (BlockingAssignment a b ) = printf "%s = %s;" (show a) (show b)
|
|
show (NonBlockingAssignment a b ) = printf "%s <= %s;" (show a) (show b)
|
|
show (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
|
|
show (If a b Null ) = printf "if (%s)\n%s" (show a) (indent $ show b)
|
|
show (If a b c ) = printf "if (%s)\n%s\nelse\n%s" (show a) (indent $ show b) (indent $ show c)
|
|
show (StmtCall a ) = printf "%s;" (show a)
|
|
show (Delay a b ) = printf "#%s %s" (showExprConst a) (show b)
|
|
show (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
|
|
| SenseStar
|
|
deriving Eq
|
|
|
|
instance Show Sense where
|
|
show (Sense a ) = show a
|
|
show (SenseOr a b) = printf "%s or %s" (show a) (show b)
|
|
show (SensePosedge a ) = printf "posedge %s" (show a)
|
|
show (SenseNegedge a ) = printf "negedge %s" (show a)
|
|
show (SenseStar ) = "*"
|
|
|
|
type Range = (Expr, Expr)
|
|
|
|
indentedParenList :: [String] -> String
|
|
indentedParenList [] = "()"
|
|
indentedParenList [x] = "(" ++ x ++ ")"
|
|
indentedParenList l =
|
|
"(\n" ++ (indent $ intercalate ",\n" l) ++ "\n)"
|