luke
/
sv2v
mirror of https://github.com/zachjs/sv2v.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

reduce usage of maybe

This commit is contained in:
Zachary Snow 2020-06-14 15:56:09 -04:00
parent b71e0f5346
commit 12be569742
31 changed files with 250 additions and 260 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/Convert/BlockDecl.hs
View File

@ -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

4
src/Convert/EmptyArgs.hs
View File

@ -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

9
src/Convert/Enum.hs
View File

@ -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'

14
src/Convert/ForDecl.hs
View File

@ -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" []

2
src/Convert/Foreach.hs
View File

@ -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))

2
src/Convert/FuncRoutine.hs
View File

@ -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

40
src/Convert/Interface.hs
View File

@ -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

4
src/Convert/Jump.hs
View File

@ -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))

9
src/Convert/KWArgs.hs
View File

@ -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) =

19
src/Convert/Logic.hs
View File

@ -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

4
src/Convert/MultiplePacked.hs
View File

@ -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

32
src/Convert/NestPI.hs
View File

@ -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 _) = ""

32
src/Convert/Package.hs
View File

@ -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 _) = ""

10
src/Convert/ParamType.hs
View File

@ -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

4
src/Convert/SignCast.hs
View File

@ -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

4
src/Convert/Simplify.hs
View File

@ -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

4
src/Convert/SizeCast.hs
View File

@ -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 =

6
src/Convert/StarPort.hs
View File

@ -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

6
src/Convert/Stream.hs
View File

@ -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

19
src/Convert/Struct.hs
View File

@ -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)

68
src/Convert/Traverse.hs
View File

@ -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

6
src/Convert/TypeOf.hs
View File

@ -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

12
src/Convert/UnpackedArray.hs
View File

@ -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

4
src/Language/SystemVerilog/AST/Attr.hs
View File

@ -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

7
src/Language/SystemVerilog/AST/Decl.hs
View File

@ -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

15
src/Language/SystemVerilog/AST/Expr.hs
View File

@ -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

25
src/Language/SystemVerilog/AST/ModuleItem.hs
View File

@ -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

12
src/Language/SystemVerilog/AST/Stmt.hs
View File

@ -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

4
src/Language/SystemVerilog/AST/Type.hs
View File

@ -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)

88
src/Language/SystemVerilog/Parser/Parse.y
View File

@ -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

37
src/Language/SystemVerilog/Parser/ParseDecl.hs
View File

@ -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, [])