surprisingly non-disgusting addition of attribute instances to module items and statements

src/Convert/Traverse.hs

@@ -135,6 +135,7 @@ traverseNestedStmtsM :: Monad m => MapperM m Stmt -> MapperM m Stmt
 traverseNestedStmtsM mapper = fullMapper
     where
         fullMapper stmt = mapper stmt >>= cs
+        cs (StmtAttr a stmt) = fullMapper stmt >>= return . StmtAttr a
         cs (Block name decls stmts) =
             mapM fullMapper stmts >>= return . Block name decls
         cs (Case u kw expr cases def) = do
@@ -263,6 +264,9 @@ traverseExprsM mapper = moduleItemMapper
         exprs' <- mapM exprMapper exprs
         return (exprs', stmt)
     stmtMapper = traverseNestedStmtsM flatStmtMapper
+    flatStmtMapper (StmtAttr attr stmt) =
+        -- note: we exclude expressions in attributes from conversion
+        return $ StmtAttr attr stmt
     flatStmtMapper (Block name decls stmts) = do
         decls' <- mapM declMapper decls
         return $ Block name decls' stmts
@@ -299,6 +303,9 @@ traverseExprsM mapper = moduleItemMapper
     portBindingMapper (p, me) =
         maybeExprMapper me >>= \me' -> return (p, me')
 
+    moduleItemMapper (MIAttr attr mi) =
+        -- note: we exclude expressions in attributes from conversion
+        return $ MIAttr attr mi
     moduleItemMapper (MIDecl decl) =
         declMapper decl >>= return . MIDecl
     moduleItemMapper (Defparam lhs expr) =

src/Language/SystemVerilog/AST.hs

@@ -31,6 +31,7 @@ module Language.SystemVerilog.AST
     , GenCase
     , simplify
     , rangeSize
+    , module Attr
     , module Decl
     , module Expr
     , module LHS
@@ -44,6 +45,7 @@ import Data.Maybe (maybe, fromJust, isJust)
 import Text.Printf (printf)
 import Text.Read (readMaybe)
 
+import Language.SystemVerilog.AST.Attr as Attr
 import Language.SystemVerilog.AST.Decl as Decl
 import Language.SystemVerilog.AST.Expr as Expr
 import Language.SystemVerilog.AST.LHS as LHS
@@ -109,7 +111,8 @@ instance Show PartKW where
   show Interface = "interface"
 
 data ModuleItem
-  = MIDecl     Decl
+  = MIAttr     Attr ModuleItem
+  | MIDecl     Decl
   | AlwaysC    AlwaysKW Stmt
   | Assign     (Maybe Expr) LHS Expr
   | Defparam   LHS Expr
@@ -141,6 +144,7 @@ type ModportDecl = (Direction, Identifier, Maybe Expr)
 
 instance Show ModuleItem where
   show thing = case thing of
+    MIAttr attr mi -> printf "%s %s" (show attr) (show mi)
     MIDecl     nest  -> show nest
     AlwaysC    k b   -> printf "%s %s" (show k) (show b)
     Assign     d a b -> printf "assign %s%s = %s;" delayStr (show a) (show b)

src/Language/SystemVerilog/AST/Attr.hs

@@ -0,0 +1,29 @@
+{- sv2v
+ - Author: Zachary Snow <zach@zachjs.com>
+ - Initial Verilog AST Author: Tom Hawkins <tomahawkins@gmail.com>
+ -
+ - SystemVerilog attribute instances
+ -}
+
+module Language.SystemVerilog.AST.Attr
+    ( Attr (..)
+    , AttrSpec
+    ) where
+
+import Text.Printf (printf)
+
+import Language.SystemVerilog.AST.ShowHelp (commas)
+import Language.SystemVerilog.AST.Expr (Expr, showAssignment)
+import Language.SystemVerilog.AST.Type (Identifier)
+
+data Attr
+    = Attr [AttrSpec]
+    deriving Eq
+
+type AttrSpec = (Identifier, Maybe Expr)
+
+instance Show Attr where
+    show (Attr specs) = printf "(* %s *)" $ commas $ map showSpec specs
+
+showSpec :: AttrSpec -> String
+showSpec (x, me) = x ++ showAssignment me

src/Language/SystemVerilog/AST/Stmt.hs

@@ -16,6 +16,7 @@ module Language.SystemVerilog.AST.Stmt
 import Text.Printf (printf)
 
 import Language.SystemVerilog.AST.ShowHelp (commas, indent, unlines', showPad, showCase)
+import Language.SystemVerilog.AST.Attr (Attr)
 import Language.SystemVerilog.AST.Decl (Decl)
 import Language.SystemVerilog.AST.Expr (Expr)
 import Language.SystemVerilog.AST.LHS (LHS)
@@ -23,7 +24,8 @@ import Language.SystemVerilog.AST.Op (AsgnOp)
 import Language.SystemVerilog.AST.Type (Identifier)
 
 data Stmt
-    = Block   (Maybe Identifier) [Decl] [Stmt]
+    = StmtAttr Attr Stmt
+    | Block   (Maybe Identifier) [Decl] [Stmt]
     | Case    Bool CaseKW Expr [Case] (Maybe Stmt)
     | For     (Identifier, Expr) Expr (Identifier, Expr) Stmt
     | AsgnBlk AsgnOp LHS Expr
@@ -41,6 +43,7 @@ data Stmt
     deriving Eq
 
 instance Show Stmt where
+    show (StmtAttr attr stmt) = printf "%s\n%s" (show attr) (show stmt)
     show (Block name decls stmts) =
         printf "begin%s\n%s\nend" header body
         where

src/Language/SystemVerilog/Parser/Parse.y

@@ -405,6 +405,16 @@ ModuleItem :: { [ModuleItem] }
   | PackageItem                          { [MIPackageItem $1] }
   | NInputGateKW  NInputGates  ";"       { map (\(a, b, c) -> NInputGate  $1 a b c) $2 }
   | NOutputGateKW NOutputGates ";"       { map (\(a, b, c) -> NOutputGate $1 a b c) $2 }
+  | AttributeInstance ModuleItem         { map (MIAttr $1) $2 }
+
+AttributeInstance :: { Attr }
+  : "(*" AttrSpecs "*)" { Attr $2 }
+AttrSpecs :: { [AttrSpec] }
+  : AttrSpec               { [$1] }
+  | AttrSpecs "," AttrSpec { $1 ++ [$3] }
+AttrSpec :: { AttrSpec }
+  : Identifier "=" Expr { ($1, Just $3) }
+  | Identifier          { ($1, Nothing) }
 
 NInputGates :: { [(Maybe Identifier, LHS, [Expr])] }
   : NInputGate                 { [$1] }
@@ -542,6 +552,7 @@ StmtNonAsgn :: { Stmt }
   | "do"      Stmt "while" "(" Expr ")" ";"    { DoWhile $5 $2 }
   | "forever" Stmt                             { Forever $2 }
   | "->" Identifier ";"                        { Trigger $2 }
+  | AttributeInstance Stmt                     { StmtAttr $1 $2 }
 
 DeclsAndStmts :: { ([Decl], [Stmt]) }
   : DeclOrStmt DeclsAndStmts { combineDeclsAndStmts $1 $2 }

sv2v.cabal

@@ -33,6 +33,7 @@ executable sv2v
     -- SystemVerilog modules
     Language.SystemVerilog
     Language.SystemVerilog.AST
+    Language.SystemVerilog.AST.Attr
     Language.SystemVerilog.AST.Decl
     Language.SystemVerilog.AST.Expr
     Language.SystemVerilog.AST.LHS