Skip to content

S
sv2v
Commit 77f0d23d by Zachary Snow
Options

starting work to clean up and segment AST

parent cecd141e
Showing with 532 additions and 445 deletions
src/Convert/AsgnOp.hs
......@@ -30,7 +30,7 @@ convertStmt other = other
lhsToExpr :: LHS -> Expr
lhsToExpr (LHSIdent x) = Ident x
lhsToExpr (LHSBit l e) = Bit (lhsToExpr l) e
lhsToExpr (LHSRange l r) = Range (lhsToExpr l) r
lhsToExpr (LHSDot l x) = Access (lhsToExpr l) x
lhsToExpr (LHSBit l e) = Bit (lhsToExpr l) e
lhsToExpr (LHSRange l r) = Range (lhsToExpr l) r
lhsToExpr (LHSDot l x) = Dot (lhsToExpr l) x
lhsToExpr (LHSConcat ls) = Concat $ map lhsToExpr ls
src/Convert/Interface.hs
......@@ -83,7 +83,7 @@ convertDescription interfaces (Part Module name ports items) =
mapInterface other = other
expandPortBinding :: PortBinding -> [PortBinding]
expandPortBinding (origBinding @ (portName, Just (Access (Ident instanceName) modportName))) =
expandPortBinding (origBinding @ (portName, Just (Dot (Ident instanceName) modportName))) =
case Map.lookup instanceName instances of
Nothing -> [origBinding]
Just interfaceName ->
......@@ -108,7 +108,7 @@ convertDescription interfaces (Part Module name ports items) =
collectModport _ = return ()
convertExpr :: Expr -> Expr
convertExpr (orig @ (Access (Ident x) y)) =
convertExpr (orig @ (Dot (Ident x) y)) =
if Map.member x modports
then Ident (x ++ "_" ++ y)
else orig
......
src/Convert/Struct.hs
......@@ -193,13 +193,13 @@ convertAsgn structs types (lhs, expr) =
case Map.lookup x types of
Nothing -> (Implicit Unspecified [], Ident x)
Just t -> (t, Ident x)
convertSubExpr (Access e x) =
convertSubExpr (Dot e x) =
case subExprType of
Struct _ _ _ ->
if Map.notMember structTf structs
then (fieldType, Access e' x)
then (fieldType, Dot e' x)
else (fieldType, Range e' r)
_ -> (Implicit Unspecified [], Access e' x)
_ -> (Implicit Unspecified [], Dot e' x)
where
(subExprType, e') = convertSubExpr e
Struct p fields [] = subExprType
......
src/Convert/Traverse.hs
......@@ -193,10 +193,9 @@ traverseNestedExprsM mapper = exprMapper
maybeExprMapper Nothing = return Nothing
maybeExprMapper (Just e) =
exprMapper e >>= return . Just
em (String s) = return $ String s
em (Number s) = return $ Number s
em (ConstBool b) = return $ ConstBool b
em (Ident i) = return $ Ident i
em (String s) = return $ String s
em (Number s) = return $ Number s
em (Ident i) = return $ Ident i
em (Range e (e1, e2)) = do
e' <- exprMapper e
e1' <- exprMapper e1
......@@ -227,8 +226,8 @@ traverseNestedExprsM mapper = exprMapper
return $ Mux e1' e2' e3'
em (Cast t e) =
exprMapper e >>= return . Cast t
em (Access e x) =
exprMapper e >>= \e' -> return $ Access e' x
em (Dot e x) =
exprMapper e >>= \e' -> return $ Dot e' x
em (Pattern l) = do
let names = map fst l
exprs <- mapM exprMapper $ map snd l
......
src/Language/SystemVerilog/AST.hs
{-# LANGUAGE FlexibleInstances #-}
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
- Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
-
- This AST allows for the representation of many syntactically invalid things,
- like input regs or modport declarations inside a module. Representing only
- syntactically valid files would make working with the AST a nightmare. We
- have placed an emphasis on making the conversion procedures in this project
- more easier to write, interpret, and maintain.
-
- In the future, we may want to have a utility which performs some basic
- invariant checks. I want to avoid making a full type-checker though, as we
- should only be given valid SystemVerilog input files.
-}
module Language.SystemVerilog.AST
( Identifier
, Description(..)
, PackageItem(..)
, ModuleItem (..)
, Direction (..)
, Type (..)
, Stmt (..)
, LHS (..)
, Expr (..)
, UniOp (..)
, BinOp (..)
, AsgnOp (..)
, Sense (..)
, Timing (..)
, GenItem (..)
, AlwaysKW (..)
, CaseKW (..)
, PartKW (..)
, Decl (..)
, Lifetime (..)
, NInputGateKW (..)
, NOutputGateKW (..)
, AST
, PortBinding
, ModportDecl
, Case
, Range
, GenCase
, typeRanges
, simplify
, rangeSize
, Signing (..)
, NetType (..)
, IntegerVectorType (..)
, IntegerAtomType (..)
, NonIntegerType (..)
, Packing (..)
) where
import Data.List
import Data.Maybe
import Text.Printf
( Description(..)
, PackageItem(..)
, ModuleItem (..)
, Direction (..)
, Stmt (..)
, LHS (..)
, Expr (..)
, Sense (..)
, Timing (..)
, GenItem (..)
, AlwaysKW (..)
, CaseKW (..)
, PartKW (..)
, Decl (..)
, Lifetime (..)
, NInputGateKW (..)
, NOutputGateKW (..)
, AST
, PortBinding
, ModportDecl
, Case
, GenCase
, simplify
, rangeSize
, module Expr
, module Op
, module Type
) where
import Data.List (intercalate)
import Data.Maybe (maybe, fromJust, isJust)
import Text.Printf (printf)
import Text.Read (readMaybe)
type Identifier = String
import Language.SystemVerilog.AST.Expr as Expr
import Language.SystemVerilog.AST.Op as Op
import Language.SystemVerilog.AST.Type as Type
import Language.SystemVerilog.AST.ShowHelp
-- 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.
type AST = [Description]
data PackageItem
......@@ -119,146 +122,6 @@ instance Show Direction where
show Inout = "inout"
show Local = ""
data Signing
= Unspecified
| Signed
| Unsigned
deriving (Eq, Ord)
instance Show Signing where
show Unspecified = ""
show Signed = "signed"
show Unsigned = "unsigned"
data NetType
= TSupply0
| TSupply1
| TTri
| TTriand
| TTrior
| TTrireg
| TTri0
| TTri1
| TUwire
| TWire
| TWand
| TWor
deriving (Eq, Ord)
data IntegerVectorType
= TBit
| TLogic
| TReg
deriving (Eq, Ord)
data IntegerAtomType
= TByte
| TShortint
| TInt
| TLongint
| TInteger
| TTime
deriving (Eq, Ord)
data NonIntegerType
= TShortreal
| TReal
| TRealtime
deriving (Eq, Ord)
instance Show NetType where
show TSupply0 = "supply0"
show TSupply1 = "supply1"
show TTri = "tri"
show TTriand = "triand"
show TTrior = "trior"
show TTrireg = "trireg"
show TTri0 = "tri0"
show TTri1 = "tri1"
show TUwire = "uwire"
show TWire = "wire"
show TWand = "wand"
show TWor = "wor"
instance Show IntegerVectorType where
show TBit = "bit"
show TLogic = "logic"
show TReg = "reg"
instance Show IntegerAtomType where
show TByte = "byte"
show TShortint = "shortint"
show TInt = "int"
show TLongint = "longint"
show TInteger = "integer"
show TTime = "time"
instance Show NonIntegerType where
show TShortreal = "shortreal"
show TReal = "real"
show TRealtime = "realtime"
data Packing
= Unpacked
| Packed Signing
deriving (Eq, Ord)
instance Show Packing where
show (Unpacked) = ""
show (Packed s) = "packed" ++ (showPadBefore s)
type Item = (Identifier, Maybe Expr)
type Field = (Type, Identifier)
data Type
= IntegerVector IntegerVectorType Signing [Range]
| IntegerAtom IntegerAtomType Signing
| NonInteger NonIntegerType
| Net NetType [Range]
| Implicit Signing [Range]
| Alias Identifier [Range]
| Enum (Maybe Type) [Item] [Range]
| Struct Packing [Field] [Range]
| InterfaceT Identifier (Maybe Identifier) [Range]
deriving (Eq, Ord)
instance Show Type where
show (Alias xx rs) = printf "%s%s" xx (showRanges rs)
show (Net kw rs) = printf "%s%s" (show kw) (showRanges rs)
show (Implicit sg rs) = printf "%s%s" (show sg) (showRanges rs)
show (IntegerVector kw sg rs) = printf "%s%s%s" (show kw) (showPadBefore sg) (showRanges rs)
show (IntegerAtom kw sg ) = printf "%s%s" (show kw) (showPadBefore sg)
show (NonInteger kw ) = printf "%s" (show kw)
show (InterfaceT x my r) = x ++ yStr ++ (showRanges r)
where yStr = maybe "" ("."++) my
show (Enum mt vals r) = printf "enum %s{%s}%s" tStr (commas $ map showVal vals) (showRanges r)
where
tStr = maybe "" showPad mt
showVal :: (Identifier, Maybe Expr) -> String
showVal (x, e) = x ++ (showAssignment e)
show (Struct p items r) = printf "struct %s{\n%s\n}%s" (showPad p) itemsStr (showRanges r)
where
itemsStr = indent $ unlines' $ map showItem items
showItem (t, x) = printf "%s %s;" (show t) x
instance Show ([Range] -> Type) where
show tf = show (tf [])
instance Eq ([Range] -> Type) where
(==) tf1 tf2 = (tf1 []) == (tf2 [])
instance Ord ([Range] -> Type) where
compare tf1 tf2 = compare (tf1 []) (tf2 [])
instance Show (Signing -> [Range] -> Type) where
show tf = show (tf Unspecified)
instance Eq (Signing -> [Range] -> Type) where
(==) tf1 tf2 = (tf1 Unspecified) == (tf2 Unspecified)
instance Ord (Signing -> [Range] -> Type) where
compare tf1 tf2 = compare (tf1 Unspecified) (tf2 Unspecified)
typeRanges :: Type -> ([Range] -> Type, [Range])
typeRanges (Alias xx rs) = (Alias xx , rs)
typeRanges (Net kw rs) = (Net kw , rs)
typeRanges (Implicit sg rs) = (Implicit sg, rs)
typeRanges (IntegerVector kw sg rs) = (IntegerVector kw sg, rs)
typeRanges (IntegerAtom kw sg ) = (\[] -> IntegerAtom kw sg, [])
typeRanges (NonInteger kw ) = (\[] -> NonInteger kw , [])
typeRanges (Enum t v r) = (Enum t v, r)
typeRanges (Struct p l r) = (Struct p l, r)
typeRanges (InterfaceT x my r) = (InterfaceT x my, r)
data Decl
= Parameter Type Identifier Expr
| Localparam Type Identifier Expr
......@@ -357,176 +220,6 @@ instance Show NOutputGateKW where
show GateBuf = "buf"
show GateNot = "not"
showAssignment :: Maybe Expr -> String
showAssignment Nothing = ""
showAssignment (Just val) = " = " ++ show val
showRanges :: [Range] -> String
showRanges [] = ""
showRanges l = " " ++ (concat $ map rangeToString l)
where rangeToString d = init $ showRange $ Just d
showRange :: Maybe Range -> String
showRange Nothing = ""
showRange (Just (h, l)) = printf "[%s:%s] " (show h) (show l)
showPad :: Show t => t -> String
showPad x =
if str == ""
then ""
else str ++ " "
where str = show x
showPadBefore :: Show t => t -> String
showPadBefore x =
if str == ""
then ""
else " " ++ str
where str = show x
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 String
| ConstBool Bool
| Ident Identifier
| Range Expr Range
| Bit Expr Expr
| Repeat Expr [Expr]
| Concat [Expr]
| Call Identifier [Maybe Expr]
| UniOp UniOp Expr
| BinOp BinOp Expr Expr
| Mux Expr Expr Expr
| Cast Type Expr
| Access Expr Identifier
| Pattern [(Maybe Identifier, Expr)]
deriving (Eq, Ord)
data UniOp
= Not
| BWNot
| UAdd
| USub
| RedAnd
| RedNand
| RedOr
| RedNor
| RedXor
| RedXnor
deriving (Eq, Ord)
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
| Pow
| ShiftAL
| ShiftAR
| TEq
| TNe
| WEq
| WNe
deriving (Eq, Ord)
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 -> ">="
Pow -> "**"
ShiftAL -> "<<<"
ShiftAR -> ">>>"
TEq -> "==="
TNe -> "!=="
WEq -> "==?"
WNe -> "!=?"
instance Show Expr where
show x = case x of
String a -> printf "\"%s\"" a
Number a -> a
ConstBool a -> printf "1'b%s" (if a then "1" else "0")
Ident a -> a
Bit a b -> printf "%s[%s]" (show a) (show b)
Range a (b, c) -> printf "%s[%s:%s]" (show a) (show b) (show c)
Repeat a b -> printf "{%s {%s}}" (show a) (commas $ map show b)
Concat a -> printf "{%s}" (commas $ map show a)
Call a b -> printf "%s(%s)" a (commas $ map (maybe "" show) b)
UniOp a b -> printf "(%s %s)" (show a) (show b)
BinOp a b c -> printf "(%s %s %s)" (show b) (show a) (show c)
Mux a b c -> printf "(%s ? %s : %s)" (show a) (show b) (show c)
Cast a b -> printf "%s'(%s)" (show a) (show b)
Access e n -> printf "%s.%s" (show e) n
Pattern l -> printf "'{\n%s\n}" (showPatternItems l)
where
showPatternItems :: [(Maybe Identifier, Expr)] -> String
showPatternItems l = indent $ intercalate ",\n" (map showPatternItem l)
showPatternItem :: (Maybe Identifier, Expr) -> String
showPatternItem (Nothing, e) = show e
showPatternItem (Just n , e) = printf "%s: %s" n (show e)
data AsgnOp
= AsgnOpEq
| AsgnOp BinOp
deriving Eq
instance Show AsgnOp where
show AsgnOpEq = "="
show (AsgnOp op) = (show op) ++ "="
data LHS
= LHSIdent Identifier
| LHSBit LHS Expr
......@@ -570,9 +263,6 @@ data Stmt
| Null
deriving Eq
commas :: [String] -> String
commas = intercalate ", "
instance Show Stmt where
show (Block name decls stmts) =
printf "begin%s\n%s\n%s\nend" header (block decls) (block stmts)
......@@ -637,14 +327,6 @@ instance Show Sense where
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)"
type GenCase = ([Expr], GenItem)
data GenItem
......
src/Language/SystemVerilog/AST/Expr.hs 0 → 100644
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
- Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
-
- SystemVerilog expressions
-}
module Language.SystemVerilog.AST.Expr
( Expr (..)
, Range
, showAssignment
, showRanges
) where
import Data.List (intercalate)
import Text.Printf (printf)
import Language.SystemVerilog.AST.Op
import Language.SystemVerilog.AST.ShowHelp
import {-# SOURCE #-} Language.SystemVerilog.AST.Type
type Range = (Expr, Expr)
data Expr
= String String
| Number String
| Ident Identifier
| Range Expr Range
| Bit Expr Expr
| Repeat Expr [Expr]
| Concat [Expr]
| Call Identifier [Maybe Expr]
| UniOp UniOp Expr
| BinOp BinOp Expr Expr
| Mux Expr Expr Expr
| Cast Type Expr
| Dot Expr Identifier
| Pattern [(Maybe Identifier, Expr)]
deriving (Eq, Ord)
instance Show Expr where
show (Number str ) = str
show (Ident str ) = str
show (String str ) = printf "\"%s\"" str
show (Bit e b ) = printf "%s[%s]" (show e) (show b)
show (Range e r ) = printf "%s%s" (show e) (showRange r)
show (Repeat e l ) = printf "{%s {%s}}" (show e) (commas $ map show l)
show (Concat l ) = printf "{%s}" (commas $ map show l)
show (UniOp a b ) = printf "(%s %s)" (show a) (show b)
show (BinOp a o b) = printf "(%s %s %s)" (show a) (show o) (show b)
show (Cast t e ) = printf "%s'(%s)" (show t) (show e)
show (Dot e n ) = printf "%s.%s" (show e) n
show (Mux c a b) = printf "(%s ? %s : %s)" (show c) (show a) (show b)
show (Call f l ) = printf "%s(%s)" f (commas $ map (maybe "" show) l)
show (Pattern l ) =
printf "'{\n%s\n}" (indent $ intercalate ",\n" $ map showPatternItem l)
where
showPatternItem :: (Maybe Identifier, Expr) -> String
showPatternItem (Nothing, e) = show e
showPatternItem (Just n , e) = printf "%s: %s" n (show e)
showAssignment :: Maybe Expr -> String
showAssignment Nothing = ""
showAssignment (Just val) = " = " ++ show val
showRanges :: [Range] -> String
showRanges [] = ""
showRanges l = " " ++ (concatMap showRange l)
showRange :: Range -> String
showRange (h, l) = printf "[%s:%s]" (show h) (show l)
src/Language/SystemVerilog/AST/Op.hs 0 → 100644
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
- Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
-
- SystemVerilog operators (unary, binary, and assignment)
-}
module Language.SystemVerilog.AST.Op
( UniOp (..)
, BinOp (..)
, AsgnOp (..)
) where
data UniOp
= LogNot
| BitNot
| UniAdd
| UniSub
| RedAnd
| RedNand
| RedOr
| RedNor
| RedXor
| RedXnor
deriving (Eq, Ord)
instance Show UniOp where
show LogNot = "!"
show BitNot = "~"
show UniAdd = "+"
show UniSub = "-"
show RedAnd = "&"
show RedNand = "~&"
show RedOr = "|"
show RedNor = "~|"
show RedXor = "^"
show RedXnor = "~^"
data BinOp
= LogAnd
| LogOr
| BitAnd
| BitXor
| BitOr
| Mul
| Div
| Mod
| Add
| Sub
| Pow
| ShiftL
| ShiftR
| ShiftAL
| ShiftAR
| Eq
| Ne
| TEq
| TNe
| WEq
| WNe
| Lt
| Le
| Gt
| Ge
deriving (Eq, Ord)
instance Show BinOp where
show LogAnd = "&&"
show LogOr = "||"
show BitAnd = "&"
show BitXor = "^"
show BitOr = "|"
show Mul = "*"
show Div = "/"
show Mod = "%"
show Add = "+"
show Sub = "-"
show Pow = "**"
show ShiftL = "<<"
show ShiftR = ">>"
show ShiftAL = "<<<"
show ShiftAR = ">>>"
show Eq = "=="
show Ne = "!="
show TEq = "==="
show TNe = "!=="
show WEq = "==?"
show WNe = "!=?"
show Lt = "<"
show Le = "<="
show Gt = ">"
show Ge = ">="
data AsgnOp
= AsgnOpEq
| AsgnOp BinOp
deriving (Eq, Ord)
instance Show AsgnOp where
show AsgnOpEq = "="
show (AsgnOp op) = (show op) ++ "="
src/Language/SystemVerilog/AST/ShowHelp.hs 0 → 100644
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
- Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
-
- Helpers for printing AST items
-}
module Language.SystemVerilog.AST.ShowHelp
( showPad
, showPadBefore
, indent
, unlines'
, commas
, indentedParenList
) where
import Data.List (intercalate)
showPad :: Show t => t -> String
showPad x =
if str == ""
then ""
else str ++ " "
where str = show x
showPadBefore :: Show t => t -> String
showPadBefore x =
if str == ""
then ""
else " " ++ str
where str = show x
indent :: String -> String
indent a = '\t' : f a
where
f [] = []
f ('\n' : xs) = "\n\t" ++ f xs
f (x : xs) = x : f xs
unlines' :: [String] -> String
unlines' = intercalate "\n"
commas :: [String] -> String
commas = intercalate ", "
indentedParenList :: [String] -> String
indentedParenList [] = "()"
indentedParenList [x] = "(" ++ x ++ ")"
indentedParenList l = "(\n" ++ (indent $ intercalate ",\n" l) ++ "\n)"
src/Language/SystemVerilog/AST/Type.hs 0 → 100644
{-# LANGUAGE FlexibleInstances #-}
{- sv2v
- Author: Zachary Snow <zach@zachjs.com>
- Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
-
- SystemVerilog types
-}
module Language.SystemVerilog.AST.Type
( Identifier
, Type (..)
, Signing (..)
, Packing (..)
, NetType (..)
, IntegerVectorType (..)
, IntegerAtomType (..)
, NonIntegerType (..)
, typeRanges
) where
import Text.Printf (printf)
import Language.SystemVerilog.AST.Expr
import Language.SystemVerilog.AST.ShowHelp
type Identifier = String
type Item = (Identifier, Maybe Expr)
type Field = (Type, Identifier)
data Type
= IntegerVector IntegerVectorType Signing [Range]
| IntegerAtom IntegerAtomType Signing
| NonInteger NonIntegerType
| Net NetType [Range]
| Implicit Signing [Range]
| Alias Identifier [Range]
| Enum (Maybe Type) [Item] [Range]
| Struct Packing [Field] [Range]
| InterfaceT Identifier (Maybe Identifier) [Range]
deriving (Eq, Ord)
instance Show Type where
show (Alias xx rs) = printf "%s%s" xx (showRanges rs)
show (Net kw rs) = printf "%s%s" (show kw) (showRanges rs)
show (Implicit sg rs) = printf "%s%s" (show sg) (showRanges rs)
show (IntegerVector kw sg rs) = printf "%s%s%s" (show kw) (showPadBefore sg) (showRanges rs)
show (IntegerAtom kw sg ) = printf "%s%s" (show kw) (showPadBefore sg)
show (NonInteger kw ) = printf "%s" (show kw)
show (InterfaceT x my r) = x ++ yStr ++ (showRanges r)
where yStr = maybe "" ("."++) my
show (Enum mt vals r) = printf "enum %s{%s}%s" tStr (commas $ map showVal vals) (showRanges r)
where
tStr = maybe "" showPad mt
showVal :: (Identifier, Maybe Expr) -> String
showVal (x, e) = x ++ (showAssignment e)
show (Struct p items r) = printf "struct %s{\n%s\n}%s" (showPad p) itemsStr (showRanges r)
where
itemsStr = indent $ unlines' $ map showItem items
showItem (t, x) = printf "%s %s;" (show t) x
instance Show ([Range] -> Type) where
show tf = show (tf [])
instance Eq ([Range] -> Type) where
(==) tf1 tf2 = (tf1 []) == (tf2 [])
instance Ord ([Range] -> Type) where
compare tf1 tf2 = compare (tf1 []) (tf2 [])
instance Show (Signing -> [Range] -> Type) where
show tf = show (tf Unspecified)
instance Eq (Signing -> [Range] -> Type) where
(==) tf1 tf2 = (tf1 Unspecified) == (tf2 Unspecified)
instance Ord (Signing -> [Range] -> Type) where
compare tf1 tf2 = compare (tf1 Unspecified) (tf2 Unspecified)
typeRanges :: Type -> ([Range] -> Type, [Range])
typeRanges (Alias xx rs) = (Alias xx , rs)
typeRanges (Net kw rs) = (Net kw , rs)
typeRanges (Implicit sg rs) = (Implicit sg, rs)
typeRanges (IntegerVector kw sg rs) = (IntegerVector kw sg, rs)
typeRanges (IntegerAtom kw sg ) = (\[] -> IntegerAtom kw sg, [])
typeRanges (NonInteger kw ) = (\[] -> NonInteger kw , [])
typeRanges (Enum t v r) = (Enum t v, r)
typeRanges (Struct p l r) = (Struct p l, r)
typeRanges (InterfaceT x my r) = (InterfaceT x my, r)
data Signing
= Unspecified
| Signed
| Unsigned
deriving (Eq, Ord)
instance Show Signing where
show Unspecified = ""
show Signed = "signed"
show Unsigned = "unsigned"
data NetType
= TSupply0
| TSupply1
| TTri
| TTriand
| TTrior
| TTrireg
| TTri0
| TTri1
| TUwire
| TWire
| TWand
| TWor
deriving (Eq, Ord)
data IntegerVectorType
= TBit
| TLogic
| TReg
deriving (Eq, Ord)
data IntegerAtomType
= TByte
| TShortint
| TInt
| TLongint
| TInteger
| TTime
deriving (Eq, Ord)
data NonIntegerType
= TShortreal
| TReal
| TRealtime
deriving (Eq, Ord)
instance Show NetType where
show TSupply0 = "supply0"
show TSupply1 = "supply1"
show TTri = "tri"
show TTriand = "triand"
show TTrior = "trior"
show TTrireg = "trireg"
show TTri0 = "tri0"
show TTri1 = "tri1"
show TUwire = "uwire"
show TWire = "wire"
show TWand = "wand"
show TWor = "wor"
instance Show IntegerVectorType where
show TBit = "bit"
show TLogic = "logic"
show TReg = "reg"
instance Show IntegerAtomType where
show TByte = "byte"
show TShortint = "shortint"
show TInt = "int"
show TLongint = "longint"
show TInteger = "integer"
show TTime = "time"
instance Show NonIntegerType where
show TShortreal = "shortreal"
show TReal = "real"
show TRealtime = "realtime"
data Packing
= Unpacked
| Packed Signing
deriving (Eq, Ord)
instance Show Packing where
show (Unpacked) = ""
show (Packed s) = "packed" ++ (showPadBefore s)
src/Language/SystemVerilog/AST/Type.hs-boot 0 → 100644
module Language.SystemVerilog.AST.Type
( Identifier
, Type
) where
type Identifier = String
data Type
instance Eq Type
instance Ord Type
instance Show Type
src/Language/SystemVerilog/Parser/Parse.y
......@@ -207,7 +207,7 @@ directive { Token Spe_Directive _ _ }
%left "+" "-"
%left "*" "/" "%"
%left "**"
%right UPlus UMinus "!" "~" RedOps "++" "--"
%right REDUCE_OP "!" "~" "++" "--"
%left "(" ")" "[" "]" "."
......@@ -618,60 +618,62 @@ CallArgsFollow :: { [Maybe Expr] }
| "," opt(Expr) CallArgsFollow { $2 : $3 }
Exprs :: { [Expr] }
: Expr { [$1] }
| Exprs "," Expr { $1 ++ [$3] }
: Expr { [$1] }
| Exprs "," Expr { $1 ++ [$3] }
Expr :: { Expr }
: "(" Expr ")" { $2 }
| String { String $1 }
| Number { Number $1 }
| Identifier "(" CallArgs ")" { Call $1 $3 }
| Identifier { Ident $1 }
| Expr Range { Range $1 $2 }
| Expr "[" Expr "]" { Bit $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 "**" Expr { BinOp Pow $1 $3 }
| Expr "<<<" Expr { BinOp ShiftAL $1 $3 }
| Expr ">>>" Expr { BinOp ShiftAR $1 $3 }
| Expr "===" Expr { BinOp TEq $1 $3 }
| Expr "!==" Expr { BinOp TNe $1 $3 }
| Expr "==?" Expr { BinOp WEq $1 $3 }
| Expr "!=?" Expr { BinOp WNe $1 $3 }
| "!" Expr { UniOp Not $2 }
| "~" Expr { UniOp BWNot $2 }
| "+" Expr %prec UPlus { UniOp UAdd $2 }
| "-" Expr %prec UMinus { UniOp USub $2 }
| "&" Expr %prec RedOps { UniOp RedAnd $2 }
| "~&" Expr %prec RedOps { UniOp RedNand $2 }
| "|" Expr %prec RedOps { UniOp RedOr $2 }
| "~|" Expr %prec RedOps { UniOp RedNor $2 }
| "^" Expr %prec RedOps { UniOp RedXor $2 }
| "~^" Expr %prec RedOps { UniOp RedXnor $2 }
| "^~" Expr %prec RedOps { UniOp RedXnor $2 }
| CastingType "'" "(" Expr ")" { Cast ($1 ) $4 }
| Identifier "'" "(" Expr ")" { Cast (Alias $1 []) $4 }
| Expr "." Identifier { Access $1 $3 }
| "'" "{" PatternItems "}" { Pattern $3 }
: "(" Expr ")" { $2 }
| String { String $1 }
| Number { Number $1 }
| Identifier "(" CallArgs ")" { Call $1 $3 }
| Identifier { Ident $1 }
| Expr Range { Range $1 $2 }
| Expr "[" Expr "]" { Bit $1 $3 }
| "{" Expr "{" Exprs "}" "}" { Repeat $2 $4 }
| "{" Exprs "}" { Concat $2 }
| Expr "?" Expr ":" Expr { Mux $1 $3 $5 }
| CastingType "'" "(" Expr ")" { Cast ($1 ) $4 }
| Identifier "'" "(" Expr ")" { Cast (Alias $1 []) $4 }
| Expr "." Identifier { Dot $1 $3 }
| "'" "{" PatternItems "}" { Pattern $3 }
-- binary expressions
| Expr "||" Expr { BinOp LogOr $1 $3 }
| Expr "&&" Expr { BinOp LogAnd $1 $3 }
| Expr "|" Expr { BinOp BitOr $1 $3 }
| Expr "^" Expr { BinOp BitXor $1 $3 }
| Expr "&" Expr { BinOp BitAnd $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 "**" Expr { BinOp Pow $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 TEq $1 $3 }
| Expr "!==" Expr { BinOp TNe $1 $3 }
| Expr "==?" Expr { BinOp WEq $1 $3 }
| Expr "!=?" Expr { BinOp WNe $1 $3 }
| Expr "<<" Expr { BinOp ShiftL $1 $3 }
| Expr ">>" Expr { BinOp ShiftR $1 $3 }
| Expr "<<<" Expr { BinOp ShiftAL $1 $3 }
| Expr ">>>" Expr { BinOp ShiftAR $1 $3 }
-- unary expressions
| "!" Expr { UniOp LogNot $2 }
| "~" Expr { UniOp BitNot $2 }
| "+" Expr %prec REDUCE_OP { UniOp UniAdd $2 }
| "-" Expr %prec REDUCE_OP { UniOp UniSub $2 }
| "&" Expr %prec REDUCE_OP { UniOp RedAnd $2 }
| "~&" Expr %prec REDUCE_OP { UniOp RedNand $2 }
| "|" Expr %prec REDUCE_OP { UniOp RedOr $2 }
| "~|" Expr %prec REDUCE_OP { UniOp RedNor $2 }
| "^" Expr %prec REDUCE_OP { UniOp RedXor $2 }
| "~^" Expr %prec REDUCE_OP { UniOp RedXnor $2 }
| "^~" Expr %prec REDUCE_OP { UniOp RedXnor $2 }
PatternItems :: { [(Maybe Identifier, Expr)] }
: PatternNamedItems { map (\(x,e) -> (Just x, e)) $1 }
......@@ -726,9 +728,9 @@ AsgnOp :: { AsgnOp }
| "*=" { AsgnOp Mul }
| "/=" { AsgnOp Div }
| "%=" { AsgnOp Mod }
| "&=" { AsgnOp BWAnd }
| "|=" { AsgnOp BWOr }
| "^=" { AsgnOp BWXor }
| "&=" { AsgnOp BitAnd }
| "|=" { AsgnOp BitOr }
| "^=" { AsgnOp BitXor }
| "<<=" { AsgnOp ShiftL }
| ">>=" { AsgnOp ShiftR }
| "<<<=" { AsgnOp ShiftAL }
......@@ -771,11 +773,11 @@ combineTags Nothing other = other
combineTags other _ = other
exprToLHS :: Expr -> LHS
exprToLHS (Ident x) = LHSIdent x
exprToLHS (Bit e b) = LHSBit (exprToLHS e) b
exprToLHS (Range e r) = LHSRange (exprToLHS e) r
exprToLHS (Access e x) = LHSDot (exprToLHS e) x
exprToLHS (Concat es ) = LHSConcat (map exprToLHS es)
exprToLHS (Ident x) = LHSIdent x
exprToLHS (Bit e b) = LHSBit (exprToLHS e) b
exprToLHS (Range e r) = LHSRange (exprToLHS e) r
exprToLHS (Dot e x) = LHSDot (exprToLHS e) x
exprToLHS (Concat es) = LHSConcat (map exprToLHS es)
exprToLHS other =
error $ "Parse error: cannot convert expression to LHS: " ++ show other
......
sv2v.cabal
......@@ -33,6 +33,10 @@ executable sv2v
-- SystemVerilog modules
Language.SystemVerilog
Language.SystemVerilog.AST
Language.SystemVerilog.AST.Expr
Language.SystemVerilog.AST.Op
Language.SystemVerilog.AST.ShowHelp
Language.SystemVerilog.AST.Type
Language.SystemVerilog.Parser
Language.SystemVerilog.Parser.Lex
Language.SystemVerilog.Parser.Parse
......
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