From 77f0d23d4bd064aa3c976a6fb93869b3c4bf659b Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Fri, 22 Mar 2019 19:24:45 -0400 Subject: [PATCH] starting work to clean up and segment AST --- src/Convert/AsgnOp.hs | 6 +- src/Convert/Interface.hs | 4 +- src/Convert/Struct.hs | 6 +- src/Convert/Traverse.hs | 11 +- src/Language/SystemVerilog/AST.hs | 422 +++----------------- src/Language/SystemVerilog/AST/Expr.hs | 71 ++++ src/Language/SystemVerilog/AST/Op.hs | 101 +++++ src/Language/SystemVerilog/AST/ShowHelp.hs | 50 +++ src/Language/SystemVerilog/AST/Type.hs | 167 ++++++++ src/Language/SystemVerilog/AST/Type.hs-boot | 11 + src/Language/SystemVerilog/Parser/Parse.y | 124 +++--- sv2v.cabal | 4 + 12 files changed, 532 insertions(+), 445 deletions(-) create mode 100644 src/Language/SystemVerilog/AST/Expr.hs create mode 100644 src/Language/SystemVerilog/AST/Op.hs create mode 100644 src/Language/SystemVerilog/AST/ShowHelp.hs create mode 100644 src/Language/SystemVerilog/AST/Type.hs create mode 100644 src/Language/SystemVerilog/AST/Type.hs-boot diff --git a/src/Convert/AsgnOp.hs b/src/Convert/AsgnOp.hs index 2bcd282..0c67891 100644 --- a/src/Convert/AsgnOp.hs +++ b/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 diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs index 190a31f..3d84b18 100644 --- a/src/Convert/Interface.hs +++ b/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 diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index 8cfdb1e..fccd022 100644 --- a/src/Convert/Struct.hs +++ b/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 diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 52a5673..c5d103f 100644 --- a/src/Convert/Traverse.hs +++ b/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 diff --git a/src/Language/SystemVerilog/AST.hs b/src/Language/SystemVerilog/AST.hs index ca1eaa2..4960d1a 100644 --- a/src/Language/SystemVerilog/AST.hs +++ b/src/Language/SystemVerilog/AST.hs @@ -1,61 +1,64 @@ -{-# LANGUAGE FlexibleInstances #-} -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 +{- sv2v + - Author: Zachary Snow + - Initial Verilog AST Author: Tom Hawkins + - + - 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. + -} -import Data.List -import Data.Maybe -import Text.Printf +module Language.SystemVerilog.AST + ( 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 diff --git a/src/Language/SystemVerilog/AST/Expr.hs b/src/Language/SystemVerilog/AST/Expr.hs new file mode 100644 index 0000000..5764f4e --- /dev/null +++ b/src/Language/SystemVerilog/AST/Expr.hs @@ -0,0 +1,71 @@ +{- sv2v + - Author: Zachary Snow + - Initial Verilog AST Author: Tom Hawkins + - + - 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) diff --git a/src/Language/SystemVerilog/AST/Op.hs b/src/Language/SystemVerilog/AST/Op.hs new file mode 100644 index 0000000..bb300d4 --- /dev/null +++ b/src/Language/SystemVerilog/AST/Op.hs @@ -0,0 +1,101 @@ +{- sv2v + - Author: Zachary Snow + - Initial Verilog AST Author: Tom Hawkins + - + - 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) ++ "=" diff --git a/src/Language/SystemVerilog/AST/ShowHelp.hs b/src/Language/SystemVerilog/AST/ShowHelp.hs new file mode 100644 index 0000000..5fb031d --- /dev/null +++ b/src/Language/SystemVerilog/AST/ShowHelp.hs @@ -0,0 +1,50 @@ +{- sv2v + - Author: Zachary Snow + - Initial Verilog AST Author: Tom Hawkins + - + - 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)" + diff --git a/src/Language/SystemVerilog/AST/Type.hs b/src/Language/SystemVerilog/AST/Type.hs new file mode 100644 index 0000000..6d45039 --- /dev/null +++ b/src/Language/SystemVerilog/AST/Type.hs @@ -0,0 +1,167 @@ +{-# LANGUAGE FlexibleInstances #-} +{- sv2v + - Author: Zachary Snow + - Initial Verilog AST Author: Tom Hawkins + - + - 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) diff --git a/src/Language/SystemVerilog/AST/Type.hs-boot b/src/Language/SystemVerilog/AST/Type.hs-boot new file mode 100644 index 0000000..63b0165 --- /dev/null +++ b/src/Language/SystemVerilog/AST/Type.hs-boot @@ -0,0 +1,11 @@ +module Language.SystemVerilog.AST.Type + ( Identifier + , Type + ) where + +type Identifier = String + +data Type +instance Eq Type +instance Ord Type +instance Show Type diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index 1a97f0f..2ceabdd 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/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 diff --git a/sv2v.cabal b/sv2v.cabal index 344af3c..01cfae5 100644 --- a/sv2v.cabal +++ b/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