support for module attributes (resolves #39)

src/Convert/EmptyArgs.hs

@@ -20,7 +20,7 @@ convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription (description @ (Part _ _ _ _ _ _)) =
+convertDescription (description @ Part{}) =
     traverseModuleItems
         (traverseExprs $ traverseNestedExprs $ convertExpr functions)
         description'

src/Convert/Enum.hs

@@ -40,11 +40,11 @@ defaultType :: Type
 defaultType = IntegerVector TLogic Unspecified [(Number "31", Number "0")]
 
 convertDescription :: Description -> Description
-convertDescription (description @ (Part _ _ _ _ _ _)) =
-    Part extern kw lifetime name ports (enumItems ++ items)
+convertDescription (description @ Part{}) =
+    Part attrs extern kw lifetime name ports (enumItems ++ items)
     where
         -- replace and collect the enum types in this description
-        (Part extern kw lifetime name ports items, enumPairs) =
+        (Part attrs extern kw lifetime name ports items, enumPairs) =
             convertDescription' description
         -- convert the collected enums into their corresponding localparams
         enumItems = map MIPackageItem $ map toItem $ sortOn snd $ convergeUsage items enumPairs

src/Convert/Interface.hs

@@ -29,7 +29,7 @@ convert =
             map (convertDescription interfaces modules)
         -- we can only collect/map non-extern interfaces
         collectDesc :: Description -> Writer (Interfaces, Modules) ()
-        collectDesc (orig @ (Part False kw _ name ports items)) = do
+        collectDesc (orig @ (Part _ False kw _ name ports items)) = do
             if kw == Interface
                 then tell (Map.singleton name (ports, items), Map.empty)
                 else collectModuleItemsM (collectDeclsM $ collectDecl name) orig
@@ -39,12 +39,12 @@ convert =
             tell (Map.empty, Map.singleton (name, ident) t)
         collectDecl _ _ = return ()
         isInterface :: Description -> Bool
-        isInterface (Part False Interface _ _ _ _) = True
+        isInterface (Part _ False Interface _ _ _ _) = True
         isInterface _ = False
 
 convertDescription :: Interfaces -> Modules -> Description -> Description
-convertDescription interfaces modules (Part extern Module lifetime name ports items) =
-    Part extern Module lifetime name ports' items'
+convertDescription interfaces modules (Part attrs extern Module lifetime name ports items) =
+    Part attrs extern Module lifetime name ports' items'
     where
         items' =
             map (traverseNestedModuleItems $ traverseExprs' ExcludeTFs (traverseNestedExprs $ convertExpr instances modports)) $

src/Convert/Logic.hs

@@ -42,7 +42,7 @@ convert =
         (traverseDescriptions . convertDescription)
     where
         collectPortsM :: Description -> Writer Ports ()
-        collectPortsM (orig @ (Part _ _ _ name portNames _)) =
+        collectPortsM (orig @ (Part _ _ _ _ name portNames _)) =
             collectModuleItemsM collectPortDirsM orig
             where
                 collectPortDirsM :: ModuleItem -> Writer Ports ()
@@ -64,8 +64,8 @@ convertDescription ports orig =
         else orig
     where
         shouldConvert = case orig of
-            Part _ Interface _ _ _ _ -> False
-            Part _ Module _ _ _ _ -> True
+            Part _ _ Interface _ _ _ _ -> False
+            Part _ _ Module _ _ _ _ -> True
             PackageItem _ -> True
             Package _ _ _ -> False
             Directive _ -> False

src/Convert/NestPI.hs

@@ -45,9 +45,10 @@ collectDescriptionM _ = return ()
 
 -- nests packages items missing from modules
 convertDescription :: PIs -> Description -> Description
-convertDescription pis (orig @ (Part extern kw lifetime name ports items)) =
-    Part extern kw lifetime name ports (newItems ++ items)
+convertDescription pis (orig @ Part{}) =
+    Part attrs extern kw lifetime name ports (newItems ++ items)
     where
+        Part attrs extern kw lifetime name ports items = orig
         existingPIs = execWriter $ collectModuleItemsM collectPIsM orig
         runner f = execWriter $ collectModuleItemsM f orig
         usedPIs = Set.unions $ map runner $

src/Convert/ParamType.hs

@@ -39,7 +39,7 @@ convert files =
         -- add type parameter instantiations
         files'' = map (concatMap explodeDescription) files'
         explodeDescription :: Description -> [Description]
-        explodeDescription (part @ (Part _ _ _ name _ _)) =
+        explodeDescription (part @ (Part _ _ _ _ name _ _)) =
             if null theseInstances then
                 [part]
             else
@@ -52,7 +52,7 @@ convert files =
                 isNonDefault = (name /=) . moduleName
                 alreadyExists = (flip Map.member info) . moduleName
                 moduleName :: Description -> Identifier
-                moduleName (Part _ _ _ x _ _) = x
+                moduleName (Part _ _ _ _ x _ _) = x
                 moduleName _ = error "not possible"
         explodeDescription other = [other]
 
@@ -65,7 +65,7 @@ convert files =
         usedTypedModules = Map.unionsWith Set.union $ map (uncurry
             Map.singleton) usedTypedModulesRaw
         collectUsageInfoM :: Description -> Writer (UsageMap, UsageMap) ()
-        collectUsageInfoM (part @ (Part _ _ _ name _ _)) =
+        collectUsageInfoM (part @ (Part _ _ _ _ name _ _)) =
             tell (makeList used, makeList usedTyped)
             where
                 makeList s = zip (Set.toList s) (repeat $ Set.singleton name)
@@ -83,7 +83,7 @@ convert files =
                         else tell (Set.singleton m, Set.empty)
         collectModuleItemM _ = return ()
         replaceDefault :: Description -> [Description]
-        replaceDefault (part @ (Part _ _ _ name _ _)) =
+        replaceDefault (part @ (Part _ _ _ _ name _ _)) =
             if Map.notMember name info then
                 [part]
             else if Map.null maybeTypeMap then
@@ -103,10 +103,10 @@ convert files =
         replaceDefault other = [other]
 
         removeDefaultTypeParams :: Description -> Description
-        removeDefaultTypeParams (part @ (Part _ _ _ _ _ _)) =
-            Part extern kw ml (moduleDefaultName name) p items
+        removeDefaultTypeParams (part @ Part{}) =
+            Part attrs extern kw ml (moduleDefaultName name) p items
             where
-                Part extern kw ml name p items =
+                Part attrs extern kw ml name p items =
                     traverseModuleItems (traverseDecls rewriteDecl) part
                 rewriteDecl :: Decl -> Decl
                 rewriteDecl (ParamType Parameter x _) =
@@ -139,9 +139,9 @@ convert files =
         -- substitute in a particular instance's parameter types
         rewriteModule :: Description -> Instance -> Description
         rewriteModule part typeMap =
-            Part extern kw ml m' p items'
+            Part attrs extern kw ml m' p items'
             where
-                Part extern kw ml m p items = part
+                Part attrs extern kw ml m p items = part
                 m' = moduleInstanceName m typeMap
                 items' = map rewriteDecl items
                 rewriteDecl :: ModuleItem -> ModuleItem
@@ -158,7 +158,7 @@ convert files =
 
 -- write down module parameter names and type parameters
 collectDescriptionM :: Description -> Writer Info ()
-collectDescriptionM (part @ (Part _ _ _ name _ _)) =
+collectDescriptionM (part @ (Part _ _ _ _ name _ _)) =
     tell $ Map.singleton name (paramNames, maybeTypeMap)
     where
         params = execWriter $

src/Convert/StarPort.hs

@@ -21,7 +21,7 @@ convert =
         (traverseDescriptions . traverseModuleItems . mapInstance)
 
 collectPortsM :: Description -> Writer Ports ()
-collectPortsM (Part _ _ _ name ports _) = tell $ Map.singleton name ports
+collectPortsM (Part _ _ _ _ name ports _) = tell $ Map.singleton name ports
 collectPortsM _ = return ()
 
 mapInstance :: Ports -> ModuleItem -> ModuleItem

src/Convert/Stream.hs

@@ -18,12 +18,12 @@ convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription (description @ (Part _ _ _ _ _ _)) =
-    Part extern kw lifetime name ports (items ++ funcs)
+convertDescription (description @ Part{}) =
+    Part attrs extern kw lifetime name ports (items ++ funcs)
     where
         (description', funcSet) =
             runWriter $ traverseModuleItemsM (traverseStmtsM traverseStmtM) description
-        Part extern kw lifetime name ports items = description'
+        Part attrs extern kw lifetime name ports items = description'
         (funcs, _, _) = complex funcSet
 convertDescription other = other
 

src/Convert/Struct.hs

@@ -27,11 +27,11 @@ convert :: [AST] -> [AST]
 convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
-convertDescription (description @ (Part _ _ _ _ _ _)) =
+convertDescription (description @ Part{}) =
     traverseModuleItems (traverseTypes $ convertType structs) $
-    Part extern kw lifetime name ports (items ++ funcs)
+    Part attrs extern kw lifetime name ports (items ++ funcs)
     where
-        description' @ (Part extern kw lifetime name ports items) =
+        description' @ (Part attrs extern kw lifetime name ports items) =
             scopedConversion (traverseDeclM structs) traverseModuleItemM
                 traverseStmtM tfArgTypes description
         -- collect information about this description

src/Convert/Traverse.hs

@@ -119,10 +119,10 @@ maybeDo _ Nothing = return Nothing
 maybeDo fun (Just val) = fun val >>= return . Just
 
 traverseModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m Description
-traverseModuleItemsM mapper (Part extern kw lifetime name ports items) = do
+traverseModuleItemsM mapper (Part attrs extern kw lifetime name ports items) = do
     items' <- mapM fullMapper items
     let items'' = concatMap breakGenerate items'
-    return $ Part extern kw lifetime name ports items''
+    return $ Part attrs extern kw lifetime name ports items''
     where
         fullMapper (Generate [GenBlock Nothing genItems]) =
             mapM fullGenItemMapper genItems >>= mapper . Generate
@@ -151,9 +151,9 @@ traverseModuleItemsM mapper (Part extern kw lifetime name ports items) = do
 traverseModuleItemsM mapper (PackageItem packageItem) = do
     let item = MIPackageItem packageItem
     converted <-
-        traverseModuleItemsM mapper (Part False Module Nothing "DNE" [] [item])
+        traverseModuleItemsM mapper (Part [] False Module Nothing "DNE" [] [item])
     let item' = case converted of
-            Part False Module Nothing "DNE" [] [newItem] -> newItem
+            Part [] False Module Nothing "DNE" [] [newItem] -> newItem
             _ -> error $ "redirected PackageItem traverse failed: "
                     ++ show converted
     return $ case item' of
@@ -162,9 +162,9 @@ traverseModuleItemsM mapper (PackageItem packageItem) = do
 traverseModuleItemsM mapper (Package lifetime name packageItems) = do
     let items = map MIPackageItem packageItems
     converted <-
-        traverseModuleItemsM mapper (Part False Module Nothing "DNE" [] items)
+        traverseModuleItemsM mapper (Part [] False Module Nothing "DNE" [] items)
     let items' = case converted of
-            Part False Module Nothing "DNE" [] newItems -> newItems
+            Part [] False Module Nothing "DNE" [] newItems -> newItems
             _ -> error $ "redirected Package traverse failed: "
                     ++ show converted
     return $ Package lifetime name $ map (\(MIPackageItem item) -> item) items'
@@ -972,9 +972,9 @@ collectStmtAsgnsM = collectify traverseStmtAsgnsM
 traverseNestedModuleItemsM :: Monad m => MapperM m ModuleItem -> MapperM m ModuleItem
 traverseNestedModuleItemsM mapper item = do
     converted <-
-        traverseModuleItemsM mapper (Part False Module Nothing "DNE" [] [item])
+        traverseModuleItemsM mapper (Part [] False Module Nothing "DNE" [] [item])
     let items' = case converted of
-            Part False Module Nothing "DNE" [] newItems -> newItems
+            Part [] False Module Nothing "DNE" [] newItems -> newItems
             _ -> error $ "redirected NestedModuleItems traverse failed: "
                     ++ show converted
     return $ case items' of

src/Convert/Typedef.hs

@@ -25,7 +25,7 @@ convert =
     where
         getTypedef :: Description -> Writer Types ()
         getTypedef (PackageItem (Typedef a b)) = tell $ Map.singleton b a
-        getTypedef (Part _ Interface _ x _ _) =
+        getTypedef (Part _ _ Interface _ x _ _) =
             tell $ Map.singleton x (InterfaceT x Nothing [])
         getTypedef _ = return ()
         removeTypedef :: Description -> Description

src/Language/SystemVerilog/AST/Description.hs

@@ -18,13 +18,14 @@ import Text.Printf (printf)
 
 import Language.SystemVerilog.AST.ShowHelp
 
+import Language.SystemVerilog.AST.Attr (Attr)
 import Language.SystemVerilog.AST.Decl (Decl)
 import Language.SystemVerilog.AST.Stmt (Stmt)
 import Language.SystemVerilog.AST.Type (Type, Identifier)
 import {-# SOURCE #-} Language.SystemVerilog.AST.ModuleItem (ModuleItem)
 
 data Description
-    = Part Bool PartKW (Maybe Lifetime) Identifier [Identifier] [ModuleItem]
+    = Part [Attr] Bool PartKW (Maybe Lifetime) Identifier [Identifier] [ModuleItem]
     | PackageItem PackageItem
     | Package (Maybe Lifetime) Identifier [PackageItem]
     | Directive String -- currently unused
@@ -32,12 +33,14 @@ data Description
 
 instance Show Description where
     showList descriptions _ = intercalate "\n" $ map show descriptions
-    show (Part True  kw lifetime name _ items) =
-        printf "extern %s %s%s %s;"
-          (show kw) (showLifetime lifetime) name (indentedParenList itemStrs)
+    show (Part attrs True  kw lifetime name _ items) =
+        printf "%sextern %s %s%s %s;"
+            (concatMap showPad attrs)
+            (show kw) (showLifetime lifetime) name (indentedParenList itemStrs)
         where itemStrs = map (init . show) items
-    show (Part False kw lifetime name ports items) =
-        printf "%s %s%s%s;\n%s\nend%s"
+    show (Part attrs False kw lifetime name ports items) =
+        printf "%s%s %s%s%s;\n%s\nend%s"
+            (concatMap showPad attrs)
             (show kw) (showLifetime lifetime) name portsStr bodyStr (show kw)
         where
             portsStr = if null ports

src/Language/SystemVerilog/Parser/Parse.y

@@ -498,8 +498,11 @@ Packing :: { Packing }
   | {- empty -}         { Unpacked }
 
 Part(begin, end) :: { Description }
-  :          begin opt(Lifetime) Identifier PackageImportDeclarations Params PortDecls ";" ModuleItems end opt(Tag) { Part False $1 $2 $3 (fst $6) ($4 ++ $5 ++ (snd $6) ++ $8) }
-  | "extern" begin opt(Lifetime) Identifier PackageImportDeclarations Params PortDecls ";"                          { Part True  $2 $3 $4 (fst $7) ($5 ++ $6 ++ (snd $7)      ) }
+  : AttributeInstances          begin PartHeader ModuleItems end opt(Tag) { $3 $1 False $2 $4 }
+  | AttributeInstances "extern" begin PartHeader                          { $4 $1 True  $3 [] }
+
+PartHeader :: { [Attr] -> Bool -> PartKW -> [ModuleItem] -> Description }
+  : opt(Lifetime) Identifier PackageImportDeclarations Params PortDecls ";" { \attrs extern kw items -> Part attrs extern kw $1 $2 (fst $5) ($3 ++ $4 ++ (snd $5) ++ items) }
 
 ModuleKW :: { PartKW }
   : "module" { Module }
@@ -693,6 +696,9 @@ ActionBlock :: { ActionBlock }
   |      "else" Stmt  { ActionBlockElse (Nothing) $2 }
   | Stmt "else" Stmt  { ActionBlockElse (Just $1) $3 }
 
+AttributeInstances :: { [Attr] }
+  : {- empty -}                          { [] }
+  | AttributeInstance AttributeInstances { $1 : $2 }
 AttributeInstance :: { Attr }
   : "(*" AttrSpecs "*)" { Attr $2 }
 AttrSpecs :: { [AttrSpec] }

test/basic/attr.sv

-module top;
+(* a=1 *) module top;
     (* foo="bar" *) logic x;
     initial begin
         x = 1;

test/basic/attr.v

-module top;
+(* a=1 *) module top;
     (* foo="bar" *) reg x;
     initial begin
         x = 1;