From dbbf71c65ad25bbf319955879922b9b6fa2c1a78 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Sun, 20 Jun 2021 15:30:21 -0400 Subject: [PATCH] revised struct pattern representation - pattern keys now represented as TypeOrExpr - support for simple integer struct pattern keys --- src/Convert/IntTypes.hs | 23 ++++-- src/Convert/Struct.hs | 86 ++++++++++++++++------- src/Convert/Traverse.hs | 6 +- src/Convert/Typedef.hs | 4 ++ src/Convert/UnbasedUnsized.hs | 7 +- src/Language/SystemVerilog/AST.hs | 2 +- src/Language/SystemVerilog/AST/Expr.hs | 11 +-- src/Language/SystemVerilog/Parser/Parse.y | 16 +++-- test/basic/pattern_revised.sv | 31 ++++++++ test/basic/pattern_revised.v | 10 +++ test/error/struct_invalid_key.sv | 6 ++ test/error/struct_non_integer.sv | 6 ++ test/error/struct_out_of_bounds.sv | 6 ++ 13 files changed, 166 insertions(+), 48 deletions(-) create mode 100644 test/basic/pattern_revised.sv create mode 100644 test/basic/pattern_revised.v create mode 100644 test/error/struct_invalid_key.sv create mode 100644 test/error/struct_non_integer.sv create mode 100644 test/error/struct_out_of_bounds.sv diff --git a/src/Convert/IntTypes.hs b/src/Convert/IntTypes.hs index 60d2cb8..06bf33d 100644 --- a/src/Convert/IntTypes.hs +++ b/src/Convert/IntTypes.hs @@ -10,11 +10,12 @@ import Convert.Traverse import Language.SystemVerilog.AST convert :: [AST] -> [AST] -convert = - map $ - traverseDescriptions $ - traverseModuleItems $ - traverseTypes $ traverseNestedTypes convertType +convert = map $ traverseDescriptions $ traverseModuleItems convertModuleItem + +convertModuleItem :: ModuleItem -> ModuleItem +convertModuleItem = + traverseTypes (traverseNestedTypes convertType) . + traverseExprs (traverseNestedExprs convertExpr) convertType :: Type -> Type convertType (Struct pk fields rs) = @@ -34,3 +35,15 @@ convertStructFields fields = convertStructFieldType :: Type -> Type convertStructFieldType (IntegerAtom TInteger sg) = IntegerAtom TInt sg convertStructFieldType t = t + +convertExpr :: Expr -> Expr +convertExpr (Pattern items) = + Pattern $ zip names exprs + where + names = map (convertPatternTypeOrExpr . fst) items + exprs = map snd items +convertExpr other = other + +convertPatternTypeOrExpr :: TypeOrExpr -> TypeOrExpr +convertPatternTypeOrExpr (Left t) = Left $ convertStructFieldType t +convertPatternTypeOrExpr (Right e) = Right e diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index 806fd76..d5c7945 100644 --- a/src/Convert/Struct.hs +++ b/src/Convert/Struct.hs @@ -8,7 +8,9 @@ module Convert.Struct (convert) where import Control.Monad ((>=>), when) -import Data.List (partition) +import Data.Either (isLeft) +import Data.List (elemIndex, find, partition) +import Data.Maybe (fromJust) import Data.Tuple (swap) import qualified Data.Map.Strict as Map import qualified Data.Set as Set @@ -183,11 +185,6 @@ traverseAsgnM (lhs, expr) = do (_, expr') <- embedScopes convertSubExpr $ convertExpr typ expr return (lhs', expr') -specialTag :: Char -specialTag = ':' -defaultKey :: String -defaultKey = specialTag : "default" - structIsntReady :: Type -> Bool structIsntReady = (Nothing ==) . convertStruct @@ -217,7 +214,7 @@ convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) = itemsNamed = -- patterns either use positions based or name/type/default - if all ((/= "") . fst) itemsOrig then + if all ((/= Right Nil) . fst) itemsOrig then itemsOrig -- position-based patterns should cover every field else if length itemsOrig /= length fields then @@ -226,44 +223,81 @@ convertExpr (struct @ (Struct _ fields [])) (Pattern itemsOrig) = -- if the pattern does not use identifiers, use the -- identifiers from the struct type definition in order else - zip fieldNames (map snd itemsOrig) - (specialItems, namedItems) = - partition ((== specialTag) . head . fst) itemsNamed + zip (map (Right . Ident) fieldNames) (map snd itemsOrig) + (typedItems, untypedItems) = + partition (isLeft . fst) itemsNamed + (numberedItems, namedItems) = + partition (isNumbered . fst) untypedItems namedItemMap = Map.fromList namedItems - specialItemMap = Map.fromList specialItems + typedItemMap = Map.fromList typedItems + + isNumbered :: TypeOrExpr -> Bool + isNumbered (Right (Number n)) = + if maybeIndex == Nothing + then error msgNonInteger + else index < length fieldNames || error msgOutOfBounds + where + maybeIndex = fmap fromIntegral $ numberToInteger n + Just index = maybeIndex + msgNonInteger = "pattern index " ++ show (Number n) + ++ " is not an integer" + msgOutOfBounds = "pattern index " ++ show index + ++ " is out of bounds for " ++ show struct + isNumbered _ = False extraNames = Set.difference - (Set.fromList $ map fst namedItems) + (Set.fromList $ map (getName . right . fst) namedItems) (Map.keysSet fieldTypeMap) + right = \(Right x) -> x + getName :: Expr -> Identifier + getName (Ident x) = x + getName e = error $ "invalid pattern key " ++ show e + ++ " is not a type, field name, or index" - items = zip fieldNames $ map resolveField fieldNames + items = zip + (map (Right . Ident) fieldNames) + (map resolveField fieldNames) resolveField :: Identifier -> Expr resolveField fieldName = convertExpr fieldType $ -- look up by name - if Map.member fieldName namedItemMap then - namedItemMap Map.! fieldName + if valueByName /= Nothing then + fromJust valueByName -- recurse for substructures else if isStruct fieldType then - Pattern specialItems + Pattern typedItems -- look up by field type - else if Map.member fieldTypeName specialItemMap then - specialItemMap Map.! fieldTypeName + else if valueByType /= Nothing then + fromJust valueByType -- fall back on the default value - else if Map.member defaultKey specialItemMap then - specialItemMap Map.! defaultKey + else if valueDefault /= Nothing then + fromJust valueDefault + else if valueByIndex /= Nothing then + fromJust valueByIndex else error $ "couldn't find field '" ++ fieldName ++ "' from struct definition " ++ show struct ++ " in struct pattern " ++ show (Pattern itemsOrig) where + valueByName = Map.lookup (Right $ Ident fieldName) namedItemMap + valueByType = Map.lookup (Left fieldType) typedItemMap + valueDefault = Map.lookup (Left UnknownType) typedItemMap + valueByIndex = fmap snd $ find (indexCheck . fst) numberedItems + fieldType = fieldTypeMap Map.! fieldName - fieldTypeName = - specialTag : (show $ fst $ typeRanges fieldType) + Just fieldIndex = elemIndex fieldName fieldNames + isStruct :: Type -> Bool - isStruct (Struct{}) = True + isStruct Struct{} = True isStruct _ = False + indexCheck :: TypeOrExpr -> Bool + indexCheck item = + fromIntegral value == fieldIndex + where + Just value = numberToInteger n + Right (Number n) = item + convertExpr (Implicit _ []) expr = expr convertExpr (Implicit sg rs) expr = convertExpr (IntegerVector TBit sg rs) expr @@ -285,7 +319,7 @@ convertExpr (t @ IntegerVector{}) (Concat exprs) = -- TODO: This is really a conversion for using default patterns to -- populate arrays. Maybe this should be somewhere else? -convertExpr t (orig @ (Pattern [(":default", expr)])) = +convertExpr t (orig @ (Pattern [(Left UnknownType, expr)])) = if null rs then orig else Repeat count [expr'] @@ -297,7 +331,7 @@ convertExpr t (orig @ (Pattern [(":default", expr)])) = -- pattern syntax used for simple array literals convertExpr t (Pattern items) = - if all null names + if all (== Right Nil) names then convertExpr t $ Concat exprs' else Pattern items where @@ -432,7 +466,7 @@ convertSubExpr scopes (Cast (Left t) e) = (t, Cast (Left t) e') where (_, e') = convertSubExpr scopes e convertSubExpr scopes (Pattern items) = - if all (== "") $ map fst items' + if all (== Right Nil) $ map fst items' then (UnknownType, Concat $ map snd items') else (UnknownType, Pattern items') where diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 3edc5ed..667bd15 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -483,7 +483,7 @@ traverseSinglyNestedExprsM exprMapper = em em (Dot e x) = exprMapper e >>= \e' -> return $ Dot e' x em (Pattern l) = do - let names = map fst l + names <- mapM typeOrExprMapper $ map fst l exprs <- mapM exprMapper $ map snd l return $ Pattern $ zip names exprs em (Inside e l) = do @@ -865,6 +865,10 @@ traverseExprTypesM mapper = exprMapper exprMapper (DimFn f tore e) = do tore' <- typeOrExprMapper tore return $ DimFn f tore' e + exprMapper (Pattern l) = do + names <- mapM typeOrExprMapper $ map fst l + let exprs = map snd l + return $ Pattern $ zip names exprs exprMapper other = return other traverseExprTypes :: Mapper Type -> Mapper Expr diff --git a/src/Convert/Typedef.hs b/src/Convert/Typedef.hs index ecc8d07..c1ce1c7 100644 --- a/src/Convert/Typedef.hs +++ b/src/Convert/Typedef.hs @@ -44,6 +44,10 @@ traverseExprM (DimsFn f v) = do traverseExprM (DimFn f v e) = do v' <- traverseTypeOrExprM v traverseExprM' $ DimFn f v' e +traverseExprM (Pattern items) = do + names <- mapM traverseTypeOrExprM $ map fst items + let exprs = map snd items + traverseExprM' $ Pattern $ zip names exprs traverseExprM other = traverseExprM' other traverseExprM' :: Expr -> Scoper Type Expr diff --git a/src/Convert/UnbasedUnsized.hs b/src/Convert/UnbasedUnsized.hs index b38e44e..13e74c2 100644 --- a/src/Convert/UnbasedUnsized.hs +++ b/src/Convert/UnbasedUnsized.hs @@ -115,7 +115,7 @@ substituteExpr mapping (Dot (Ident x) y) = case lookup x mapping of Nothing -> Dot (Ident x) y Just (Pattern items) -> - case lookup y items of + case lookup (Right $ Ident y) items of Just item -> substituteExpr mapping item Nothing -> Dot (substituteExpr mapping (Pattern items)) y Just expr -> Dot (substituteExpr mapping expr) y @@ -192,7 +192,7 @@ convertExpr _ (Cast te e) = Cast te $ convertExpr SelfDetermined e convertExpr _ (Concat exprs) = Concat $ map (convertExpr SelfDetermined) exprs -convertExpr context (Pattern [(":default", e @ UU{})]) = +convertExpr context (Pattern [(Left UnknownType, e @ UU{})]) = convertExpr context e convertExpr _ (Pattern items) = Pattern $ zip @@ -202,7 +202,8 @@ convertExpr _ (Call expr (Args pnArgs kwArgs)) = Call expr $ Args pnArgs' kwArgs' where pnArgs' = map (convertExpr SelfDetermined) pnArgs - Pattern kwArgs' = convertExpr SelfDetermined $ Pattern kwArgs + kwArgs' = zip (map fst kwArgs) $ + map (convertExpr SelfDetermined) $ map snd kwArgs convertExpr _ (Repeat count exprs) = Repeat count $ map (convertExpr SelfDetermined) exprs convertExpr SelfDetermined (Mux cond (e1 @ UU{}) (e2 @ UU{})) = diff --git a/src/Language/SystemVerilog/AST.hs b/src/Language/SystemVerilog/AST.hs index 14dc2bb..37cbfaa 100644 --- a/src/Language/SystemVerilog/AST.hs +++ b/src/Language/SystemVerilog/AST.hs @@ -64,7 +64,7 @@ exprToLHS (Concat ls ) = do Just $ LHSConcat ls' exprToLHS (Pattern ls ) = do ls' <- mapM exprToLHS $ map snd ls - if all (null . fst) ls + if all ((== Right Nil) . fst) ls then Just $ LHSConcat ls' else Nothing exprToLHS (Stream o e ls) = do diff --git a/src/Language/SystemVerilog/AST/Expr.hs b/src/Language/SystemVerilog/AST/Expr.hs index 5163fdf..83029ca 100644 --- a/src/Language/SystemVerilog/AST/Expr.hs +++ b/src/Language/SystemVerilog/AST/Expr.hs @@ -57,7 +57,7 @@ data Expr | DimsFn DimsFn TypeOrExpr | DimFn DimFn TypeOrExpr Expr | Dot Expr Identifier - | Pattern [(Identifier, Expr)] + | Pattern [(TypeOrExpr, Expr)] | Inside Expr [Expr] | MinTypMax Expr Expr Expr | Nil @@ -84,10 +84,11 @@ instance Show Expr where show (Pattern l ) = printf "'{\n%s\n}" (indent $ intercalate ",\n" $ map showPatternItem l) where - showPatternItem :: (Identifier, Expr) -> String - showPatternItem ("" , e) = show e - showPatternItem (':' : n, e) = showPatternItem (n, e) - showPatternItem (n , e) = printf "%s: %s" n (show e) + showPatternItem :: (TypeOrExpr, Expr) -> String + showPatternItem (Right Nil, v) = show v + showPatternItem (Right e, v) = printf "%s: %s" (show e) (show v) + showPatternItem (Left t, v) = printf "%s: %s" tStr (show v) + where tStr = if null (show t) then "default" else show t show (MinTypMax a b c) = printf "(%s : %s : %s)" (show a) (show b) (show c) show (e @ UniOp{}) = showsPrec 0 e "" show (e @ BinOp{}) = showsPrec 0 e "" diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index c69da5a..f508790 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -1282,16 +1282,18 @@ ExprOrNil :: { Expr } : Expr { $1 } | {- empty -} { Nil } -PatternItems :: { [(Identifier, Expr)] } +PatternItems :: { [(TypeOrExpr, Expr)] } : PatternNamedItems { $1 } - | PatternUnnamedItems { zip (repeat "") $1 } -PatternNamedItems :: { [(Identifier, Expr)] } + | PatternUnnamedItems { zip (repeat $ Right Nil) $1 } +PatternNamedItems :: { [(TypeOrExpr, Expr)] } : PatternNamedItem { [$1] } | PatternNamedItems "," PatternNamedItem { $1 ++ [$3] } -PatternNamedItem :: { (Identifier, Expr) } - : Identifier ":" Expr { ($1 , $3) } - | PartialType ":" Expr { (':' : show $1 , $3) } - | "default" ":" Expr { (':' : "default", $3) } +PatternNamedItem :: { (TypeOrExpr, Expr) } + : PatternName ":" Expr { ($1, $3) } +PatternName :: { TypeOrExpr } + : Expr { Right $1 } + | PartialType { Left $ $1 Unspecified [] } + | "default" { Left UnknownType } PatternUnnamedItems :: { [Expr] } : PatternUnnamedItem { [$1] } | PatternUnnamedItems "," PatternUnnamedItem { $1 ++ [$3] } diff --git a/test/basic/pattern_revised.sv b/test/basic/pattern_revised.sv new file mode 100644 index 0000000..f6349a4 --- /dev/null +++ b/test/basic/pattern_revised.sv @@ -0,0 +1,31 @@ +module top; + parameter PARAM = 1; + +`define BASE(expr, full, x, y, z) \ + $display(`"%b %0d %0d %0d expr`", \ + full, x, y, z) + +`ifndef TEST + typedef byte T; + typedef struct packed { + byte x; + T y; + integer z; + } S; + +`define TEST(a, b, c, expr) \ + if (PARAM) begin \ + S s; \ + assign s = expr; \ + initial `BASE(expr, s, s.x, s.y, s.z); \ + end +`endif + + `TEST(1, 2, 3, '{ x: 1, y: 2, z: 3 }) + `TEST(2, 2, 3, '{ byte: 2, integer: 3 }) + `TEST(3, 3, 2, '{ integer: 2, byte: 3 }) + `TEST(4, 4, 2, '{ integer: 2, T: 4 }) + `TEST(5, 5, 2, '{ integer: 2, T: 4, byte: 5 }) + `TEST(5, 5, 2, '{ 2: 2, byte: 5 }) + `TEST(7, 8, 9, '{ 1: 8, 2: 9, 0: 7 }) +endmodule diff --git a/test/basic/pattern_revised.v b/test/basic/pattern_revised.v new file mode 100644 index 0000000..8942a14 --- /dev/null +++ b/test/basic/pattern_revised.v @@ -0,0 +1,10 @@ +`define TEST(aVal, bVal, cVal, expr) \ + if (PARAM) begin \ + wire [7:0] a, b; \ + wire [31:0] c; \ + assign a = aVal; \ + assign b = bVal; \ + assign c = cVal; \ + initial `BASE(expr, {a, b, c}, a, b, c); \ + end +`include "pattern_revised.sv" diff --git a/test/error/struct_invalid_key.sv b/test/error/struct_invalid_key.sv new file mode 100644 index 0000000..dc0a7e7 --- /dev/null +++ b/test/error/struct_invalid_key.sv @@ -0,0 +1,6 @@ +// pattern: invalid pattern key -1 is not a type, field name, or index +module top; + struct packed { + logic x; + } s = '{ -1: 1 }; +endmodule diff --git a/test/error/struct_non_integer.sv b/test/error/struct_non_integer.sv new file mode 100644 index 0000000..0ee70e6 --- /dev/null +++ b/test/error/struct_non_integer.sv @@ -0,0 +1,6 @@ +// pattern: pattern index 1'bx is not an integer +module top; + struct packed { + logic x; + } s = '{ 1'bx: 1 }; +endmodule diff --git a/test/error/struct_out_of_bounds.sv b/test/error/struct_out_of_bounds.sv new file mode 100644 index 0000000..453efef --- /dev/null +++ b/test/error/struct_out_of_bounds.sv @@ -0,0 +1,6 @@ +// pattern: pattern index 1 is out of bounds for struct packed \{..logic x;.\} +module top; + struct packed { + logic x; + } s = '{ 1: 1 }; +endmodule