From 0f4a60be1d561d266ef8a87f7087a29ad6bd750d Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Thu, 7 Mar 2019 13:19:31 -0500 Subject: [PATCH] functions and typedefs can now appear at the top level --- src/Convert/FuncRet.hs | 4 +-- src/Convert/Interface.hs | 5 ++-- src/Convert/PackedArray.hs | 2 +- src/Convert/Return.hs | 5 ++-- src/Convert/Struct.hs | 2 +- src/Convert/Traverse.hs | 29 ++++++++++++++-------- src/Convert/Typedef.hs | 30 +++++++++++++++++------ src/Language/SystemVerilog/AST.hs | 27 ++++++++++++++------ src/Language/SystemVerilog/Parser/Parse.y | 16 ++++++------ 9 files changed, 80 insertions(+), 40 deletions(-) diff --git a/src/Convert/FuncRet.hs b/src/Convert/FuncRet.hs index 8a78729..7180ca5 100644 --- a/src/Convert/FuncRet.hs +++ b/src/Convert/FuncRet.hs @@ -13,6 +13,6 @@ convert :: AST -> AST convert = traverseDescriptions $ traverseModuleItems convertFunction convertFunction :: ModuleItem -> ModuleItem -convertFunction (Function ml (Logic r) f decls stmts) = - Function ml (Implicit r) f decls stmts +convertFunction (MIPackageItem (Function ml (Logic r) f decls stmts)) = + MIPackageItem $ Function ml (Implicit r) f decls stmts convertFunction other = other diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs index 6cbaf47..cda5353 100644 --- a/src/Convert/Interface.hs +++ b/src/Convert/Interface.hs @@ -161,7 +161,7 @@ lookupType _ expr = error $ "lookupType on fancy expr: " ++ show expr -- convert an interface instantiation into a series of equivalent module items inlineInterface :: Interface -> (Identifier, [PortBinding]) -> [ModuleItem] inlineInterface (ports, items) (instanceName, instancePorts) = - (:) (Comment $ "expanded instance: " ++ instanceName) $ + (:) (MIPackageItem $ Comment $ "expanded instance: " ++ instanceName) $ (++) portBindings $ map (traverseNestedModuleItems removeModport) $ map (traverseNestedModuleItems removeMIDeclDir) $ @@ -186,5 +186,6 @@ inlineInterface (ports, items) (instanceName, instancePorts) = MIDecl $ Variable Local t x a me removeMIDeclDir other = other removeModport :: ModuleItem -> ModuleItem - removeModport (Modport x _) = Comment $ "removed modport " ++ x + removeModport (Modport x _) = + MIPackageItem $ Comment $ "removed modport " ++ x removeModport other = other diff --git a/src/Convert/PackedArray.hs b/src/Convert/PackedArray.hs index ab7a8ee..43ea27c 100644 --- a/src/Convert/PackedArray.hs +++ b/src/Convert/PackedArray.hs @@ -149,7 +149,7 @@ flattenModuleItem _ other = other -- flattened, packed array unflattener :: Bool -> Identifier -> (Type, Range) -> [GenItem] unflattener writeToFlatVariant arr (t, (majorHi, majorLo)) = - [ GenModuleItem $ Comment $ "sv2v packed-array-flatten unflattener for " ++ arr + [ GenModuleItem $ MIPackageItem $ Comment $ "sv2v packed-array-flatten unflattener for " ++ arr , GenModuleItem $ MIDecl $ Variable Local t arrUnflat [(majorHi, majorLo)] Nothing , GenModuleItem $ Genvar index , GenModuleItem $ MIDecl $ Variable Local IntegerT (arrUnflat ++ "_repeater_index") [] Nothing diff --git a/src/Convert/Return.hs b/src/Convert/Return.hs index 0e94fa8..88c48a6 100644 --- a/src/Convert/Return.hs +++ b/src/Convert/Return.hs @@ -13,8 +13,9 @@ convert :: AST -> AST convert = traverseDescriptions $ traverseModuleItems convertFunction convertFunction :: ModuleItem -> ModuleItem -convertFunction (Function ml t f decls stmts) = - Function ml t f decls (map (traverseNestedStmts convertStmt) stmts) +convertFunction (MIPackageItem (Function ml t f decls stmts)) = + MIPackageItem $ Function ml t f decls $ + map (traverseNestedStmts convertStmt) stmts where convertStmt :: Stmt -> Stmt convertStmt (Return e) = AsgnBlk (LHSIdent f) e diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index cd7e554..ade3882 100644 --- a/src/Convert/Struct.hs +++ b/src/Convert/Struct.hs @@ -109,7 +109,7 @@ collectDecl (Localparam t x _) = tell $ Map.singleton x t -- write down the return type of a function collectFunction :: ModuleItem -> Writer Types () -collectFunction (Function _ t f _ _) = tell $ Map.singleton f t +collectFunction (MIPackageItem (Function _ t f _ _)) = tell $ Map.singleton f t collectFunction _ = return () diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 0bd9f0a..0a78ade 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -89,7 +89,13 @@ traverseModuleItemsM mapper (Part kw name ports items) = Generate subItems -> GenBlock Nothing subItems _ -> GenModuleItem moduleItem' genItemMapper other = return other -traverseModuleItemsM _ orig = return orig +traverseModuleItemsM mapper (PackageItem packageItem) = do + let item = MIPackageItem packageItem + Part Module "DNE" [] [item'] <- + traverseModuleItemsM mapper (Part Module "DNE" [] [item]) + return $ case item' of + MIPackageItem packageItem' -> PackageItem packageItem' + other -> error $ "encountered bad package module item: " ++ show other traverseModuleItems :: Mapper ModuleItem -> Mapper Description traverseModuleItems = unmonad traverseModuleItemsM @@ -101,9 +107,9 @@ traverseStmtsM mapper = moduleItemMapper where moduleItemMapper (AlwaysC kw stmt) = fullMapper stmt >>= return . AlwaysC kw - moduleItemMapper (Function lifetime ret name decls stmts) = do + moduleItemMapper (MIPackageItem (Function lifetime ret name decls stmts)) = do stmts' <- mapM fullMapper stmts - return $ Function lifetime ret name decls stmts' + return $ MIPackageItem $ Function lifetime ret name decls stmts' moduleItemMapper (Initial stmt) = fullMapper stmt >>= return . Initial moduleItemMapper other = return $ other @@ -288,10 +294,10 @@ traverseExprsM mapper = moduleItemMapper stmtMapper stmt >>= return . AlwaysC kw moduleItemMapper (Initial stmt) = stmtMapper stmt >>= return . Initial - moduleItemMapper (Function lifetime ret f decls stmts) = do + moduleItemMapper (MIPackageItem (Function lifetime ret f decls stmts)) = do decls' <- mapM declMapper decls stmts' <- mapM stmtMapper stmts - return $ Function lifetime ret f decls' stmts' + return $ MIPackageItem $ Function lifetime ret f decls' stmts' moduleItemMapper (Instance m params x ml) = do if ml == Nothing then return $ Instance m params x Nothing @@ -300,9 +306,12 @@ traverseExprsM mapper = moduleItemMapper return $ Instance m params x (Just l) moduleItemMapper (Modport x l) = mapM modportDeclMapper l >>= return . Modport x - moduleItemMapper (Comment x) = return $ Comment x moduleItemMapper (Genvar x) = return $ Genvar x moduleItemMapper (Generate x) = return $ Generate x + moduleItemMapper (MIPackageItem (Typedef t x)) = + return $ MIPackageItem $ Typedef t x + moduleItemMapper (MIPackageItem (Comment c)) = + return $ MIPackageItem $ Comment c modportDeclMapper (dir, ident, Just e) = do e' <- exprMapper e @@ -345,9 +354,9 @@ traverseDeclsM mapper item = do where miMapperA (MIDecl decl) = mapper decl >>= return . MIDecl - miMapperA (Function l t x decls s) = do + miMapperA (MIPackageItem (Function l t x decls s)) = do decls' <- mapM mapper decls - return $ Function l t x decls' s + return $ MIPackageItem $ Function l t x decls' s miMapperA other = return other miMapperB (Block (Just (name, decls)) stmts) = do decls' <- mapM mapper decls @@ -389,8 +398,8 @@ traverseTypesM mapper item = fullMapper t >>= \t' -> return $ Localparam t' x e declMapper (Variable d t x a me) = fullMapper t >>= \t' -> return $ Variable d t' x a me - miMapper (Function l t x d s) = - fullMapper t >>= \t' -> return $ Function l t' x d s + miMapper (MIPackageItem (Function l t x d s)) = + fullMapper t >>= \t' -> return $ MIPackageItem $ Function l t' x d s miMapper other = return other traverseTypes :: Mapper Type -> Mapper ModuleItem diff --git a/src/Convert/Typedef.hs b/src/Convert/Typedef.hs index 7598b96..d539675 100644 --- a/src/Convert/Typedef.hs +++ b/src/Convert/Typedef.hs @@ -19,20 +19,34 @@ type Types = Map.Map Identifier Type convert :: AST -> AST convert descriptions = - filter (not . isTypedef) $ traverseDescriptions (convertDescription types) descriptions + traverseDescriptions removeTypedef $ + traverseDescriptions (convertDescription types) $ + descriptions where types = execWriter $ collectDescriptionsM getTypedef descriptions getTypedef :: Description -> Writer Types () - getTypedef (Typedef a b) = tell $ Map.singleton b a + getTypedef (PackageItem (Typedef a b)) = tell $ Map.singleton b a getTypedef _ = return () - -isTypedef :: Description -> Bool -isTypedef (Typedef _ _) = True -isTypedef _ = False + removeTypedef :: Description -> Description + removeTypedef (PackageItem (Typedef _ x)) = + PackageItem $ Comment $ "removed typedef: " ++ x + removeTypedef other = other convertDescription :: Types -> Description -> Description -convertDescription types description = - traverseModuleItems (traverseTypes $ resolveType types) description +convertDescription globalTypes description = + traverseModuleItems removeTypedef $ + traverseModuleItems (traverseTypes $ resolveType types) $ + description + where + types = Map.union globalTypes $ + execWriter $ collectModuleItemsM getTypedef description + getTypedef :: ModuleItem -> Writer Types () + getTypedef (MIPackageItem (Typedef a b)) = tell $ Map.singleton b a + getTypedef _ = return () + removeTypedef :: ModuleItem -> ModuleItem + removeTypedef (MIPackageItem (Typedef _ x)) = + MIPackageItem $ Comment $ "removed typedef: " ++ x + removeTypedef other = other resolveType :: Types -> Type -> Type resolveType _ (Reg rs) = Reg rs diff --git a/src/Language/SystemVerilog/AST.hs b/src/Language/SystemVerilog/AST.hs index 8fffd5e..1398b71 100644 --- a/src/Language/SystemVerilog/AST.hs +++ b/src/Language/SystemVerilog/AST.hs @@ -2,6 +2,7 @@ module Language.SystemVerilog.AST ( Identifier , Description(..) + , PackageItem(..) , ModuleItem (..) , Direction (..) , Type (..) @@ -49,9 +50,23 @@ type Identifier = String type AST = [Description] +data PackageItem + = Typedef Type Identifier + | Function (Maybe Lifetime) Type Identifier [Decl] [Stmt] + | Comment String + deriving Eq + +instance Show PackageItem where + show (Typedef t x) = printf "typedef %s %s;" (show t) x + show (Function ml t x i b) = + printf "function %s%s%s;\n%s\n%s\nendfunction" + (showLifetime ml) (showPad t) x (indent $ show i) + (indent $ unlines' $ map show b) + show (Comment c) = "// " ++ c + data Description = Part PartKW Identifier [Identifier] [ModuleItem] - | Typedef Type Identifier + | PackageItem PackageItem deriving Eq instance Show Description where @@ -65,7 +80,7 @@ instance Show Description where if null ports then "" else indentedParenList ports - show (Typedef t x) = printf "typedef %s %s;" (show t) x + show (PackageItem i) = show i data PartKW = Module @@ -154,16 +169,15 @@ instance Show Decl where show (Variable d t x a me) = printf "%s%s %s%s%s;" (showPad d) (show t) x (showRanges a) (showAssignment me) data ModuleItem - = Comment String - | MIDecl Decl + = MIDecl Decl | AlwaysC AlwaysKW Stmt | Assign LHS Expr | Instance Identifier [PortBinding] Identifier (Maybe [PortBinding]) -- `Nothing` represents `.*` - | Function (Maybe Lifetime) Type Identifier [Decl] [Stmt] | Genvar Identifier | Generate [GenItem] | Modport Identifier [ModportDecl] | Initial Stmt + | MIPackageItem PackageItem deriving Eq data AlwaysKW @@ -184,18 +198,17 @@ type ModportDecl = (Direction, Identifier, Maybe Expr) instance Show ModuleItem where show thing = case thing of - Comment c -> "// " ++ c MIDecl nest -> show nest AlwaysC k b -> printf "%s %s" (show k) (show b) Assign a b -> printf "assign %s = %s;" (show a) (show b) Instance m params i ports | null params -> printf "%s %s%s;" m i (showMaybePorts ports) | otherwise -> printf "%s #%s %s%s;" m (showPorts params) i (showMaybePorts ports) - Function ml t x i b -> printf "function %s%s%s;\n%s\n%s\nendfunction" (showLifetime ml) (showPad t) x (indent $ show i) (indent $ unlines' $ map show b) Genvar x -> printf "genvar %s;" x Generate b -> printf "generate\n%s\nendgenerate" (indent $ unlines' $ map show b) Modport x l -> printf "modport %s(\n%s\n);" x (indent $ intercalate ",\n" $ map showModportDecl l) Initial s -> printf "initial %s" (show s) + MIPackageItem i -> show i where showMaybePorts = maybe "(.*)" showPorts showPorts :: [PortBinding] -> String diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index e93eb34..96669a7 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -184,15 +184,13 @@ opt(p) :: { Maybe a } | { Nothing } Descriptions :: { [Description] } - : {- empty -} { [] } + : {- empty -} { [] } + | Descriptions ";" { $1 } | Descriptions Description { $1 ++ [$2] } Description :: { Description } - : Part opt(";") { $1 } - | Typedef opt(";") { $1 } - -Typedef :: { Description } - : "typedef" Type Identifier ";" { Typedef $2 $3 } + : Part { $1 } + | PackageItem { PackageItem $1 } Type :: { Type } : PartialType Dimensions { $1 $2 } @@ -322,7 +320,11 @@ ModuleItem :: { [ModuleItem] } | "genvar" Identifiers ";" { map Genvar $2 } | "generate" GenItems "endgenerate" { [Generate $2] } | "modport" ModportItems ";" { map (uncurry Modport) $2 } - | "function" opt(Lifetime) FuncRetAndName FunctionItems DeclsAndStmts "endfunction" opt(Tag) { [Function $2 (fst $3) (snd $3) (map defaultFuncInput $ $4 ++ fst $5) (snd $5)] } + | PackageItem { [MIPackageItem $1] } + +PackageItem :: { PackageItem } + : "typedef" Type Identifier ";" { Typedef $2 $3 } + | "function" opt(Lifetime) FuncRetAndName FunctionItems DeclsAndStmts "endfunction" opt(Tag) { Function $2 (fst $3) (snd $3) (map defaultFuncInput $ $4 ++ fst $5) (snd $5) } FuncRetAndName :: { (Type, Identifier) } : {- empty -} Identifier { (Implicit [], $1) }