From 8a67a91166e4fc9b618dfdfadde9c3f46b20c7d5 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Thu, 8 Aug 2019 23:12:06 -0400 Subject: [PATCH] added language support for (untagged) unions --- src/Convert/Traverse.hs | 4 ++++ src/Convert/Typedef.hs | 10 ++++++---- src/Language/SystemVerilog/AST/Type.hs | 14 ++++++++++---- src/Language/SystemVerilog/Parser/Lex.x | 1 + src/Language/SystemVerilog/Parser/Parse.y | 2 ++ 5 files changed, 23 insertions(+), 8 deletions(-) diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 49aaff6..3595828 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -785,6 +785,10 @@ traverseTypesM mapper item = types <- mapM fullMapper $ map fst fields let idents = map snd fields return $ Struct p (zip types idents) r + tm (Union p fields r) = do + types <- mapM fullMapper $ map fst fields + let idents = map snd fields + return $ Union p (zip types idents) r exprMapper (Cast (Left t) e) = fullMapper t >>= \t' -> return $ Cast (Left t') e exprMapper (Bits (Left t)) = diff --git a/src/Convert/Typedef.hs b/src/Convert/Typedef.hs index 9510cfa..10c4f10 100644 --- a/src/Convert/Typedef.hs +++ b/src/Convert/Typedef.hs @@ -54,6 +54,9 @@ convertDescription globalTypes description = else Bits $ Right $ Ident x convertExpr other = other +resolveItem :: Types -> (Type, Identifier) -> (Type, Identifier) +resolveItem types (t, x) = (resolveType types t, x) + resolveType :: Types -> Type -> Type resolveType _ (Net kw rs) = Net kw rs resolveType _ (Implicit sg rs) = Implicit sg rs @@ -64,10 +67,8 @@ resolveType _ (InterfaceT x my rs) = InterfaceT x my rs resolveType _ (Enum Nothing vals rs) = Enum Nothing vals rs resolveType _ (Alias (Just ps) st rs) = Alias (Just ps) st rs resolveType types (Enum (Just t) vals rs) = Enum (Just $ resolveType types t) vals rs -resolveType types (Struct p items rs) = Struct p items' rs - where - items' = map resolveItem items - resolveItem (t, x) = (resolveType types t, x) +resolveType types (Struct p items rs) = Struct p (map (resolveItem types) items) rs +resolveType types (Union p items rs) = Union p (map (resolveItem types) items) rs resolveType types (Alias Nothing st rs1) = if Map.notMember st types then InterfaceT st Nothing rs1 @@ -77,6 +78,7 @@ resolveType types (Alias Nothing st rs1) = (IntegerVector kw sg rs2) -> IntegerVector kw sg $ rs1 ++ rs2 (Enum t v rs2) -> Enum t v $ rs1 ++ rs2 (Struct p l rs2) -> Struct p l $ rs1 ++ rs2 + (Union p l rs2) -> Union p l $ rs1 ++ rs2 (InterfaceT x my rs2) -> InterfaceT x my $ rs1 ++ rs2 (IntegerAtom kw _ ) -> error $ "resolveType encountered packed `" ++ (show kw) ++ "` on " ++ st (NonInteger kw ) -> error $ "resolveType encountered packed `" ++ (show kw) ++ "` on " ++ st diff --git a/src/Language/SystemVerilog/AST/Type.hs b/src/Language/SystemVerilog/AST/Type.hs index 4f5ca13..645a20d 100644 --- a/src/Language/SystemVerilog/AST/Type.hs +++ b/src/Language/SystemVerilog/AST/Type.hs @@ -37,6 +37,7 @@ data Type | Alias (Maybe Identifier) Identifier [Range] | Enum (Maybe Type) [Item] [Range] | Struct Packing [Field] [Range] + | Union Packing [Field] [Range] | InterfaceT Identifier (Maybe Identifier) [Range] deriving (Eq, Ord) @@ -54,10 +55,14 @@ instance Show Type 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 + show (Struct p items r) = printf "struct %s{\n%s\n}%s" (showPad p) (showFields items) (showRanges r) + show (Union p items r) = printf "union %s{\n%s\n}%s" (showPad p) (showFields items) (showRanges r) + +showFields :: [Field] -> String +showFields items = itemsStr + 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 []) @@ -82,6 +87,7 @@ 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 (Union p l r) = (Union p l, r) typeRanges (InterfaceT x my r) = (InterfaceT x my, r) data Signing diff --git a/src/Language/SystemVerilog/Parser/Lex.x b/src/Language/SystemVerilog/Parser/Lex.x index ef0c03a..03e0c9e 100644 --- a/src/Language/SystemVerilog/Parser/Lex.x +++ b/src/Language/SystemVerilog/Parser/Lex.x @@ -197,6 +197,7 @@ tokens :- "trior" { tok KW_trior } "trireg" { tok KW_trireg } "typedef" { tok KW_typedef } + "union" { tok KW_union } "unique" { tok KW_unique } "unique0" { tok KW_unique0 } "unsigned" { tok KW_unsigned } diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index 3e3e460..0175db4 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -115,6 +115,7 @@ import Language.SystemVerilog.Parser.Tokens "trior" { Token KW_trior _ _ } "trireg" { Token KW_trireg _ _ } "typedef" { Token KW_typedef _ _ } +"union" { Token KW_union _ _ } "unique" { Token KW_unique _ _ } "unique0" { Token KW_unique0 _ _ } "unsigned" { Token KW_unsigned _ _ } @@ -277,6 +278,7 @@ PartialType :: { Signing -> [Range] -> Type } | NonIntegerType { \Unspecified -> \[] -> NonInteger $1 } | "enum" EnumBaseType "{" EnumItems "}" { \Unspecified -> Enum $2 $4 } | "struct" Packing "{" StructItems "}" { \Unspecified -> Struct $2 $4 } + | "union" Packing "{" StructItems "}" { \Unspecified -> Union $2 $4 } CastingType :: { Type } : IntegerVectorType { IntegerVector $1 Unspecified [] } | IntegerAtomType { IntegerAtom $1 Unspecified }