From 12be569742d3a48bf8e3f325981121f90f3aedd6 Mon Sep 17 00:00:00 2001 From: Zachary Snow Date: Sun, 14 Jun 2020 15:56:09 -0400 Subject: [PATCH] reduce usage of maybe --- src/Convert/BlockDecl.hs | 8 +- src/Convert/EmptyArgs.hs | 4 +- src/Convert/Enum.hs | 9 +- src/Convert/ForDecl.hs | 14 +-- src/Convert/Foreach.hs | 2 +- src/Convert/FuncRoutine.hs | 2 +- src/Convert/Interface.hs | 40 ++++----- src/Convert/Jump.hs | 4 +- src/Convert/KWArgs.hs | 9 +- src/Convert/Logic.hs | 19 ++-- src/Convert/MultiplePacked.hs | 4 +- src/Convert/NestPI.hs | 32 +++---- src/Convert/Package.hs | 32 +++---- src/Convert/ParamType.hs | 10 +-- src/Convert/SignCast.hs | 4 +- src/Convert/Simplify.hs | 4 +- src/Convert/SizeCast.hs | 4 +- src/Convert/StarPort.hs | 6 +- src/Convert/Stream.hs | 6 +- src/Convert/Struct.hs | 19 ++-- src/Convert/Traverse.hs | 68 ++++++-------- src/Convert/TypeOf.hs | 6 +- src/Convert/UnpackedArray.hs | 12 +-- src/Language/SystemVerilog/AST/Attr.hs | 4 +- src/Language/SystemVerilog/AST/Decl.hs | 7 +- src/Language/SystemVerilog/AST/Expr.hs | 15 ++-- src/Language/SystemVerilog/AST/ModuleItem.hs | 25 +++--- src/Language/SystemVerilog/AST/Stmt.hs | 12 +-- src/Language/SystemVerilog/AST/Type.hs | 4 +- src/Language/SystemVerilog/Parser/Parse.y | 88 ++++++++++--------- .../SystemVerilog/Parser/ParseDecl.hs | 37 ++++---- 31 files changed, 250 insertions(+), 260 deletions(-) diff --git a/src/Convert/BlockDecl.hs b/src/Convert/BlockDecl.hs index fe6bf19..5584870 100644 --- a/src/Convert/BlockDecl.hs +++ b/src/Convert/BlockDecl.hs @@ -42,9 +42,11 @@ convertStmt (Block Seq name decls stmts) = convertStmt other = other splitDecl :: Decl -> (Decl, Maybe (LHS, Expr)) -splitDecl (Variable d t ident a (Just e)) = - (Variable d t ident a Nothing, Just (LHSIdent ident, e)) -splitDecl other = (other, Nothing) +splitDecl (decl @ (Variable _ _ _ _ Nil)) = + (decl, Nothing) +splitDecl (Variable d t ident a e) = + (Variable d t ident a Nil, Just (LHSIdent ident, e)) +splitDecl decl = (decl, Nothing) asgnStmt :: (LHS, Expr) -> Stmt asgnStmt = uncurry $ Asgn AsgnOpEq Nothing diff --git a/src/Convert/EmptyArgs.hs b/src/Convert/EmptyArgs.hs index 662b609..fc18b71 100644 --- a/src/Convert/EmptyArgs.hs +++ b/src/Convert/EmptyArgs.hs @@ -31,7 +31,7 @@ convertDescription other = other traverseFunctionsM :: ModuleItem -> Writer Idents ModuleItem traverseFunctionsM (MIPackageItem (Function ml t f decls stmts)) = do - let dummyDecl = Variable Input (Implicit Unspecified []) "_sv2v_unused" [] Nothing + let dummyDecl = Variable Input (Implicit Unspecified []) "_sv2v_unused" [] Nil decls' <- do if any isInput decls then return decls @@ -49,6 +49,6 @@ convertExpr :: Idents -> Expr -> Expr convertExpr functions (Call (Ident func) (Args [] [])) = Call (Ident func) (Args args []) where args = if Set.member func functions - then [Just $ Number "0"] + then [Number "0"] else [] convertExpr _ other = other diff --git a/src/Convert/Enum.hs b/src/Convert/Enum.hs index 79080f6..a6336ec 100644 --- a/src/Convert/Enum.hs +++ b/src/Convert/Enum.hs @@ -26,7 +26,7 @@ import qualified Data.Set as Set import Convert.Traverse import Language.SystemVerilog.AST -type EnumInfo = (Type, [(Identifier, Maybe Expr)]) +type EnumInfo = (Type, [(Identifier, Expr)]) type Enums = Set.Set EnumInfo convert :: [AST] -> [AST] @@ -84,10 +84,9 @@ makeEnumItems (itemType, l) = keys = map fst l vals = tail $ scanl step (Number "-1") (map snd l) noDuplicates = all (null . tail . flip elemIndices vals) vals - step :: Expr -> Maybe Expr -> Expr - step _ (Just expr) = expr - step expr Nothing = - simplify $ BinOp Add expr (Number "1") + step :: Expr -> Expr -> Expr + step expr Nil = simplify $ BinOp Add expr (Number "1") + step _ expr = expr toPackageItem :: Identifier -> Expr -> PackageItem toPackageItem x v = Decl $ Param Localparam itemType x v' diff --git a/src/Convert/ForDecl.hs b/src/Convert/ForDecl.hs index 05e921d..8eb9d93 100644 --- a/src/Convert/ForDecl.hs +++ b/src/Convert/ForDecl.hs @@ -23,7 +23,7 @@ convertStmt (For (Left []) cc asgns stmt) = convertStmt $ For (Right []) cc asgns stmt convertStmt (For (Right []) cc asgns stmt) = convertStmt $ For inits cc asgns stmt - where inits = Left [dummyDecl (Just $ Number "0")] + where inits = Left [dummyDecl $ Number "0"] convertStmt (orig @ (For (Right [_]) _ _ _)) = orig convertStmt (For (Left inits) cc asgns stmt) = @@ -47,13 +47,15 @@ convertStmt (For (Right origPairs) cc asgns stmt) = convertStmt other = other splitDecl :: Decl -> (Decl, (LHS, Expr)) -splitDecl (Variable d t ident a (Just e)) = - (Variable d t ident a Nothing, (LHSIdent ident, e)) -splitDecl other = - error $ "invalid for loop decl: " ++ show other +splitDecl (decl @ (Variable _ _ _ _ Nil)) = + error $ "invalid for loop decl: " ++ show decl +splitDecl (Variable d t ident a e) = + (Variable d t ident a Nil, (LHSIdent ident, e)) +splitDecl decl = + error $ "invalid for loop decl: " ++ show decl asgnStmt :: (LHS, Expr) -> Stmt asgnStmt = uncurry $ Asgn AsgnOpEq Nothing -dummyDecl :: Maybe Expr -> Decl +dummyDecl :: Expr -> Decl dummyDecl = Variable Local (IntegerAtom TInteger Unspecified) "_sv2v_dummy" [] diff --git a/src/Convert/Foreach.hs b/src/Convert/Foreach.hs index 458ef99..c261b3c 100644 --- a/src/Convert/Foreach.hs +++ b/src/Convert/Foreach.hs @@ -29,7 +29,7 @@ convertStmt (Foreach x idxs stmt) = where queryFn f = DimFn f (Right $ Ident x) (Number $ show d) idxDecl = Variable Local (IntegerAtom TInteger Unspecified) i [] - $ Just $ queryFn FnLeft + (queryFn FnLeft) cmp = Mux (BinOp Eq (queryFn FnIncrement) (Number "1")) (BinOp Ge (Ident i) (queryFn FnRight)) diff --git a/src/Convert/FuncRoutine.hs b/src/Convert/FuncRoutine.hs index 0c92e5d..1a3357b 100644 --- a/src/Convert/FuncRoutine.hs +++ b/src/Convert/FuncRoutine.hs @@ -41,5 +41,5 @@ convertStmt functions (Subroutine (Ident func) args) = where t = TypeOf e e = Call (Ident func) args - decl = Variable Local t "sv2v_void" [] (Just e) + decl = Variable Local t "sv2v_void" [] e convertStmt _ other = other diff --git a/src/Convert/Interface.hs b/src/Convert/Interface.hs index 1b44573..72c9dae 100644 --- a/src/Convert/Interface.hs +++ b/src/Convert/Interface.hs @@ -103,8 +103,8 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po Just res -> snd res Nothing -> error $ "could not find interface " ++ show interfaceName mapper (dir, port, expr) = - Variable dir mpt (ident ++ "_" ++ port) mprs Nothing - where (mpt, mprs) = lookupType interfaceItems (fromJust expr) + Variable dir mpt (ident ++ "_" ++ port) mprs Nil + where (mpt, mprs) = lookupType interfaceItems expr mapInterface (Instance part params ident Nothing instancePorts) = -- expand modport port bindings case Map.lookup part interfaces of @@ -125,15 +125,15 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po traverseExprs (traverseNestedExprs $ convertExpr its mps) . traverseLHSs (traverseNestedLHSs $ convertLHS its mps) where - locals = Set.fromList $ mapMaybe declVarIdent decls + locals = Set.fromList $ map declVarIdent decls its = Map.withoutKeys instances locals mps = Map.withoutKeys modports locals - declVarIdent :: Decl -> Maybe Identifier - declVarIdent (Variable _ _ x _ _) = Just x - declVarIdent _ = Nothing + declVarIdent :: Decl -> Identifier + declVarIdent (Variable _ _ x _ _) = x + declVarIdent _ = "" expandPortBinding :: Identifier -> PortBinding -> Int -> [PortBinding] - expandPortBinding _ (origBinding @ (portName, Just (Dot (Ident instanceName) modportName))) _ = + expandPortBinding _ (origBinding @ (portName, Dot (Ident instanceName) modportName)) _ = -- expand instance modport bound to a modport if Map.member instanceName instances && modportDecls /= Nothing then expandPortBinding' portName instanceName $ fromJust modportDecls @@ -141,7 +141,7 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po where interfaceName = instances Map.! instanceName modportDecls = lookupModport interfaceName modportName - expandPortBinding moduleName (origBinding @ (portName, Just (Ident ident))) idx = + expandPortBinding moduleName (origBinding @ (portName, Ident ident)) idx = case (instances Map.!? ident, modports Map.!? ident) of (Nothing, Nothing) -> [origBinding] (Just interfaceName, _) -> @@ -176,17 +176,17 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po (_, Just modportDecls) -> -- modport directly bound to a modport expandPortBinding' portName ident $ map redirect modportDecls - where redirect (d, x, _) = (d, x, Just $ Ident x) + where redirect (d, x, _) = (d, x, Ident x) expandPortBinding _ other _ = [other] expandPortBinding' :: Identifier -> Identifier -> [ModportDecl] -> [PortBinding] expandPortBinding' portName instanceName modportDecls = map mapper modportDecls where - mapper (_, x, me) = (x', me') + mapper (_, x, e) = (x', e') where x' = if null portName then "" else portName ++ '_' : x - me' = fmap (traverseNestedExprs prefixExpr) me + e' = traverseNestedExprs prefixExpr e prefixExpr :: Expr -> Expr prefixExpr (Ident x) = Ident (instanceName ++ '_' : x) prefixExpr other = other @@ -217,7 +217,7 @@ convertDescription interfaces modules (Part attrs extern Module lifetime name po interfaceItems collectModportDecls :: ModuleItem -> Writer [ModportDecl] () collectModportDecls (MIPackageItem (Decl (Variable d _ x _ _))) = - tell [(d', x, Just $ Ident x)] + tell [(d', x, Ident x)] where d' = if d == Local then Inout else d collectModportDecls _ = return () @@ -251,10 +251,10 @@ prefixModuleItems prefix = traverseLHSs (traverseNestedLHSs prefixLHS ) where prefixDecl :: Decl -> Decl - prefixDecl (Variable d t x a me) = Variable d t (prefix x) a me - prefixDecl (Param s t x e) = Param s t (prefix x) e - prefixDecl (ParamType s x mt) = ParamType s (prefix x) mt - prefixDecl (CommentDecl c) = CommentDecl c + prefixDecl (Variable d t x a e) = Variable d t (prefix x) a e + prefixDecl (Param s t x e) = Param s t (prefix x) e + prefixDecl (ParamType s x mt) = ParamType s (prefix x) mt + prefixDecl (CommentDecl c) = CommentDecl c prefixExpr :: Expr -> Expr prefixExpr (Ident x) = Ident (prefix x) prefixExpr other = other @@ -343,8 +343,8 @@ inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) = zip instancePortNames instancePortExprs removeDeclDir :: ModuleItem -> ModuleItem - removeDeclDir (MIPackageItem (Decl (Variable _ t x a me))) = - MIPackageItem $ Decl $ Variable Local t x a me + removeDeclDir (MIPackageItem (Decl (Variable _ t x a e))) = + MIPackageItem $ Decl $ Variable Local t x a e removeDeclDir other = other removeModport :: ModuleItem -> ModuleItem removeModport (Modport x _) = @@ -370,11 +370,11 @@ inlineInterface (ports, items) (instanceName, instanceParams, instancePorts) = overrideParam other = other portBindingItem :: PortBinding -> Maybe ModuleItem - portBindingItem (ident, Just expr) = + portBindingItem (_, Nil) = Nothing + portBindingItem (ident, expr) = Just $ if declDirs Map.! ident == Input then Assign AssignOptionNone (LHSIdent ident) expr else Assign AssignOptionNone (toLHS expr) (Ident ident) - portBindingItem (_, Nothing) = Nothing declDirs = execWriter $ mapM (collectDeclsM collectDeclDir) itemsPrefixed diff --git a/src/Convert/Jump.hs b/src/Convert/Jump.hs index 5eb99ad..d76ebfa 100644 --- a/src/Convert/Jump.hs +++ b/src/Convert/Jump.hs @@ -77,7 +77,7 @@ addJumpStateDeclTF :: [Decl] -> [Stmt] -> ([Decl], [Stmt]) addJumpStateDeclTF decls stmts = if uses && not declares then ( decls ++ - [Variable Local jumpStateType jumpState [] (Just jsNone)] + [Variable Local jumpStateType jumpState [] jsNone] , stmts ) else if uses then (decls, stmts) @@ -256,7 +256,7 @@ convertLoop loop comp stmt = do ] let jsStackIdent = jumpState ++ "_" ++ show origLoopDepth let jsStackDecl = Variable Local jumpStateType jsStackIdent [] - (Just $ Ident jumpState) + (Ident jumpState) let jsStackRestore = If NoCheck (BinOp Ne (Ident jumpState) jsReturn) (asgn jumpState (Ident jsStackIdent)) diff --git a/src/Convert/KWArgs.hs b/src/Convert/KWArgs.hs index 8e62ae6..549f41f 100644 --- a/src/Convert/KWArgs.hs +++ b/src/Convert/KWArgs.hs @@ -10,7 +10,6 @@ module Convert.KWArgs (convert) where import Data.List (elemIndex, sortOn) -import Data.Maybe (mapMaybe) import Control.Monad.Writer import qualified Data.Map.Strict as Map @@ -39,11 +38,11 @@ collectTF _ = return () collectTFDecls :: Identifier -> [Decl] -> Writer TFs () collectTFDecls name decls = - tell $ Map.singleton name $ mapMaybe getInput decls + tell $ Map.singleton name $ filter (not . null) $ map getInput decls where - getInput :: Decl -> Maybe Identifier - getInput (Variable Input _ ident _ _) = Just ident - getInput _ = Nothing + getInput :: Decl -> Identifier + getInput (Variable Input _ ident _ _) = ident + getInput _ = "" convertExpr :: TFs -> Expr -> Expr convertExpr tfs (Call expr args) = diff --git a/src/Convert/Logic.hs b/src/Convert/Logic.hs index 85415dd..5d9e0c4 100644 --- a/src/Convert/Logic.hs +++ b/src/Convert/Logic.hs @@ -102,10 +102,10 @@ convertDescription ports orig = unzip $ map (uncurry fixBinding) $ zip bindings [0..] newItems = concat newItemsList fixBinding :: PortBinding -> Int -> (PortBinding, [ModuleItem]) - fixBinding (portName, Just expr) portIdx = + fixBinding (portName, expr) portIdx = if portDir /= Just Output || Set.disjoint usedIdents origIdents - then ((portName, Just expr), []) - else ((portName, Just tmpExpr), items) + then ((portName, expr), []) + else ((portName, tmpExpr), items) where portDir = lookupPortDir portName portIdx usedIdents = execWriter $ @@ -115,7 +115,7 @@ convertDescription ports orig = t = Net (NetType TWire) Unspecified [(DimsFn FnBits $ Right expr, Number "1")] items = - [ MIPackageItem $ Decl $ Variable Local t tmp [] Nothing + [ MIPackageItem $ Decl $ Variable Local t tmp [] Nil , AlwaysC AlwaysComb $ Asgn AsgnOpEq Nothing lhs tmpExpr] lhs = case exprToLHS expr of Just l -> l @@ -123,7 +123,6 @@ convertDescription ports orig = error $ "bad non-lhs, non-net expr " ++ show expr ++ " connected to output port " ++ portName ++ " of " ++ instanceName - fixBinding other _ = (other, []) lookupPortDir :: Identifier -> Int -> Maybe Direction lookupPortDir "" portIdx = case Map.lookup moduleName ports of @@ -138,8 +137,8 @@ convertDescription ports orig = fixModuleItem other = other -- rewrite variable declarations to have the correct type - convertModuleItem (MIPackageItem (Decl (Variable dir (IntegerVector _ sg mr) ident a me))) = - MIPackageItem $ Decl $ Variable dir' (t mr) ident a me + convertModuleItem (MIPackageItem (Decl (Variable dir (IntegerVector _ sg mr) ident a e))) = + MIPackageItem $ Decl $ Variable dir' (t mr) ident a e where t = if Set.member ident fixedIdents then IntegerVector TReg sg @@ -153,8 +152,8 @@ convertDescription ports orig = convertDecl :: Decl -> Decl convertDecl (Param s (IntegerVector _ sg rs) x e) = Param s (Implicit sg rs) x e - convertDecl (Variable d (IntegerVector TLogic sg rs) x a me) = - Variable d (IntegerVector TReg sg rs) x a me + convertDecl (Variable d (IntegerVector TLogic sg rs) x a e) = + Variable d (IntegerVector TReg sg rs) x a e convertDecl other = other regIdents :: ModuleItem -> Writer Idents () @@ -180,7 +179,7 @@ traverseStmtM :: Stmt -> StateT Idents (Writer Idents) Stmt traverseStmtM (Timing _ stmt) = traverseStmtM stmt traverseStmtM (Subroutine (Ident f) args) = do case args of - Args [_, Just (Ident x), _] [] -> + Args [_, Ident x, _] [] -> -- assuming that no one will readmem into a local variable if f == "$readmemh" || f == "$readmemb" then lift $ tell $ Set.singleton x diff --git a/src/Convert/MultiplePacked.hs b/src/Convert/MultiplePacked.hs index 6454695..9ac846d 100644 --- a/src/Convert/MultiplePacked.hs +++ b/src/Convert/MultiplePacked.hs @@ -47,9 +47,9 @@ convertDescription other = other -- collects and converts declarations with multiple packed dimensions traverseDeclM :: Decl -> State Info Decl -traverseDeclM (Variable dir t ident a me) = do +traverseDeclM (Variable dir t ident a e) = do t' <- traverseTypeM t a ident - return $ Variable dir t' ident a me + return $ Variable dir t' ident a e traverseDeclM (Param s t ident e) = do t' <- traverseTypeM t [] ident return $ Param s t' ident e diff --git a/src/Convert/NestPI.hs b/src/Convert/NestPI.hs index 1bf984d..8cb076c 100644 --- a/src/Convert/NestPI.hs +++ b/src/Convert/NestPI.hs @@ -26,15 +26,15 @@ convert = (traverseDescriptions . convertDescription) isPI :: Description -> Bool isPI (PackageItem Import{}) = False - isPI (PackageItem item) = piName item /= Nothing + isPI (PackageItem item) = piName item /= "" isPI _ = False -- collects packages items missing collectDescriptionM :: Description -> Writer PIs () collectDescriptionM (PackageItem item) = do case piName item of - Nothing -> return () - Just ident -> tell $ Map.singleton ident item + "" -> return () + ident -> tell $ Map.singleton ident item collectDescriptionM _ = return () -- nests packages items missing from modules @@ -77,8 +77,8 @@ addItems _ _ [] = [] collectPIsM :: ModuleItem -> Writer Idents () collectPIsM (MIPackageItem item) = case piName item of - Nothing -> return () - Just ident -> tell $ Set.singleton ident + "" -> return () + ident -> tell $ Set.singleton ident collectPIsM _ = return () -- writes down the names of subroutine invocations @@ -98,14 +98,14 @@ collectTypenamesM (Alias _ x _) = tell $ Set.singleton x collectTypenamesM _ = return () -- returns the "name" of a package item, if it has one -piName :: PackageItem -> Maybe Identifier -piName (Function _ _ ident _ _) = Just ident -piName (Task _ ident _ _) = Just ident -piName (Typedef _ ident ) = Just ident -piName (Decl (Variable _ _ ident _ _)) = Just ident -piName (Decl (Param _ _ ident _)) = Just ident -piName (Decl (ParamType _ ident _)) = Just ident -piName (Decl (CommentDecl _)) = Nothing -piName (Import x y) = Just $ show $ Import x y -piName (Export _) = Nothing -piName (Directive _) = Nothing +piName :: PackageItem -> Identifier +piName (Function _ _ ident _ _) = ident +piName (Task _ ident _ _) = ident +piName (Typedef _ ident ) = ident +piName (Decl (Variable _ _ ident _ _)) = ident +piName (Decl (Param _ _ ident _)) = ident +piName (Decl (ParamType _ ident _)) = ident +piName (Decl (CommentDecl _)) = "" +piName (Import x y) = show $ Import x y +piName (Export _) = "" +piName (Directive _) = "" diff --git a/src/Convert/Package.hs b/src/Convert/Package.hs index 73b3df6..00903a3 100644 --- a/src/Convert/Package.hs +++ b/src/Convert/Package.hs @@ -98,7 +98,7 @@ prefixPackageItem packageName idents item = convertType (Enum t items rs) = Enum t items' rs where items' = map prefixItem items - prefixItem (x, me) = (prefix x, me) + prefixItem (x, e) = (prefix x, e) convertType other = other convertExpr (Ident x) = Ident $ prefix x convertExpr other = other @@ -120,8 +120,8 @@ collectDescriptionM (Package _ name items) = toPackageItems :: PackageItem -> PackageItems toPackageItems item = case piName item of - Nothing -> [] - Just x -> [(x, item)] + "" -> [] + x -> [(x, item)] isImport :: PackageItem -> Bool isImport (Import _ _) = True isImport _ = False @@ -146,8 +146,8 @@ traverseDescription packages description = writePIName :: ModuleItem -> Writer Idents () writePIName (MIPackageItem item) = case piName item of - Nothing -> return () - Just x -> tell $ Set.singleton x + "" -> return () + x -> tell $ Set.singleton x writePIName _ = return () traverseModuleItem :: Idents -> Packages -> ModuleItem -> ModuleItem @@ -177,14 +177,14 @@ traverseModuleItem _ _ item = traverseType other = other -- returns the "name" of a package item, if it has one -piName :: PackageItem -> Maybe Identifier -piName (Function _ _ ident _ _) = Just ident -piName (Task _ ident _ _) = Just ident -piName (Typedef _ ident ) = Just ident -piName (Decl (Variable _ _ ident _ _)) = Just ident -piName (Decl (Param _ _ ident _)) = Just ident -piName (Decl (ParamType _ ident _)) = Just ident -piName (Decl (CommentDecl _)) = Nothing -piName (Import _ _) = Nothing -piName (Export _) = Nothing -piName (Directive _) = Nothing +piName :: PackageItem -> Identifier +piName (Function _ _ ident _ _) = ident +piName (Task _ ident _ _) = ident +piName (Typedef _ ident ) = ident +piName (Decl (Variable _ _ ident _ _)) = ident +piName (Decl (Param _ _ ident _)) = ident +piName (Decl (ParamType _ ident _)) = ident +piName (Decl (CommentDecl _)) = "" +piName (Import _ _) = "" +piName (Export _) = "" +piName (Directive _) = "" diff --git a/src/Convert/ParamType.hs b/src/Convert/ParamType.hs index c2fa02a..aff0c17 100644 --- a/src/Convert/ParamType.hs +++ b/src/Convert/ParamType.hs @@ -99,11 +99,11 @@ convert files = where maybeTypeMap = snd $ info Map.! name typeMap = defaultInstance maybeTypeMap - existingNames = map maybeModuleName existing - alreadyExists = (flip elem existingNames) . maybeModuleName - maybeModuleName :: Description -> Maybe Identifier - maybeModuleName (Part _ _ _ _ x _ _) = Just x - maybeModuleName _ = Nothing + existingNames = map moduleName existing + alreadyExists = (flip elem existingNames) . moduleName + moduleName :: Description -> Identifier + moduleName (Part _ _ _ _ x _ _) = x + moduleName _ = "" replaceDefault _ other = [other] removeDefaultTypeParams :: Description -> Description diff --git a/src/Convert/SignCast.hs b/src/Convert/SignCast.hs index f3fa3eb..e879d82 100644 --- a/src/Convert/SignCast.hs +++ b/src/Convert/SignCast.hs @@ -23,7 +23,7 @@ convert = convertExpr :: Expr -> Expr convertExpr (Cast (Left (Implicit Signed [])) e) = - Call (Ident "$signed") (Args [Just e] []) + Call (Ident "$signed") (Args [e] []) convertExpr (Cast (Left (Implicit Unsigned [])) e) = - Call (Ident "$unsigned") (Args [Just e] []) + Call (Ident "$unsigned") (Args [e] []) convertExpr other = other diff --git a/src/Convert/Simplify.hs b/src/Convert/Simplify.hs index d99bc75..25d7ba0 100644 --- a/src/Convert/Simplify.hs +++ b/src/Convert/Simplify.hs @@ -70,13 +70,13 @@ convertExpr info (DimFn f v e) = DimFn f v e' where e' = simplify $ substitute info e -convertExpr info (Call (Ident "$clog2") (Args [Just e] [])) = +convertExpr info (Call (Ident "$clog2") (Args [e] [])) = if clog2' == clog2 then clog2 else clog2' where e' = simplify $ substitute info e - clog2 = Call (Ident "$clog2") (Args [Just e'] []) + clog2 = Call (Ident "$clog2") (Args [e'] []) clog2' = simplify clog2 convertExpr info (Mux cc aa bb) = if before == after diff --git a/src/Convert/SizeCast.hs b/src/Convert/SizeCast.hs index 9f7d193..2c46b98 100644 --- a/src/Convert/SizeCast.hs +++ b/src/Convert/SizeCast.hs @@ -97,7 +97,7 @@ traverseExprM = convertCastWithSigningM s e sg = do lift $ tell $ Set.singleton (s, sg) let f = castFnName s sg - let args = Args [Just e] [] + let args = Args [e] [] return $ Call (Ident f) args castFn :: Expr -> Signing -> Description @@ -109,7 +109,7 @@ castFn e sg = r = (simplify $ BinOp Sub e (Number "1"), Number "0") t = IntegerVector TLogic sg [r] fnName = castFnName e sg - decl = Variable Input t inp [] Nothing + decl = Variable Input t inp [] Nil castFnName :: Expr -> Signing -> String castFnName e sg = diff --git a/src/Convert/StarPort.hs b/src/Convert/StarPort.hs index 549311e..50dc50b 100644 --- a/src/Convert/StarPort.hs +++ b/src/Convert/StarPort.hs @@ -31,12 +31,12 @@ mapInstance modulePorts (Instance m p x r bindings) = alreadyBound :: [Identifier] alreadyBound = map fst bindings expandBinding :: PortBinding -> [PortBinding] - expandBinding ("*", Nothing) = + expandBinding ("*", Nil) = case Map.lookup m modulePorts of Just l -> - map (\port -> (port, Just $ Ident port)) $ + map (\port -> (port, Ident port)) $ filter (\s -> not $ elem s alreadyBound) $ l -- if we can't find it, just skip :( - Nothing -> [("*", Nothing)] + Nothing -> [("*", Nil)] expandBinding other = [other] mapInstance _ other = other diff --git a/src/Convert/Stream.hs b/src/Convert/Stream.hs index 081abc8..312a31b 100644 --- a/src/Convert/Stream.hs +++ b/src/Convert/Stream.hs @@ -20,9 +20,9 @@ convertDescription other = other streamerBlock :: Expr -> Expr -> (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt streamerBlock chunk size asgn output input = Block Seq "" - [ Variable Local t inp [] $ Just input - , Variable Local t out [] Nothing - , Variable Local (IntegerAtom TInteger Unspecified) idx [] Nothing + [ Variable Local t inp [] input + , Variable Local t out [] Nil + , Variable Local (IntegerAtom TInteger Unspecified) idx [] Nil ] [ For inits cmp incr stmt , If NoCheck cmp2 stmt2 Null diff --git a/src/Convert/Struct.hs b/src/Convert/Struct.hs index 8aa7581..a833c55 100644 --- a/src/Convert/Struct.hs +++ b/src/Convert/Struct.hs @@ -189,16 +189,13 @@ collectTFArgsM _ = return () traverseDeclM :: Structs -> Decl -> State Types Decl traverseDeclM structs origDecl = do case origDecl of - Variable d t x a me -> do + Variable d t x a e -> do let (tf, rs) = typeRanges t if isRangeable t then modify $ Map.insert x (tf $ a ++ rs) else return () - case me of - Nothing -> return origDecl - Just e -> do - e' <- convertDeclExpr x e - return $ Variable d t x a (Just e') + e' <- convertDeclExpr x e + return $ Variable d t x a e' Param s t x e -> do modify $ Map.insert x t e' <- convertDeclExpr x e @@ -223,7 +220,7 @@ packerFn structTf = Function Automatic (structTf []) fnName decls [retStmt] where Struct _ fields [] = structTf [] - toInput (t, x) = Variable Input t x [] Nothing + toInput (t, x) = Variable Input t x [] Nil decls = map toInput fields retStmt = Return $ Concat $ map (Ident . snd) fields fnName = packerFnName structTf @@ -269,6 +266,7 @@ convertAsgn structs types (lhs, expr) = -- try expression conversion by looking at the *outermost* type first convertExpr :: Type -> Expr -> Expr + convertExpr _ Nil = Nil convertExpr t (Mux c e1 e2) = Mux c e1' e2' where @@ -316,7 +314,7 @@ convertAsgn structs types (lhs, expr) = else if Map.member structTf structs then Call (Ident $ packerFnName structTf) - (Args (map (Just . snd) items) []) + (Args (map snd items) []) else Pattern items where @@ -551,9 +549,8 @@ convertCall structs types fn (Args pnArgs kwArgs) = args = Args (map snd $ map convertArg $ zip idxs pnArgs) (map convertArg kwArgs) - convertArg :: (Identifier, Maybe Expr) -> (Identifier, Maybe Expr) - convertArg (x, Nothing) = (x, Nothing) - convertArg (x, Just e ) = (x, Just e') + convertArg :: (Identifier, Expr) -> (Identifier, Expr) + convertArg (x, e) = (x, e') where (_, e') = convertAsgn structs types (LHSIdent $ f ++ ":" ++ x, e) diff --git a/src/Convert/Traverse.hs b/src/Convert/Traverse.hs index 3dc7b4b..e9bb5bc 100644 --- a/src/Convert/Traverse.hs +++ b/src/Convert/Traverse.hs @@ -300,13 +300,10 @@ traverseAssertionExprsM mapper = assertionMapper c' <- mapper c return $ Left (a, b, c') seqMatchItemMapper (Right (x, (Args l p))) = do - l' <- mapM maybeExprMapper l - pes <- mapM maybeExprMapper $ map snd p + l' <- mapM mapper l + pes <- mapM mapper $ map snd p let p' = zip (map fst p) pes return $ Right (x, Args l' p') - maybeExprMapper Nothing = return Nothing - maybeExprMapper (Just e) = - mapper e >>= return . Just ppMapper constructor p1 p2 = do p1' <- propExprMapper p1 p2' <- propExprMapper p2 @@ -331,10 +328,10 @@ traverseAssertionExprsM mapper = assertionMapper spMapper PropExprFollowsNO se pe propExprMapper (PropExprIff p1 p2) = ppMapper PropExprIff p1 p2 - propSpecMapper (PropertySpec ms me pe) = do - me' <- maybeExprMapper me + propSpecMapper (PropertySpec ms e pe) = do + e' <- mapper e pe' <- propExprMapper pe - return $ PropertySpec ms me' pe' + return $ PropertySpec ms e' pe' assertionExprMapper (Left e) = propSpecMapper e >>= return . Left assertionExprMapper (Right e) = @@ -408,10 +405,7 @@ traverseNestedExprsM :: Monad m => MapperM m Expr -> MapperM m Expr traverseNestedExprsM mapper = exprMapper where exprMapper e = mapper e >>= em - (_, _, _, _, typeMapper) = exprMapperHelpers exprMapper - maybeExprMapper Nothing = return Nothing - maybeExprMapper (Just e) = - exprMapper e >>= return . Just + (_, _, _, typeMapper) = exprMapperHelpers exprMapper typeOrExprMapper (Left t) = typeMapper t >>= return . Left typeOrExprMapper (Right e) = @@ -448,8 +442,8 @@ traverseNestedExprsM mapper = exprMapper return $ Stream o e' l' em (Call e (Args l p)) = do e' <- exprMapper e - l' <- mapM maybeExprMapper l - pes <- mapM maybeExprMapper $ map snd p + l' <- mapM exprMapper l + pes <- mapM exprMapper $ map snd p let p' = zip (map fst p) pes return $ Call e' (Args l' p') em (UniOp o e) = @@ -493,9 +487,9 @@ traverseNestedExprsM mapper = exprMapper em (Nil) = return Nil exprMapperHelpers :: Monad m => MapperM m Expr -> - (MapperM m Range, MapperM m (Maybe Expr), MapperM m Decl, MapperM m LHS, MapperM m Type) + (MapperM m Range, MapperM m Decl, MapperM m LHS, MapperM m Type) exprMapperHelpers exprMapper = - (rangeMapper, maybeExprMapper, declMapper, traverseNestedLHSsM lhsMapper, typeMapper) + (rangeMapper, declMapper, traverseNestedLHSsM lhsMapper, typeMapper) where rangeMapper (a, b) = do @@ -503,10 +497,6 @@ exprMapperHelpers exprMapper = b' <- exprMapper b return (a', b') - maybeExprMapper Nothing = return Nothing - maybeExprMapper (Just e) = - exprMapper e >>= return . Just - typeMapper' (TypeOf expr) = exprMapper expr >>= return . TypeOf typeMapper' t = do @@ -526,11 +516,11 @@ exprMapperHelpers exprMapper = declMapper (ParamType s x mt) = do mt' <- maybeTypeMapper mt return $ ParamType s x mt' - declMapper (Variable d t x a me) = do + declMapper (Variable d t x a e) = do t' <- typeMapper t a' <- mapM rangeMapper a - me' <- maybeExprMapper me - return $ Variable d t' x a' me' + e' <- exprMapper e + return $ Variable d t' x a' e' declMapper (CommentDecl c) = return $ CommentDecl c @@ -547,13 +537,13 @@ traverseExprsM' :: Monad m => TFStrategy -> MapperM m Expr -> MapperM m ModuleIt traverseExprsM' strat exprMapper = moduleItemMapper where - (rangeMapper, maybeExprMapper, declMapper, lhsMapper, typeMapper) + (rangeMapper, declMapper, lhsMapper, typeMapper) = exprMapperHelpers exprMapper stmtMapper = traverseNestedStmtsM (traverseStmtExprsM exprMapper) - portBindingMapper (p, me) = - maybeExprMapper me >>= \me' -> return (p, me') + portBindingMapper (p, e) = + exprMapper e >>= \e' -> return (p, e') paramBindingMapper (p, Left t) = typeMapper t >>= \t' -> return (p, Left t') @@ -616,12 +606,12 @@ traverseExprsM' strat exprMapper = moduleItemMapper moduleItemMapper (Modport x l) = mapM modportDeclMapper l >>= return . Modport x moduleItemMapper (NInputGate kw d x lhs exprs) = do - d' <- maybeExprMapper d + d' <- exprMapper d exprs' <- mapM exprMapper exprs lhs' <- lhsMapper lhs return $ NInputGate kw d' x lhs' exprs' moduleItemMapper (NOutputGate kw d x lhss expr) = do - d' <- maybeExprMapper d + d' <- exprMapper d lhss' <- mapM lhsMapper lhss expr' <- exprMapper expr return $ NOutputGate kw d' x lhss' expr' @@ -655,10 +645,9 @@ traverseExprsM' strat exprMapper = moduleItemMapper return $ GenCase e' cases' genItemMapper other = return other - modportDeclMapper (dir, ident, Just e) = do + modportDeclMapper (dir, ident, e) = do e' <- exprMapper e - return (dir, ident, Just e') - modportDeclMapper other = return other + return (dir, ident, e') traverseExprs' :: TFStrategy -> Mapper Expr -> Mapper ModuleItem traverseExprs' strat = unmonad $ traverseExprsM' strat @@ -676,8 +665,7 @@ traverseStmtExprsM :: Monad m => MapperM m Expr -> MapperM m Stmt traverseStmtExprsM exprMapper = flatStmtMapper where - (_, maybeExprMapper, declMapper, lhsMapper, _) - = exprMapperHelpers exprMapper + (_, declMapper, lhsMapper, _) = exprMapperHelpers exprMapper caseMapper (exprs, stmt) = do exprs' <- mapM exprMapper exprs @@ -715,8 +703,8 @@ traverseStmtExprsM exprMapper = flatStmtMapper flatStmtMapper (Timing event stmt) = return $ Timing event stmt flatStmtMapper (Subroutine e (Args l p)) = do e' <- exprMapper e - l' <- mapM maybeExprMapper l - pes <- mapM maybeExprMapper $ map snd p + l' <- mapM exprMapper l + pes <- mapM exprMapper $ map snd p let p' = zip (map fst p) pes return $ Subroutine e' (Args l' p') flatStmtMapper (Return expr) = @@ -897,7 +885,7 @@ collectExprTypesM = collectify traverseExprTypesM traverseTypeExprsM :: Monad m => MapperM m Expr -> MapperM m Type traverseTypeExprsM mapper = typeMapper - where (_, _, _, _, typeMapper) = exprMapperHelpers mapper + where (_, _, _, typeMapper) = exprMapperHelpers mapper traverseTypeExprs :: Mapper Expr -> Mapper Type traverseTypeExprs = unmonad traverseTypeExprsM @@ -918,8 +906,8 @@ traverseTypesM' strategy mapper item = fullMapper t >>= \t' -> return $ Param s t' x e declMapper (ParamType s x mt) = maybeMapper mt >>= \mt' -> return $ ParamType s x mt' - declMapper (Variable d t x a me) = - fullMapper t >>= \t' -> return $ Variable d t' x a me + declMapper (Variable d t x a e) = + fullMapper t >>= \t' -> return $ Variable d t' x a e declMapper (CommentDecl c) = return $ CommentDecl c miMapper (MIPackageItem (Typedef t x)) = fullMapper t >>= \t' -> return $ MIPackageItem $ Typedef t' x @@ -1111,9 +1099,9 @@ traverseScopesM declMapper moduleItemMapper stmtMapper = redirectModuleItem (MIPackageItem (Function ml t x decls stmts)) = do prevState <- get t' <- do - res <- declMapper $ Variable Local t x [] Nothing + res <- declMapper $ Variable Local t x [] Nil case res of - Variable Local newType _ [] Nothing -> return newType + Variable Local newType _ [] Nil -> return newType _ -> error $ "redirected func ret traverse failed: " ++ show res decls' <- mapM declMapper decls stmts' <- mapM fullStmtMapper stmts diff --git a/src/Convert/TypeOf.hs b/src/Convert/TypeOf.hs index d2e4088..f3c0f21 100644 --- a/src/Convert/TypeOf.hs +++ b/src/Convert/TypeOf.hs @@ -46,12 +46,12 @@ traverseDeclM decl = do item <- traverseModuleItemM (MIPackageItem $ Decl decl) let MIPackageItem (Decl decl') = item case decl' of - Variable d t ident a me -> do + Variable d t ident a e -> do let t' = injectRanges t a modify $ Map.insert ident t' return $ case t' of - UnpackedType t'' a' -> Variable d t'' ident a' me - _ -> Variable d t' ident [] me + UnpackedType t'' a' -> Variable d t'' ident a' e + _ -> Variable d t' ident [] e Param _ t ident _ -> do let t' = if t == Implicit Unspecified [] then IntegerAtom TInteger Unspecified diff --git a/src/Convert/UnpackedArray.hs b/src/Convert/UnpackedArray.hs index fdffbad..dc3b83f 100644 --- a/src/Convert/UnpackedArray.hs +++ b/src/Convert/UnpackedArray.hs @@ -40,9 +40,9 @@ convertDescription description = -- collects and converts multi-dimensional packed-array declarations traverseDeclM :: Decl -> ST Decl -traverseDeclM (orig @ (Variable dir _ x _ me)) = do +traverseDeclM (orig @ (Variable dir _ x _ e)) = do modify $ Map.insert x orig - () <- if dir /= Local || me /= Nothing + () <- if dir /= Local || e /= Nil then lift $ tell $ Set.singleton orig else return () return orig @@ -50,12 +50,12 @@ traverseDeclM other = return other -- pack the given decls marked for packing packDecl :: DeclSet -> Decl -> Decl -packDecl decls (orig @ (Variable d t x a me)) = do +packDecl decls (orig @ (Variable d t x a e)) = do if Set.member orig decls then do let (tf, rs) = typeRanges t let t' = tf $ a ++ rs - Variable d t' x [] me + Variable d t' x [] e else orig packDecl _ other = other @@ -73,9 +73,9 @@ traverseModuleItemM' (Instance a b c d bindings) = do return $ Instance a b c d bindings' where collectBinding :: PortBinding -> ST PortBinding - collectBinding (y, Just (Ident x)) = do + collectBinding (y, Ident x) = do flatUsageM x - return (y, Just (Ident x)) + return (y, Ident x) collectBinding other = return other traverseModuleItemM' other = return other diff --git a/src/Language/SystemVerilog/AST/Attr.hs b/src/Language/SystemVerilog/AST/Attr.hs index 1fd72e0..ad79c79 100644 --- a/src/Language/SystemVerilog/AST/Attr.hs +++ b/src/Language/SystemVerilog/AST/Attr.hs @@ -20,10 +20,10 @@ data Attr = Attr [AttrSpec] deriving Eq -type AttrSpec = (Identifier, Maybe Expr) +type AttrSpec = (Identifier, Expr) instance Show Attr where show (Attr specs) = printf "(* %s *)" $ commas $ map showSpec specs showSpec :: AttrSpec -> String -showSpec (x, me) = x ++ showAssignment me +showSpec (x, e) = x ++ showAssignment e diff --git a/src/Language/SystemVerilog/AST/Decl.hs b/src/Language/SystemVerilog/AST/Decl.hs index 1bff7a0..d84db21 100644 --- a/src/Language/SystemVerilog/AST/Decl.hs +++ b/src/Language/SystemVerilog/AST/Decl.hs @@ -22,15 +22,16 @@ import Language.SystemVerilog.AST.Expr (Expr, Range, showRanges, showAssignment) data Decl = Param ParamScope Type Identifier Expr | ParamType ParamScope Identifier (Maybe Type) - | Variable Direction Type Identifier [Range] (Maybe Expr) + | Variable Direction Type Identifier [Range] Expr | CommentDecl String deriving (Eq, Ord) instance Show Decl where showList l _ = unlines' $ map show l show (Param s t x e) = printf "%s %s%s = %s;" (show s) (showPad t) x (show e) - show (ParamType s x mt) = printf "%s type %s%s;" (show s) x (showAssignment mt) - show (Variable d t x a me) = printf "%s%s%s%s%s;" (showPad d) (showPad t) x (showRanges a) (showAssignment me) + show (ParamType s x mt) = printf "%s type %s%s;" (show s) x tStr + where tStr = maybe "" ((" = " ++) . show) mt + show (Variable d t x a e) = printf "%s%s%s%s%s;" (showPad d) (showPad t) x (showRanges a) (showAssignment e) show (CommentDecl c) = if elem '\n' c then "// " ++ show c diff --git a/src/Language/SystemVerilog/AST/Expr.hs b/src/Language/SystemVerilog/AST/Expr.hs index 0e545f9..2031f8a 100644 --- a/src/Language/SystemVerilog/AST/Expr.hs +++ b/src/Language/SystemVerilog/AST/Expr.hs @@ -127,15 +127,14 @@ instance Show Expr where showsPrec _ e = \s -> show e ++ s data Args - = Args [Maybe Expr] [(Identifier, Maybe Expr)] + = Args [Expr] [(Identifier, Expr)] deriving (Eq, Ord) instance Show Args where show (Args pnArgs kwArgs) = "(" ++ (commas strs) ++ ")" where - strs = (map showPnArg pnArgs) ++ (map showKwArg kwArgs) - showPnArg = maybe "" show - showKwArg (x, me) = printf ".%s(%s)" x (showPnArg me) + strs = (map show pnArgs) ++ (map showKwArg kwArgs) + showKwArg (x, e) = printf ".%s(%s)" x (show e) data PartSelectMode = NonIndexed @@ -177,9 +176,9 @@ instance Show DimFn where show FnSize = "$size" -showAssignment :: Show a => Maybe a -> String -showAssignment Nothing = "" -showAssignment (Just val) = " = " ++ show val +showAssignment :: Expr -> String +showAssignment Nil = "" +showAssignment val = " = " ++ show val showRanges :: [Range] -> String showRanges [] = "" @@ -241,7 +240,7 @@ simplify (orig @ (Repeat (Number n) exprs)) = simplify (Concat [expr]) = expr simplify (Concat exprs) = Concat $ filter (/= Concat []) exprs -simplify (orig @ (Call (Ident "$clog2") (Args [Just (Number n)] []))) = +simplify (orig @ (Call (Ident "$clog2") (Args [Number n] []))) = case readNumber n of Nothing -> orig Just x -> Number $ show $ clog2 x diff --git a/src/Language/SystemVerilog/AST/ModuleItem.hs b/src/Language/SystemVerilog/AST/ModuleItem.hs index 1cf6496..4c2b7af 100644 --- a/src/Language/SystemVerilog/AST/ModuleItem.hs +++ b/src/Language/SystemVerilog/AST/ModuleItem.hs @@ -17,7 +17,6 @@ module Language.SystemVerilog.AST.ModuleItem ) where import Data.List (intercalate) -import Data.Maybe (fromJust, isJust) import Text.Printf (printf) import Language.SystemVerilog.AST.ShowHelp @@ -43,8 +42,8 @@ data ModuleItem | Initial Stmt | Final Stmt | MIPackageItem PackageItem - | NInputGate NInputGateKW (Maybe Expr) Identifier LHS [Expr] - | NOutputGate NOutputGateKW (Maybe Expr) Identifier [LHS] Expr + | NInputGate NInputGateKW Expr Identifier LHS [Expr] + | NOutputGate NOutputGateKW Expr Identifier [LHS] Expr | AssertionItem AssertionItem deriving Eq @@ -77,17 +76,17 @@ showPorts :: [PortBinding] -> String showPorts ports = indentedParenList $ map showPort ports showPort :: PortBinding -> String -showPort ("*", Nothing) = ".*" +showPort ("*", Nil) = ".*" showPort (i, arg) = if i == "" - then show (fromJust arg) - else printf ".%s(%s)" i (if isJust arg then show $ fromJust arg else "") + then show arg + else printf ".%s(%s)" i (show arg) -showGate :: Show k => k -> Maybe Expr -> Identifier -> [String] -> String +showGate :: Show k => k -> Expr -> Identifier -> [String] -> String showGate kw d x args = printf "%s %s%s(%s);" (show kw) delayStr nameStr (commas args) where - delayStr = maybe "" (showPad . Delay) d + delayStr = if d == Nil then "" else showPad $ Delay d nameStr = showPad $ Ident x showParams :: [ParamBinding] -> String @@ -100,16 +99,16 @@ showParam (i, arg) = where fmt = if i == "" then "%s%s" else ".%s(%s)" showModportDecl :: ModportDecl -> String -showModportDecl (dir, ident, me) = - if me == Just (Ident ident) +showModportDecl (dir, ident, e) = + if e == Ident ident then printf "%s %s" (show dir) ident - else printf "%s .%s(%s)" (show dir) ident (maybe "" show me) + else printf "%s .%s(%s)" (show dir) ident (show e) -type PortBinding = (Identifier, Maybe Expr) +type PortBinding = (Identifier, Expr) type ParamBinding = (Identifier, TypeOrExpr) -type ModportDecl = (Direction, Identifier, Maybe Expr) +type ModportDecl = (Direction, Identifier, Expr) data AlwaysKW = Always diff --git a/src/Language/SystemVerilog/AST/Stmt.hs b/src/Language/SystemVerilog/AST/Stmt.hs index 31e5c66..f84de2d 100644 --- a/src/Language/SystemVerilog/AST/Stmt.hs +++ b/src/Language/SystemVerilog/AST/Stmt.hs @@ -244,18 +244,18 @@ showAssertionExpr (Left e) = printf "property (%s\n)" (show e) showAssertionExpr (Right e) = printf "(%s)" (show e) data PropertySpec - = PropertySpec (Maybe Sense) (Maybe Expr) PropExpr + = PropertySpec (Maybe Sense) Expr PropExpr deriving Eq instance Show PropertySpec where - show (PropertySpec ms me pe) = - printf "%s%s\n\t%s" msStr meStr (show pe) + show (PropertySpec ms e pe) = + printf "%s%s\n\t%s" msStr eStr (show pe) where msStr = case ms of Nothing -> "" Just s -> printf "@(%s) " (show s) - meStr = case me of - Nothing -> "" - Just e -> printf "disable iff (%s)" (show e) + eStr = case e of + Nil -> "" + _ -> printf "disable iff (%s)" (show e) data ViolationCheck = Unique diff --git a/src/Language/SystemVerilog/AST/Type.hs b/src/Language/SystemVerilog/AST/Type.hs index 8dfe63b..d94a374 100644 --- a/src/Language/SystemVerilog/AST/Type.hs +++ b/src/Language/SystemVerilog/AST/Type.hs @@ -33,7 +33,7 @@ import Language.SystemVerilog.AST.ShowHelp type Identifier = String -type Item = (Identifier, Maybe Expr) +type Item = (Identifier, Expr) type Field = (Type, Identifier) data Type @@ -63,7 +63,7 @@ instance Show Type where show (Enum t vals r) = printf "enum %s{%s}%s" tStr (commas $ map showVal vals) (showRanges r) where tStr = showPad t - showVal :: (Identifier, Maybe Expr) -> String + showVal :: (Identifier, Expr) -> String showVal (x, e) = x ++ (showAssignment e) show (Struct p items r) = printf "struct %s{\n%s\n}%s" (showPad p) (showFields items) (showRanges r) show (Union p items r) = printf "union %s{\n%s\n}%s" (showPad p) (showFields items) (showRanges r) diff --git a/src/Language/SystemVerilog/Parser/Parse.y b/src/Language/SystemVerilog/Parser/Parse.y index 3903cd9..a87111a 100644 --- a/src/Language/SystemVerilog/Parser/Parse.y +++ b/src/Language/SystemVerilog/Parser/Parse.y @@ -509,7 +509,7 @@ NonIntegerType :: { NonIntegerType } | "string" { TString } | "event" { TEvent } -EnumItems :: { [(Identifier, Maybe Expr)] } +EnumItems :: { [(Identifier, Expr)] } : VariablePortIdentifiers { $1 } StructItems :: { [(Type, Identifier)] } @@ -589,12 +589,12 @@ ModportPortsDeclaration(delim) :: { [ModportDecl] } : ModportSimplePortsDeclaration(delim) { $1 } ModportSimplePortsDeclaration(delim) :: { [ModportDecl] } : Direction ModportSimplePorts delim { map (\(a, b) -> ($1, a, b)) $2 } -ModportSimplePorts :: { [(Identifier, Maybe Expr)] } +ModportSimplePorts :: { [(Identifier, Expr)] } : ModportSimplePort { [$1] } | ModportSimplePorts "," ModportSimplePort { $1 ++ [$3] } -ModportSimplePort :: { (Identifier, Maybe Expr) } - : "." Identifier "(" opt(Expr) ")" { ($2, $4) } - | Identifier { ($1, Just $ Ident $1) } +ModportSimplePort :: { (Identifier, Expr) } + : "." Identifier "(" ExprOrNil ")" { ($2, $4) } + | Identifier { ($1, Ident $1) } Identifier :: { Identifier } : simpleIdentifier { tokenString $1 } @@ -636,12 +636,12 @@ DeclTokenAsgn :: { DeclToken } : "=" opt(DelayOrEvent) Expr {% posInject \p -> DTAsgn p AsgnOpEq $2 $3 } | AsgnBinOp Expr {% posInject \p -> DTAsgn p $1 Nothing $2 } -VariablePortIdentifiers :: { [(Identifier, Maybe Expr)] } +VariablePortIdentifiers :: { [(Identifier, Expr)] } : VariablePortIdentifier { [$1] } | VariablePortIdentifiers "," VariablePortIdentifier { $1 ++ [$3] } -VariablePortIdentifier :: { (Identifier, Maybe Expr) } - : Identifier { ($1, Nothing) } - | Identifier "=" Expr { ($1, Just $3) } +VariablePortIdentifier :: { (Identifier, Expr) } + : Identifier { ($1, Nil) } + | Identifier "=" Expr { ($1, $3 ) } Direction :: { Direction } : "inout" { Inout } @@ -705,8 +705,8 @@ SimpleImmediateAssertionStatement :: { Assertion } | "cover" "(" Expr ")" Stmt { Cover (Right $3) $5 } PropertySpec :: { PropertySpec } - : opt(ClockingEvent) "disable" "iff" "(" Expr ")" PropExpr { PropertySpec $1 (Just $5) $7 } - | opt(ClockingEvent) PropExpr { PropertySpec $1 (Nothing) $2 } + : opt(ClockingEvent) "disable" "iff" "(" Expr ")" PropExpr { PropertySpec $1 $5 $7 } + | opt(ClockingEvent) PropExpr { PropertySpec $1 Nil $2 } PropExpr :: { PropExpr } : SeqExpr { PropExpr $1 } @@ -752,23 +752,26 @@ AttrSpecs :: { [AttrSpec] } : AttrSpec { [$1] } | AttrSpecs "," AttrSpec { $1 ++ [$3] } AttrSpec :: { AttrSpec } - : Identifier "=" Expr { ($1, Just $3) } - | Identifier { ($1, Nothing) } + : Identifier "=" Expr { ($1, $3 ) } + | Identifier { ($1, Nil) } -NInputGates :: { [(Maybe Expr, Identifier, LHS, [Expr])] } +NInputGates :: { [(Expr, Identifier, LHS, [Expr])] } : NInputGate { [$1] } | NInputGates "," NInputGate { $1 ++ [$3]} -NOutputGates :: { [(Maybe Expr, Identifier, [LHS], Expr)] } +NOutputGates :: { [(Expr, Identifier, [LHS], Expr)] } : NOutputGate { [$1] } | NOutputGates "," NOutputGate { $1 ++ [$3]} -NInputGate :: { (Maybe Expr, Identifier, LHS, [Expr]) } - : opt(DelayControl) opt(Identifier) "(" LHS "," Exprs ")" { ($1, fromMaybe "" $2, $4, $6) } -NOutputGate :: { (Maybe Expr, Identifier, [LHS], Expr) } - : opt(DelayControl) opt(Identifier) "(" NOutputGateItems { ($1, fromMaybe "" $2, fst $4, snd $4) } +NInputGate :: { (Expr, Identifier, LHS, [Expr]) } + : DelayControlOrNil opt(Identifier) "(" LHS "," Exprs ")" { ($1, fromMaybe "" $2, $4, $6) } +NOutputGate :: { (Expr, Identifier, [LHS], Expr) } + : DelayControlOrNil opt(Identifier) "(" NOutputGateItems { ($1, fromMaybe "" $2, fst $4, snd $4) } NOutputGateItems :: { ([LHS], Expr) } : Expr ")" { ([], $1) } | Expr "," NOutputGateItems { (fst $3 ++ [toLHS $1], snd $3) } +DelayControlOrNil :: { Expr } + : DelayControl { $1 } + | {- empty -} { Nil } NInputGateKW :: { NInputGateKW } : "and" { GateAnd } @@ -937,10 +940,10 @@ PortBindingsInside :: { [PortBinding] } : PortBinding { [$1] } | PortBinding "," PortBindingsInside { $1 : $3} PortBinding :: { PortBinding } - : "." Identifier "(" opt(Expr) ")" { ($2, $4) } - | "." Identifier { ($2, Just $ Ident $2) } - | Expr { ("", Just $1) } - | ".*" { ("*", Nothing) } + : "." Identifier "(" ExprOrNil ")" { ($2, $4) } + | "." Identifier { ($2, Ident $2) } + | Expr { ("", $1) } + | ".*" { ("*", Nil) } ParamBindings :: { [ParamBinding] } : "#" "(" ")" { [] } @@ -984,8 +987,7 @@ StmtNonBlock :: { Stmt } | "for" "(" ForInit ForCond ForStep ")" Stmt { For $3 $4 $5 $7 } | Unique CaseKW "(" Expr ")" Cases "endcase" { Case $1 $2 $4 $6 } | TimingControl Stmt { Timing $1 $2 } - | "return" Expr ";" { Return $2 } - | "return" ";" { Return Nil } + | "return" ExprOrNil ";" { Return $2 } | "break" ";" { Break } | "continue" ";" { Continue } | "while" "(" Expr ")" Stmt { While $3 $5 } @@ -1131,22 +1133,22 @@ Time :: { String } CallArgs :: { Args } : "(" CallArgsInside ")" { $2 } CallArgsInside :: { Args } - : {- empty -} { Args [ ] [] } - | NamedCallArgsFollow { Args [ ] $1 } - | Expr NamedCallArgs { Args [Just $1 ] $2 } - | UnnamedCallArgs NamedCallArgs { Args (Nothing : $1) $2 } - | Expr UnnamedCallArgs NamedCallArgs { Args (Just $1 : $2) $3 } -UnnamedCallArgs :: { [Maybe Expr] } - : "," opt(Expr) { [$2] } - | UnnamedCallArgs "," opt(Expr) { $1 ++ [$3] } -NamedCallArgs :: { [(Identifier, Maybe Expr)] } + : {- empty -} { Args [ ] [] } + | NamedCallArgsFollow { Args [ ] $1 } + | Expr NamedCallArgs { Args [$1 ] $2 } + | UnnamedCallArgs NamedCallArgs { Args (Nil : $1) $2 } + | Expr UnnamedCallArgs NamedCallArgs { Args ($1 : $2) $3 } +UnnamedCallArgs :: { [Expr] } + : "," ExprOrNil { [$2] } + | UnnamedCallArgs "," ExprOrNil { $1 ++ [$3] } +NamedCallArgs :: { [(Identifier, Expr)] } : {- empty -} { [] } | "," NamedCallArgsFollow { $2 } -NamedCallArgsFollow :: { [(Identifier, Maybe Expr)] } +NamedCallArgsFollow :: { [(Identifier, Expr)] } : NamedCallArg { [$1] } | NamedCallArgsFollow "," NamedCallArg { $1 ++ [$3] } -NamedCallArg :: { (Identifier, Maybe Expr) } - : "." Identifier "(" opt(Expr) ")" { ($2, $4) } +NamedCallArg :: { (Identifier, Expr) } + : "." Identifier "(" ExprOrNil ")" { ($2, $4) } Exprs :: { [Expr] } : Expr { [$1] } @@ -1230,6 +1232,10 @@ Expr :: { Expr } | "~^" Expr %prec REDUCE_OP { UniOp RedXnor $2 } | "^~" Expr %prec REDUCE_OP { UniOp RedXnor $2 } +ExprOrNil :: { Expr } + : Expr { $1 } + | {- empty -} { Nil } + PatternItems :: { [(Identifier, Expr)] } : PatternNamedItems { $1 } | PatternUnnamedItems { zip (repeat "") $1 } @@ -1373,15 +1379,15 @@ combineDeclsAndStmts :: ([Decl], [Stmt]) -> ([Decl], [Stmt]) -> ([Decl], [Stmt]) combineDeclsAndStmts (a1, b1) (a2, b2) = (a1 ++ a2, b1 ++ b2) makeInput :: Decl -> Decl -makeInput (Variable Local t x a me) = Variable Input t x a me -makeInput (Variable Input t x a me) = Variable Input t x a me +makeInput (Variable Local t x a e) = Variable Input t x a e +makeInput (Variable Input t x a e) = Variable Input t x a e makeInput (CommentDecl c) = CommentDecl c makeInput other = error $ "unexpected non-var or non-input decl: " ++ (show other) defaultFuncInput :: Decl -> Decl -defaultFuncInput (Variable dir (Implicit sg rs) x a me) = - Variable dir t x a me +defaultFuncInput (Variable dir (Implicit sg rs) x a e) = + Variable dir t x a e where t = if dir == Input || dir == Inout then IntegerVector TLogic sg rs diff --git a/src/Language/SystemVerilog/Parser/ParseDecl.hs b/src/Language/SystemVerilog/Parser/ParseDecl.hs index 8d9becf..d453fbe 100644 --- a/src/Language/SystemVerilog/Parser/ParseDecl.hs +++ b/src/Language/SystemVerilog/Parser/ParseDecl.hs @@ -46,7 +46,6 @@ module Language.SystemVerilog.Parser.ParseDecl ) where import Data.List (findIndex, findIndices, partition) -import Data.Maybe (mapMaybe) import Language.SystemVerilog.AST import Language.SystemVerilog.Parser.Tokens (Position(..)) @@ -112,20 +111,20 @@ parseDTsAsPortDecls pieces = propagateDirections :: Direction -> [Decl] -> [Decl] propagateDirections dir (decl @ (Variable _ InterfaceT{} _ _ _) : decls) = decl : propagateDirections dir decls - propagateDirections lastDir (Variable currDir t x a me : decls) = + propagateDirections lastDir (Variable currDir t x a e : decls) = decl : propagateDirections dir decls where - decl = Variable dir t x a me + decl = Variable dir t x a e dir = if currDir == Local then lastDir else currDir propagateDirections dir (decl : decls) = decl : propagateDirections dir decls propagateDirections _ [] = [] portNames :: [Decl] -> [Identifier] - portNames items = mapMaybe portName items - portName :: Decl -> Maybe Identifier - portName (Variable _ _ ident _ _) = Just ident - portName CommentDecl{} = Nothing + portNames = filter (not . null) . map portName + portName :: Decl -> Identifier + portName (Variable _ _ ident _ _) = ident + portName CommentDecl{} = "" portName decl = error $ "unexpected non-variable port declaration: " ++ (show decl) @@ -315,12 +314,12 @@ takeLHSStep _ _ = Nothing -- batches together separate declaration lists -type Triplet = (Identifier, [Range], Maybe Expr) +type Triplet = (Identifier, [Range], Expr) type Component = (Direction, Type, [Triplet]) finalize :: (Position, Component) -> [Decl] finalize (pos, (dir, typ, trips)) = CommentDecl ("Trace: " ++ show pos) : - map (\(x, a, me) -> Variable dir typ x a me) trips + map (\(x, a, e) -> Variable dir typ x a e) trips -- internal; entrypoint of the critical portion of our parser @@ -354,11 +353,11 @@ takeTrips l0 force = then ([], l0) else (trip : trips, l5) where - (x , l1) = takeIdent l0 - (a , l2) = takeRanges l1 - (me, l3) = takeAsgn l2 - (_ , l4) = takeComma l3 - trip = (x, a, me) + (x, l1) = takeIdent l0 + (a, l2) = takeRanges l1 + (e, l3) = takeAsgn l2 + (_, l4) = takeComma l3 + trip = (x, a, e) (trips, l5) = takeTrips l4 False tripLookahead :: [DeclToken] -> Bool @@ -369,7 +368,7 @@ tripLookahead l0 = False -- if the identifier is the last token, or if it assigned a value, then we -- know we must have a valid triplet ahead - else if null l1 || asgn /= Nothing then + else if null l1 || asgn /= Nil then True -- if there is an ident followed by some number of ranges, and that's it, -- then there is a trailing declaration of an array ahead @@ -442,12 +441,12 @@ takeRanges (token : tokens) = -- both for standard declarations and in `parseDTsAsDeclOrStmt`, where we're -- checking for an assignment statement. The other entry points disallow -- `AsgnOpNonBlocking`, so this doesn't liberalize the parser. -takeAsgn :: [DeclToken] -> (Maybe Expr, [DeclToken]) +takeAsgn :: [DeclToken] -> (Expr, [DeclToken]) takeAsgn (DTAsgn _ op Nothing e : rest) = if op == AsgnOpEq || op == AsgnOpNonBlocking - then (Just e , rest) - else (Nothing, rest) -takeAsgn rest = (Nothing, rest) + then (e , rest) + else (Nil, rest) +takeAsgn rest = (Nil, rest) takeComma :: [DeclToken] -> (Bool, [DeclToken]) takeComma [] = (False, [])