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

LHSs are recursive (as they should have been)

This commit is contained in:
Zachary Snow 2019-03-04 15:16:53 -05:00
parent b95af2b6d1
commit 59efba06ac
6 changed files with 53 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/Convert/Logic.hs
View File

@ -39,9 +39,6 @@ regIdents :: ModuleItem -> Writer RegIdents ()
regIdents (AlwaysC _ stmt) = collectStmtLHSsM idents stmt
where
idents :: LHS -> Writer RegIdents ()
idents (LHS vx ) = tell $ Set.singleton vx
idents (LHSBit vx _) = tell $ Set.singleton vx
idents (LHSRange vx _) = tell $ Set.singleton vx
idents (LHSConcat lhss) = mapM idents lhss >>= \_ -> return ()
idents (LHSDot lhs _) = idents lhs
idents (LHSIdent vx ) = tell $ Set.singleton vx
idents _ = return () -- the collector recurses for us
regIdents _ = return ()

24
src/Convert/PackedArray.hs
View File

@ -95,11 +95,9 @@ collectExpr (IdentRange i _) = recordSeqUsage i
collectExpr (IdentBit i _) = recordIdxUsage i
collectExpr _ = return ()
collectLHS :: LHS -> State Info ()
collectLHS (LHS i ) = recordSeqUsage i
collectLHS (LHSRange i _) = recordSeqUsage i
collectLHS (LHSBit i _) = recordIdxUsage i
collectLHS (LHSConcat lhss) = mapM collectLHS lhss >>= \_ -> return ()
collectLHS (LHSDot lhs _) = collectLHS lhs
collectLHS (LHSIdent i) = recordSeqUsage i
collectLHS (LHSBit (LHSIdent i) _) = recordIdxUsage i
collectLHS _ = return () -- the collect recurses for us
-- VCS doesn't like port declarations inside of `generate` blocks, so we hoist
-- them out with this function. This obviously isn't ideal, but it's a
@ -167,8 +165,8 @@ unflattener writeToFlatVariant arr (t, (majorHi, majorLo)) =
(BinOp Mul (Ident index) size))
, GenModuleItem $ (uncurry Assign) $
if not writeToFlatVariant
then (LHSBit arrUnflat $ Ident index, IdentRange arr origRange)
else (LHSRange arr origRange, IdentBit arrUnflat $ Ident index)
then (LHSBit (LHSIdent arrUnflat) $ Ident index, IdentRange arr origRange)
else (LHSRange (LHSIdent arr) origRange, IdentBit arrUnflat $ Ident index)
]
]
where
@ -257,18 +255,18 @@ rewriteModuleItem info =
rewriteExpr other = other
rewriteLHS :: LHS -> LHS
rewriteLHS (LHS x ) = LHS (rewriteAsgnIdent x)
rewriteLHS (LHSBit x e) = LHSBit (rewriteAsgnIdent x) e
rewriteLHS (LHSRange x r) = LHSRange (rewriteAsgnIdent x) r
rewriteLHS (LHSIdent x ) = LHSIdent (rewriteAsgnIdent x)
rewriteLHS (LHSBit l e) = LHSBit (rewriteLHS l) e
rewriteLHS (LHSRange l r) = LHSRange (rewriteLHS l) r
rewriteLHS (LHSDot l x) = LHSDot (rewriteLHS l) x
rewriteLHS (LHSConcat ls) = LHSConcat $ map rewriteLHS ls
rewriteLHS (LHSDot lhs x) = LHSDot (rewriteLHS lhs) x
rewriteStmt :: Stmt -> Stmt
rewriteStmt (AsgnBlk lhs expr) = convertAssignment AsgnBlk lhs expr
rewriteStmt (Asgn lhs expr) = convertAssignment Asgn lhs expr
rewriteStmt other = other
convertAssignment :: (LHS -> Expr -> Stmt) -> LHS -> Expr -> Stmt
convertAssignment constructor (lhs @ (LHS ident)) (expr @ (Repeat _ exprs)) =
convertAssignment constructor (lhs @ (LHSIdent ident)) (expr @ (Repeat _ exprs)) =
if Map.member ident typeDims
then For inir chkr incr assign
else constructor (rewriteLHS lhs) expr
@ -276,7 +274,7 @@ rewriteModuleItem info =
(_, (a, b)) = typeDims Map.! ident
index = prefix $ ident ++ "_repeater_index"
assign = constructor
(LHSBit (prefix ident) (Ident index))
(LHSBit (LHSIdent $ prefix ident) (Ident index))
(Concat exprs)
inir = (index, b)
chkr = BinOp Le (Ident index) a

17
src/Convert/Traverse.hs
View File

@ -142,8 +142,9 @@ traverseNestedStmtsM mapper = fullMapper
traverseStmtLHSsM :: Monad m => MapperM m LHS -> MapperM m Stmt
traverseStmtLHSsM mapper = traverseNestedStmtsM stmtMapper
where
stmtMapper (AsgnBlk lhs expr) = mapper lhs >>= \lhs' -> return $ AsgnBlk lhs' expr
stmtMapper (Asgn lhs expr) = mapper lhs >>= \lhs' -> return $ Asgn lhs' expr
fullMapper = traverseNestedLHSsM mapper
stmtMapper (AsgnBlk lhs expr) = fullMapper lhs >>= \lhs' -> return $ AsgnBlk lhs' expr
stmtMapper (Asgn lhs expr) = fullMapper lhs >>= \lhs' -> return $ Asgn lhs' expr
stmtMapper other = return other
traverseStmtLHSs :: Mapper LHS -> Mapper Stmt
@ -285,7 +286,7 @@ traverseLHSsM mapper item =
traverseStmtsM (traverseStmtLHSsM mapper) item >>= traverseModuleItemLHSsM
where
traverseModuleItemLHSsM (Assign lhs expr) = do
lhs' <- mapper lhs
lhs' <- traverseNestedLHSsM mapper lhs
return $ Assign lhs' expr
traverseModuleItemLHSsM other = return other
@ -294,6 +295,16 @@ traverseLHSs = unmonad traverseLHSsM
collectLHSsM :: Monad m => CollectorM m LHS -> CollectorM m ModuleItem
collectLHSsM = collectify traverseLHSsM
traverseNestedLHSsM :: Monad m => MapperM m LHS -> MapperM m LHS
traverseNestedLHSsM mapper = fullMapper
where
fullMapper lhs = tl lhs >>= mapper
tl (LHSIdent x ) = return $ LHSIdent x
tl (LHSBit l e ) = fullMapper l >>= \l' -> return $ LHSBit l' e
tl (LHSRange l r ) = fullMapper l >>= \l' -> return $ LHSRange l' r
tl (LHSDot l x ) = fullMapper l >>= \l' -> return $ LHSDot l' x
tl (LHSConcat lhss) = mapM fullMapper lhss >>= return . LHSConcat
traverseDeclsM :: Monad m => MapperM m Decl -> MapperM m ModuleItem
traverseDeclsM mapper item = do
item' <- miMapperA item

16
src/Language/SystemVerilog/AST.hs
View File

@ -351,19 +351,19 @@ instance Show Expr where
showPatternItem (Just n , e) = printf "%s: %s" n (show e)
data LHS
= LHS Identifier
| LHSBit Identifier Expr
| LHSRange Identifier Range
= LHSIdent Identifier
| LHSBit LHS Expr
| LHSRange LHS Range
| LHSDot LHS Identifier
| LHSConcat [LHS]
deriving Eq
instance Show LHS where
show (LHS a ) = a
show (LHSBit a b ) = printf "%s[%s]" a (show b)
show (LHSRange a (b, c)) = printf "%s[%s:%s]" a (show b) (show c)
show (LHSConcat a ) = printf "{%s}" (commas $ map show a)
show (LHSDot a b ) = printf "%s.%s" (show a) b
show (LHSIdent x ) = x
show (LHSBit l e ) = printf "%s[%s]" (show l) (show e)
show (LHSRange l (a, b)) = printf "%s[%s:%s]" (show l) (show a) (show b)
show (LHSDot l x ) = printf "%s.%s" (show l) x
show (LHSConcat lhss ) = printf "{%s}" (commas $ map show lhss)
data CaseKW
= CaseN

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

@ -230,6 +230,7 @@ ParamDecl(delim) :: { [ModuleItem] }
PortDecls :: { ([Identifier], [ModuleItem]) }
: "(" DeclTokens(")") { parseDTsAsPortDecls $2 }
| "(" ")" { ([], []) }
| {- empty -} { ([], []) }
ModportItems :: { [(Identifier, [ModportDecl])] }
@ -360,15 +361,15 @@ Range :: { Range }
: "[" Expr ":" Expr "]" { ($2, $4) }
LHS :: { LHS }
: Identifier { LHS $1 }
| Identifier Range { LHSRange $1 $2 }
| Identifier "[" Expr "]" { LHSBit $1 $3 }
| "{" LHSs "}" { LHSConcat $2 }
| LHS "." Identifier { LHSDot $1 $3 }
: Identifier { LHSIdent $1 }
| LHS Range { LHSRange $1 $2 }
| LHS "[" Expr "]" { LHSBit $1 $3 }
| LHS "." Identifier { LHSDot $1 $3 }
| "{" LHSs "}" { LHSConcat $2 }
LHSs :: { [LHS] }
: LHS { [$1] }
| LHSs "," LHS { $1 ++ [$3] }
: LHS { [$1] }
| LHSs "," LHS { $1 ++ [$3] }
Sense :: { Sense }
: Sense1 { $1 }

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

@ -151,26 +151,23 @@ parseDTsAsDeclOrAsgn tokens =
DTAsgn e -> (AsgnBlk, e)
DTAsgnNBlk e -> (Asgn , e)
_ -> error $ "invalid block item decl or stmt: " ++ (show tokens)
(lhs, []) = takeLHS $ init tokens
Just lhs = foldl takeLHSStep Nothing $ init tokens
isAsgnToken :: DeclToken -> Bool
isAsgnToken (DTBit _) = True
isAsgnToken (DTConcat _) = True
isAsgnToken _ = False
-- TODO: It looks like our LHS type doesn't represent the full set of possible
-- LHSs, i.e., `foo[0][0]` isn't representable. When this is addressed, we'll
-- have to take another pass at this function. It will probably need to be
-- recursive.
takeLHS :: [DeclToken] -> (LHS, [DeclToken])
takeLHS (DTConcat lhss : rest) = (LHSConcat lhss, rest)
takeLHS (DTIdent x : DTBit e : rest) = (LHSBit x e , rest)
takeLHS (DTIdent x : DTRange r : rest) = (LHSRange x r , rest)
takeLHS (DTIdent x : rest) = (LHS x , rest)
takeLHS (DTType tf : rest) =
takeLHSStep :: Maybe LHS -> DeclToken -> Maybe LHS
takeLHSStep (Nothing ) (DTConcat lhss) = Just $ LHSConcat lhss
takeLHSStep (Nothing ) (DTIdent x ) = Just $ LHSIdent x
takeLHSStep (Just curr) (DTBit e ) = Just $ LHSBit curr e
takeLHSStep (Just curr) (DTRange r ) = Just $ LHSRange curr r
takeLHSStep (Nothing ) (DTType tf ) =
case tf [] of
InterfaceT x (Just y) [] -> (LHSDot (LHS x) y, rest)
InterfaceT x (Just y) [] -> Just $ LHSDot (LHSIdent x) y
_ -> error $ "unexpected type in assignment: " ++ (show tf)
takeLHS tokens = error $ "missing LHS in assignment: " ++ (show tokens)
takeLHSStep (maybeCurr) token =
error $ "unexpected token in LHS: " ++ show (maybeCurr, token)
-- batches together seperate declaration lists