revised struct pattern representation

- pattern keys now represented as TypeOrExpr
- support for simple integer struct pattern keys

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

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)
-
-        items = zip fieldNames $ map resolveField fieldNames
+        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
+            (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

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

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

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{})) =

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

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 ""

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] }

test/basic/pattern_revised.sv

+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

test/basic/pattern_revised.v

+`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"

test/error/struct_invalid_key.sv

+// pattern: invalid pattern key -1 is not a type, field name, or index
+module top;
+    struct packed {
+        logic x;
+    } s = '{ -1: 1 };
+endmodule

test/error/struct_non_integer.sv

+// pattern: pattern index 1'bx is not an integer
+module top;
+    struct packed {
+        logic x;
+    } s = '{ 1'bx: 1 };
+endmodule

test/error/struct_out_of_bounds.sv

+// pattern: pattern index 1 is out of bounds for struct packed \{..logic x;.\}
+module top;
+    struct packed {
+        logic x;
+    } s = '{ 1: 1 };
+endmodule