From de581ecaf552bb83bcd7359914fb33ee14616714 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Sun, 13 Oct 2019 19:01:42 -0400 Subject: [PATCH] initial support for types in struct patterns --- src/Convert/Struct.hs | 108 +++++++++++-------- src/Language/SystemVerilog/AST/Expr.hs | 9 +- src/Language/SystemVerilog/Parser/Parse.y | 11 +- test/basic/pattern.sv | 40 ++++++++ test/basic/pattern.v | 120 ++++++++++++++++++++++ 5 files changed, 234 insertions(+), 54 deletions(-) create mode 100644 test/basic/pattern.sv create mode 100644 test/basic/pattern.v diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index b1e071b..28ec91b 100644 --- a/src/Convert/Struct.hs +++ b/src/Convert/Struct.hs @@ -8,8 +8,7 @@ module Convert.Struct (convert) where import Control.Monad.State import Control.Monad.Writer -import Data.List (elemIndex, sortOn) -import Data.Maybe (fromJust, isJust) +import Data.List (partition) import Data.Tuple (swap) import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -299,67 +298,86 @@ convertAsgn structs types (lhs, expr) = convertLHS (LHSStream o e lhss) = (Implicit Unspecified [], LHSStream o e $ map (snd . convertLHS) lhss) - defaultKey = Just "default" + specialTag = ':' + defaultKey = specialTag : "default" -- try expression conversion by looking at the *outermost* type first convertExpr :: Type -> Expr -> Expr -- TODO: This is really a conversion for using default patterns to -- populate arrays. Maybe this should be somewhere else? - convertExpr (IntegerVector t sg (r:rs)) (Pattern [(Just "default", e)]) = + convertExpr (IntegerVector t sg (r:rs)) (Pattern [(":default", e)]) = Repeat (rangeSize r) [e'] where e' = convertExpr (IntegerVector t sg rs) e convertExpr (Struct (Packed sg) fields (_:rs)) (Concat exprs) = Concat $ map (convertExpr (Struct (Packed sg) fields rs)) exprs convertExpr (Struct (Packed sg) fields (_:rs)) (Bit e _) = convertExpr (Struct (Packed sg) fields rs) e - convertExpr (Struct (Packed sg) fields rs) (Pattern [(Just "default", e)]) = - if Map.notMember structTf structs then - Pattern [(defaultKey, e)] - else if null rs then - expanded - else - Repeat (dimensionsSize rs) [expanded] - where - structTf = Struct (Packed sg) fields - expanded = convertExpr (structTf []) $ Pattern $ - take (length fields) (repeat (Nothing, e)) convertExpr (Struct (Packed sg) fields []) (Pattern itemsOrig) = - if length items /= length fields then - error $ "struct pattern " ++ show items ++ - " doesn't have the same # of items as " ++ show structTf - else if itemsFieldNames /= fieldNames then - error $ "struct pattern " ++ show items ++ " has fields " ++ - show itemsFieldNames ++ ", but struct type has fields " ++ - show fieldNames - else if Map.notMember structTf structs then - Pattern items + if extraNames /= Set.empty then + error $ "pattern " ++ show (Pattern itemsOrig) ++ + " has extra named fields: " ++ + show (Set.toList extraNames) ++ " that are not in " ++ + show structTf + else if Map.member structTf structs then + Call Nothing + (packerFnName structTf) + (Args (map (Just . snd) items) []) else - Call Nothing fnName $ Args (map (Just . snd) items) [] + Pattern items where - subMap = \(Just ident, subExpr) -> - (Just ident, convertExpr (lookupFieldType fields ident) subExpr) structTf = Struct (Packed sg) fields + fieldNames = map snd fields + fieldTypeMap = Map.fromList $ map swap fields + itemsNamed = + -- patterns either use positions based or name/type/default + if all ((/= "") . fst) itemsOrig then + itemsOrig + -- position-based patterns should cover every field + else if length itemsOrig /= length fields then + error $ "struct pattern " ++ show items ++ + " doesn't have the same # of items as " ++ + show structTf -- if the pattern does not use identifiers, use the -- identifiers from the struct type definition in order - if not (all (isJust . fst) itemsOrig) then - zip (map (Just. snd) fields) (map snd itemsOrig) - -- if the pattern has a default value, use that for any - -- missing fields - else if any ((== defaultKey) . fst) itemsOrig then - let origValueMap = Map.fromList itemsOrig - origValues = Map.delete defaultKey origValueMap - defaultValue = origValueMap Map.! defaultKey - defaultValues = Map.fromList $ - zip (map Just fieldNames) (repeat defaultValue) - in Map.toList $ Map.union origValues defaultValues else - itemsOrig - items = sortOn itemPosition $ map subMap itemsNamed - fieldNames = map snd fields - itemsFieldNames = map (fromJust . fst) items - itemPosition = \(Just x, _) -> fromJust $ elemIndex x fieldNames - fnName = packerFnName structTf + zip fieldNames (map snd itemsOrig) + (specialItems, namedItems) = + partition ((== specialTag) . head . fst) itemsNamed + namedItemMap = Map.fromList namedItems + specialItemMap = Map.fromList specialItems + + extraNames = Set.difference + (Set.fromList $ map fst namedItems) + (Map.keysSet fieldTypeMap) + + items = zip fieldNames $ map resolveField fieldNames + resolveField :: Identifier -> Expr + resolveField fieldName = + convertExpr fieldType $ + -- look up by name + if Map.member fieldName namedItemMap then + namedItemMap Map.! fieldName + -- look up by field type + else if Map.member fieldTypeName specialItemMap then + specialItemMap Map.! fieldTypeName + -- fall back on the default value + else if Map.member defaultKey specialItemMap then + specialItemMap Map.! defaultKey + else + error $ "couldn't find field " ++ fieldName ++ + " from struct definition " ++ show structTf ++ + " in struct pattern " ++ show itemsOrig + where + fieldType = fieldTypeMap Map.! fieldName + fieldTypeName = + specialTag : (show $ fst $ typeRanges fieldType) + + convertExpr (Struct (Packed sg) fields (r : rs)) subExpr = + Repeat (rangeSize r) [subExpr'] + where + structTf = Struct (Packed sg) fields + subExpr' = convertExpr (structTf rs) subExpr convertExpr _ other = other -- try expression conversion by looking at the *innermost* type first @@ -470,7 +488,7 @@ convertAsgn structs types (lhs, expr) = tore' = convertTypeOrExpr tore e' = snd $ convertSubExpr e convertSubExpr (Pattern items) = - if all (== Nothing) $ map fst items' + if all (== "") $ map fst items' then (Implicit Unspecified [], Concat $ map snd items') else (Implicit Unspecified [], Pattern items') where diff --git a/src/Language/SystemVerilog/AST/Expr.hs b/src/Language/SystemVerilog/AST/Expr.hs index 25fb242..4f54a1f 100644 --- a/src/Language/SystemVerilog/AST/Expr.hs +++ b/src/Language/SystemVerilog/AST/Expr.hs @@ -54,7 +54,7 @@ data Expr | DimsFn DimsFn TypeOrExpr | DimFn DimFn TypeOrExpr Expr | Dot Expr Identifier - | Pattern [(Maybe Identifier, Expr)] + | Pattern [(Identifier, Expr)] | MinTypMax Expr Expr Expr | Nil deriving (Eq, Ord) @@ -82,9 +82,10 @@ instance Show Expr where 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) + showPatternItem :: (Identifier, Expr) -> String + showPatternItem ("" , e) = show e + showPatternItem (':' : n, e) = showPatternItem (n, e) + showPatternItem (n , e) = printf "%s: %s" n (show e) show (MinTypMax a b c) = printf "(%s : %s : %s)" (show a) (show b) (show c) data Args diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index b9d726e..44b7b61 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -1162,15 +1162,16 @@ Expr :: { Expr } | "~^" 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 } - | PatternUnnamedItems { zip (repeat Nothing) $1 } +PatternItems :: { [(Identifier, Expr)] } + : PatternNamedItems { $1 } + | PatternUnnamedItems { zip (repeat "") $1 } PatternNamedItems :: { [(Identifier, Expr)] } : PatternNamedItem { [$1] } | PatternNamedItems "," PatternNamedItem { $1 ++ [$3] } PatternNamedItem :: { (Identifier, Expr) } - : Identifier ":" Expr { ($1, $3) } - | "default" ":" Expr { (tokenString $1, $3) } + : Identifier ":" Expr { ($1 , $3) } + | PartialType ":" Expr { (':' : show $1 , $3) } + | "default" ":" Expr { (':' : "default", $3) } PatternUnnamedItems :: { [Expr] } : PatternUnnamedItem { [$1] } | PatternUnnamedItems "," PatternUnnamedItem { $1 ++ [$3] } diff --git a/test/basic/pattern.sv b/test/basic/pattern.sv new file mode 100644 index 0000000..770be35 --- /dev/null +++ b/test/basic/pattern.sv @@ -0,0 +1,40 @@ +module test; + typedef struct packed { + int w, x; + byte y; + logic z; + } struct_a; + struct_a a; + initial begin + $monitor("%2d: %b %b %b %b %b", $time, a, a.w, a.x, a.y, a.z); + + #1 a.w = 0; + #1 a.x = 0; + #1 a.y = 0; + #1 a.z = 0; + + #1 a = '{default: 1}; + #1 a = '{default: 2}; + #1 a = '{default: 3}; + #1 a = '{default: 0}; + #1 a = '{default: -1}; + #1 a = '{default: -2}; + + #1 a = '{int: 0, default: 1}; + #1 a = '{byte: 0, default: 1}; + #1 a = '{logic: 0, default: 1}; + #1 a = '{logic: 1, int: 2, byte: 3}; + #1 a = '{logic: 1, int: 2, byte: 3, default: -1}; + #1 a = '{int: 3, byte: 2, default: 0}; + + #1 a = '{w: 8, int: 0, default: 1}; + #1 a = '{w: 8, byte: 0, default: 1}; + #1 a = '{w: 8, logic: 0, default: 1}; + #1 a = '{w: 8, logic: 1, int: 2, byte: 3}; + #1 a = '{w: 8, logic: 1, int: 2, byte: 3, default: -1}; + #1 a = '{w: 8, int: 3, byte: 2, default: 0}; + + end +endmodule + +module top; endmodule diff --git a/test/basic/pattern.v b/test/basic/pattern.v new file mode 100644 index 0000000..d63f2cf --- /dev/null +++ b/test/basic/pattern.v @@ -0,0 +1,120 @@ +module test; + reg [31:0] a_w, a_x; + reg [7:0] a_y; + reg a_z; + reg [72:0] a; + always @* a = {a_w, a_x, a_y, a_z}; + initial begin + $monitor("%2d: %b %b %b %b %b", $time, a, a_w, a_x, a_y, a_z); + + #1 a_w = 0; + #1 a_x = 0; + #1 a_y = 0; + #1 a_z = 0; + + #1 begin + a_w = 1; + a_x = 1; + a_y = 1; + a_z = 1; + end + #1 begin + a_w = 2; + a_x = 2; + a_y = 2; + a_z = 2; + end + #1 begin + a_w = 3; + a_x = 3; + a_y = 3; + a_z = 3; + end + #1 begin + a_w = 0; + a_x = 0; + a_y = 0; + a_z = 0; + end + #1 begin + a_w = -1; + a_x = -1; + a_y = -1; + a_z = -1; + end + #1 begin + a_w = -2; + a_x = -2; + a_y = -2; + a_z = -2; + end + + #1 begin + a_w = 0; + a_x = 0; + a_y = 1; + a_z = 1; + end + #1 begin + a_w = 1; + a_x = 1; + a_y = 0; + a_z = 1; + end + #1 begin + a_w = 1; + a_x = 1; + a_y = 1; + a_z = 0; + end + #1 begin + a_w = 2; + a_x = 2; + a_y = 3; + a_z = 1; + end + #1; + #1 begin + a_w = 3; + a_x = 3; + a_y = 2; + a_z = 0; + end + + #1 begin + a_w = 8; + a_x = 0; + a_y = 1; + a_z = 1; + end + #1 begin + a_w = 8; + a_x = 1; + a_y = 0; + a_z = 1; + end + #1 begin + a_w = 8; + a_x = 1; + a_y = 1; + a_z = 0; + end + #1 begin + a_w = 8; + a_x = 2; + a_y = 3; + a_z = 1; + end + #1; + #1 begin + a_w = 8; + a_x = 3; + a_y = 2; + a_z = 0; + end + + + end +endmodule + +module top; endmodule