preliminary support for structs

src/Convert/Traverse.hs

@@ -186,6 +186,12 @@ traverseNestedExprsM mapper = exprMapper
             exprMapper e >>= \e' -> return $ Bit e' n
         em (Cast       t e) =
             exprMapper e >>= return . Cast t
+        em (StructAccess e x) =
+            exprMapper e >>= \e' -> return $ StructAccess e' x
+        em (StructPattern l) = do
+            let names = map fst l
+            exprs <- mapM exprMapper $ map snd l
+            return $ StructPattern $ zip names exprs
 
 
 traverseExprsM :: Monad m => MapperM m Expr -> MapperM m ModuleItem

src/Convert/Typedef.hs

@@ -42,12 +42,17 @@ resolveType _ (Implicit rs) = Implicit rs
 resolveType _ (IntegerT   ) = IntegerT
 resolveType _ (Enum Nothing vals rs) = Enum Nothing vals 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 (Alias st rs1) =
     case resolveType types $ types Map.! st of
         (Reg      rs2) -> Reg      $ rs2 ++ rs1
         (Wire     rs2) -> Wire     $ rs2 ++ rs1
         (Logic    rs2) -> Logic    $ rs2 ++ rs1
         (Enum t v rs2) -> Enum t v $ rs2 ++ rs1
+        (Struct p l rs2) -> Struct p l $ rs2 ++ rs1
         (Implicit rs2) -> Implicit $ rs2 ++ rs1
         (IntegerT    ) -> error $ "resolveType encountered packed `integer` on " ++ st
         (Alias    _ _) -> error $ "resolveType invariant failed on " ++ st

src/Language/SystemVerilog/AST.hs

@@ -79,6 +79,7 @@ data Type
   | Implicit         [Range]
   | IntegerT
   | Enum (Maybe Type) [(Identifier, Maybe Expr)] [Range]
+  | Struct Bool [(Type, Identifier)] [Range]
   deriving (Eq, Ord)
 
 instance Show Type where
@@ -93,6 +94,11 @@ 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" packedStr itemsStr (showRanges r)
+    where
+      packedStr = if p then "packed " else ""
+      itemsStr = indent $ unlines' $ map showItem items
+      showItem (t, x) = printf "%s %s;" (show t) x
 
 typeRanges :: Type -> ([Range] -> Type, [Range])
 typeRanges (Reg      r) = (Reg     , r)
@@ -102,6 +108,7 @@ typeRanges (Alias  t r) = (Alias  t, r)
 typeRanges (Implicit r) = (Implicit, r)
 typeRanges (IntegerT  ) = (error "ranges cannot be applied to IntegerT", [])
 typeRanges (Enum t v r) = (Enum t v, r)
+typeRanges (Struct p l r) = (Struct p l, r)
 
 data Decl
   = Parameter            Type Identifier Expr
@@ -212,6 +219,8 @@ data Expr
   | Mux        Expr Expr Expr
   | Bit        Expr Int
   | Cast       Type Expr
+  | StructAccess Expr Identifier
+  | StructPattern [(Maybe Identifier, Expr)]
   deriving (Eq, Ord)
 
 data UniOp
@@ -301,6 +310,14 @@ instance Show Expr where
     Mux        a b c    -> printf "(%s ? %s : %s)" (show a) (show b) (show c)
     Bit        a b      -> printf "(%s [%d])" (show a) b
     Cast       a b      -> printf "%s'(%s)" (show a) (show b)
+    StructAccess e n    -> printf "%s.%s" (show e) n
+    StructPattern 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 LHS
   = LHS       Identifier
@@ -354,7 +371,7 @@ instance Show Stmt where
     where
     defStr = case def of
       Nothing -> ""
-      Just c -> printf "\n\tdefault:\n%s" (indent $ indent $ show c)
+      Just c -> printf "\n\tdefault: %s" (show c)
   show (For (a,b) c (d,e) f) = printf "for (%s = %s; %s; %s = %s)\n%s" a (show b) (show c) d (show e) $ indent $ show f
   show (AsgnBlk v e) = printf "%s = %s;"  (show v) (show e)
   show (Asgn    v e) = printf "%s <= %s;" (show v) (show e)

src/Language/SystemVerilog/Parser/Lex.x

@@ -84,9 +84,11 @@ tokens :-
   "negedge"          { tok KW_negedge    }
   "or"               { tok KW_or         }
   "output"           { tok KW_output     }
+  "packed"           { tok KW_packed     }
   "parameter"        { tok KW_parameter  }
   "posedge"          { tok KW_posedge    }
   "reg"              { tok KW_reg        }
+  "struct"           { tok KW_struct     }
   "typedef"          { tok KW_typedef    }
   "unique"           { tok KW_unique     }
   "wire"             { tok KW_wire       }

src/Language/SystemVerilog/Parser/Parse.y

@@ -48,9 +48,11 @@ import Language.SystemVerilog.Parser.Tokens
 "negedge"          { Token KW_negedge    _ _ }
 "or"               { Token KW_or         _ _ }
 "output"           { Token KW_output     _ _ }
+"packed"           { Token KW_packed     _ _ }
 "parameter"        { Token KW_parameter  _ _ }
 "posedge"          { Token KW_posedge    _ _ }
 "reg"              { Token KW_reg        _ _ }
+"struct"           { Token KW_struct     _ _ }
 "typedef"          { Token KW_typedef    _ _ }
 "unique"           { Token KW_unique     _ _ }
 "wire"             { Token KW_wire       _ _ }
@@ -159,6 +161,7 @@ string             { Token Lit_string    _ _ }
 %left  "+" "-"
 %left  "*" "/" "%"
 %left  UPlus UMinus "!" "~" RedOps
+%left  "."
 
 
 %%
@@ -182,11 +185,25 @@ TypeNonAlias :: { Type }
   : "wire"  Dimensions { Wire  $2 }
   | "reg"   Dimensions { Reg   $2 }
   | "logic" Dimensions { Logic $2 }
-  | "enum" opt(Type) "{" VariablePortIdentifiers "}" Dimensions { Enum $2 $4 $6 }
+  | "enum"   opt(Type) "{" EnumItems   "}" Dimensions { Enum   $2 $4 $6 }
+  | "struct" Packed    "{" StructItems "}" Dimensions { Struct $2 $4 $6 }
 Type :: { Type }
   : TypeNonAlias          { $1 }
   | Identifier Dimensions { Alias $1 $2 }
 
+EnumItems :: { [(Identifier, Maybe Expr)] }
+  : VariablePortIdentifiers { $1 }
+
+StructItems :: { [(Type, Identifier)] }
+  : StructItem             { [$1] }
+  | StructItems StructItem { $1 ++ [$2] }
+StructItem :: { (Type, Identifier) }
+  : Type Identifier ";" { ($1, $2) }
+
+Packed :: { Bool }
+  : "packed"    { True }
+  | {- empty -} { False }
+
 Module :: { Description }
   : "module" Identifier Params           ";" ModuleItems "endmodule" { Module $2 [] ($3 ++ $5) }
   | "module" Identifier Params PortNames ";" ModuleItems "endmodule" { Module $2 $4 ($3 ++ $6) }
@@ -220,18 +237,9 @@ PortDeclsFollow :: { [ModuleItem] }
   : ")"                           { [] }
   | PortDecl(")")                 { $1 }
   | PortDecl(",") PortDeclsFollow { $1 ++ $2 }
-
 PortDecl(delim) :: { [ModuleItem] }
-  : "inout"  NetType Dimensions Identifiers             delim { portDeclToModuleItems Inout  ($2       $3) (zip $4 (repeat Nothing)) }
-  | "input"  NetType Dimensions Identifiers             delim { portDeclToModuleItems Input  ($2       $3) (zip $4 (repeat Nothing)) }
-  | "output"         Dimensions Identifiers             delim { portDeclToModuleItems Output (Implicit $2) (zip $3 (repeat Nothing)) }
-  | "output" "wire"  Dimensions Identifiers             delim { portDeclToModuleItems Output (Wire     $3) (zip $4 (repeat Nothing)) }
-  | "output" "reg"   Dimensions VariablePortIdentifiers delim { portDeclToModuleItems Output (Reg      $3) $4 }
-  | "output" "logic" Dimensions VariablePortIdentifiers delim { portDeclToModuleItems Output (Logic    $3) $4 }
-NetType :: { [Range] -> Type }
-  : "wire"      { Wire }
-  | "logic"     { Logic }
-  | {- empty -} { Implicit }
+  : Direction TypedVariablePortIdentifiers(delim) { portDeclToModuleItems $1 $2 }
+
 VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] }
   : VariablePortIdentifier                             { [$1] }
   | VariablePortIdentifiers "," VariablePortIdentifier { $1 ++ [$3] }
@@ -239,6 +247,18 @@ VariablePortIdentifier :: { (Identifier, Maybe Expr) }
   : Identifier          { ($1, Nothing) }
   | Identifier "=" Expr { ($1, Just $3) }
 
+-- Note that this allows for things like `input reg` which are not valid.
+TypedVariablePortIdentifiers(delim) :: { (Type, [PortBinding]) }
+  : TypeNonAlias                  VariablePortIdentifiers delim { ($1,    $2) }
+  | Identifier DimensionsNonEmpty VariablePortIdentifiers delim { (Alias $1 $2, $3) }
+  | Identifier                    VariablePortIdentifiers delim { (Alias $1 [], $2) }
+  |            DimensionsNonEmpty VariablePortIdentifiers delim { (Implicit $1, $2) }
+  |                               VariablePortIdentifiers delim { (Implicit [], $1) }
+Direction :: { Direction }
+  : "inout"  { Inout  }
+  | "input"  { Input  }
+  | "output" { Output }
+
 ModuleItems :: { [ModuleItem] }
   : {- empty -}            { [] }
   | ModuleItems ModuleItem { $1 ++ $2 }
@@ -464,6 +484,19 @@ Expr :: { Expr }
 | "~^" Expr %prec RedOps      { UniOp RedXnor $2 }
 | "^~" Expr %prec RedOps      { UniOp RedXnor $2 }
 | Type "'" "(" Expr ")"       { Cast $1 $4 }
+| Expr "." Identifier         { StructAccess $1 $3 }
+| "'" "{" PatternItems "}"    { StructPattern $3 }
+
+PatternItems :: { [(Maybe Identifier, Expr)] }
+  : PatternNamedItems   { map (\(x,e) -> (Just x, e)) $1 }
+  | PatternUnnamedItems { zip (repeat Nothing) $1 }
+PatternNamedItems :: { [(Identifier, Expr)] }
+  : PatternNamedItem                       { [$1] }
+  | PatternNamedItems "," PatternNamedItem { $1 ++ [$3] }
+PatternNamedItem :: { (Identifier, Expr) }
+  : Identifier ":" Expr { ($1, $3) }
+PatternUnnamedItems :: { [Expr] }
+  : Exprs { $1 }
 
 GenItemOrNull :: { GenItem }
   : GenItem { $1 }
@@ -500,8 +533,8 @@ parseError a = case a of
   []              -> error "Parse error: no tokens left to parse."
   Token t s p : _ -> error $ "Parse error: unexpected token '" ++ s ++ "' (" ++ show t ++ ") at " ++ show p ++ "."
 
-portDeclToModuleItems :: Direction -> Type -> [PortBinding] -> [ModuleItem]
-portDeclToModuleItems dir t l =
+portDeclToModuleItems :: Direction -> (Type, [PortBinding]) -> [ModuleItem]
+portDeclToModuleItems dir (t, l) =
   map (\(x, me) -> MIDecl $ Variable dir t x [] me) l
 
 getPortNames :: [ModuleItem] -> [Identifier]