LHSs are recursive (as they should have been)

src/Convert/Logic.hs

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

src/Convert/PackedArray.hs

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

src/Convert/Traverse.hs

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

src/Language/SystemVerilog/AST.hs

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

src/Language/SystemVerilog/Parser/Parse.y

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

src/Language/SystemVerilog/Parser/ParseDecl.hs

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