more careful expr and type traversals

src/Convert/Enum.hs

@@ -55,7 +55,8 @@ convertDescription' description =
     where
         -- replace and collect the enum types in this description
         (description', enums) = runWriter $
-            traverseModuleItemsM (traverseTypesM traverseType) description
+            traverseModuleItemsM traverseModuleItemM description
+        traverseModuleItemM = traverseTypesM $ traverseNestedTypesM traverseType
         -- convert the collected enums into their corresponding localparams
         enumItems = concatMap makeEnumItems $ Set.toList enums
 

src/Convert/IntTypes.hs

@@ -14,7 +14,7 @@ convert =
     map $
     traverseDescriptions $
     traverseModuleItems $
-    traverseTypes convertType
+    traverseTypes $ traverseNestedTypes convertType
 
 convertType :: Type -> Type
 convertType (IntegerAtom kw sg) = elaborateIntegerAtom $ IntegerAtom kw sg

src/Convert/Package.hs

@@ -124,7 +124,7 @@ prefixPackageItem packageName idents item =
         convertLHSM other = return other
 
         convertModuleItemM =
-            traverseTypesM                       convertTypeM  >=>
+            traverseTypesM (traverseNestedTypesM convertTypeM) >=>
             traverseExprsM (traverseNestedExprsM convertExprM) >=>
             traverseLHSsM  (traverseNestedLHSsM  convertLHSM )
         convertStmtM =

src/Convert/ParamType.hs

@@ -243,7 +243,7 @@ isSimpleType typ =
         Union    _ fields _ -> all (isSimpleType . fst) fields
         _ -> False
 
--- returns whether a type contains any dimension queries
+-- returns whether a top-level type contains any dimension queries
 typeHasQueries :: Type -> Bool
 typeHasQueries =
     not . null . execWriter . collectTypeExprsM
@@ -257,8 +257,9 @@ typeHasQueries =
         collectUnresolvedExprM _ = return ()
 
 prepareTypeIdents :: Identifier -> Type -> (Type, IdentSet)
-prepareTypeIdents prefix typ =
-    runWriter $ traverseTypeExprsM (traverseNestedExprsM prepareExprIdents) typ
+prepareTypeIdents prefix =
+    runWriter . traverseNestedTypesM
+        (traverseTypeExprsM $ traverseNestedExprsM prepareExprIdents)
     where
         prepareExprIdents :: Expr -> Writer IdentSet Expr
         prepareExprIdents (Ident x) = do

src/Convert/Simplify.hs

@@ -58,7 +58,7 @@ traverseModuleItemM (Instance m p x rs l) = do
     traverseExprsM traverseExprM $ Instance m p' x rs l
     where
         paramBindingMapper (param, Left t) = do
-            t' <- traverseTypeExprsM substituteExprM t
+            t' <- traverseNestedTypesM (traverseTypeExprsM substituteExprM) t
             return (param, Left t')
         paramBindingMapper (param, Right e) = return (param, Right e)
 traverseModuleItemM item = traverseExprsM traverseExprM item

src/Convert/Struct.hs

@@ -24,7 +24,8 @@ convert = map $ traverseDescriptions convertDescription
 
 convertDescription :: Description -> Description
 convertDescription (description @ (Part _ _ Module _ _ _ _)) =
-    traverseModuleItems (traverseTypes' ExcludeParamTypes convertType) $
+    traverseModuleItems
+    (traverseTypes' ExcludeParamTypes $ traverseNestedTypes convertType) $
     partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
     description
 convertDescription other = other

src/Convert/Traverse.hs

@@ -397,7 +397,7 @@ collectNestedExprsM = collectify traverseNestedExprsM
 traverseSinglyNestedExprsM :: Monad m => MapperM m Expr -> MapperM m Expr
 traverseSinglyNestedExprsM exprMapper = em
     where
-        (_, _, _, typeMapper, _) = exprMapperHelpers exprMapper
+        typeMapper = traverseNestedTypesM (traverseTypeExprsM exprMapper)
         typeOrExprMapper (Left t) =
             typeMapper t >>= return . Left
         typeOrExprMapper (Right e) =
@@ -488,95 +488,32 @@ traverseSinglyNestedExprs = unmonad traverseSinglyNestedExprsM
 collectSinglyNestedExprsM :: Monad m => CollectorM m Expr -> CollectorM m Expr
 collectSinglyNestedExprsM = collectify traverseSinglyNestedExprsM
 
-exprMapperHelpers :: Monad m => MapperM m Expr ->
-    ( MapperM m Range
-    , MapperM m Decl
-    , MapperM m LHS
-    , MapperM m Type
-    , MapperM m GenItem
-    )
-exprMapperHelpers exprMapper =
-    ( rangeMapper
-    , declMapper
-    , traverseNestedLHSsM lhsMapper
-    , typeMapper
-    , genItemMapper
-    )
+traverseLHSExprsM :: Monad m => MapperM m Expr -> MapperM m LHS
+traverseLHSExprsM exprMapper =
+    lhsMapper
     where
+        lhsMapper (LHSRange l m r) =
+            mapBothM exprMapper r >>= return . LHSRange l m
+        lhsMapper (LHSBit l e) =
+            exprMapper e >>= return . LHSBit l
+        lhsMapper (LHSStream o e ls) = do
+            e' <- exprMapper e
+            return $ LHSStream o e' ls
+        lhsMapper other = return other
 
-    rangeMapper (a, b) = do
-        a' <- exprMapper a
-        b' <- exprMapper b
-        return (a', b')
-
-    typeOrExprMapper (Left t) =
-        typeMapper t >>= return . Left
-    typeOrExprMapper (Right e) =
-        exprMapper e >>= return . Right
-
-    typeMapper' (TypeOf expr) =
-        exprMapper expr >>= return . TypeOf
-    typeMapper' (CSAlias x pm y rs) = do
-        vals' <- mapM typeOrExprMapper $ map snd pm
-        let pm' = zip (map fst pm) vals'
-        rs' <- mapM rangeMapper rs
-        return $ CSAlias x pm' y rs'
-    typeMapper' t = do
-        let (tf, rs) = typeRanges t
-        rs' <- mapM rangeMapper rs
-        return $ tf rs'
-    typeMapper = traverseNestedTypesM typeMapper'
-
-    maybeTypeMapper Nothing = return Nothing
-    maybeTypeMapper (Just t) =
-        typeMapper t >>= return . Just
-
-    declMapper (Param s t x e) = do
-        t' <- typeMapper t
-        e' <- exprMapper e
-        return $ Param s t' x e'
-    declMapper (ParamType s x mt) = do
-        mt' <- maybeTypeMapper mt
-        return $ ParamType s x mt'
-    declMapper (Variable d t x a e) = do
-        t' <- typeMapper t
-        a' <- mapM rangeMapper a
-        e' <- exprMapper e
-        return $ Variable d t' x a' e'
-    declMapper (CommentDecl c) =
-        return $ CommentDecl c
-
-    lhsMapper (LHSRange l m r) =
-        rangeMapper r >>= return . LHSRange l m
-    lhsMapper (LHSBit l e) =
-        exprMapper e >>= return . LHSBit l
-    lhsMapper (LHSStream o e ls) = do
-        e' <- exprMapper e
-        return $ LHSStream o e' ls
-    lhsMapper other = return other
-
-    genItemMapper (GenFor (x1, e1) cc (x2, op2, e2) subItem) = do
-        e1' <- exprMapper e1
-        e2' <- exprMapper e2
-        cc' <- exprMapper cc
-        return $ GenFor (x1, e1') cc' (x2, op2, e2') subItem
-    genItemMapper (GenIf e i1 i2) = do
-        e' <- exprMapper e
-        return $ GenIf e' i1 i2
-    genItemMapper (GenCase e cases) = do
-        e' <- exprMapper e
-        caseExprs <- mapM (mapM exprMapper . fst) cases
-        let cases' = zip caseExprs (map snd cases)
-        return $ GenCase e' cases'
-    genItemMapper other = return other
+mapBothM :: Monad m => MapperM m t -> MapperM m (t, t)
+mapBothM mapper (a, b) = do
+    a' <- mapper a
+    b' <- mapper b
+    return (a', b')
 
 traverseExprsM :: Monad m => MapperM m Expr -> MapperM m ModuleItem
 traverseExprsM exprMapper = moduleItemMapper
     where
 
-    (rangeMapper, declMapper, lhsMapper, typeMapper, genItemMapper)
-        = exprMapperHelpers exprMapper
-
+    declMapper = traverseDeclExprsM exprMapper
+    typeMapper = traverseNestedTypesM (traverseTypeExprsM exprMapper)
+    lhsMapper = traverseNestedLHSsM (traverseLHSExprsM exprMapper)
     stmtMapper = traverseNestedStmtsM (traverseStmtExprsM exprMapper)
 
     portBindingMapper (p, e) =
@@ -626,7 +563,7 @@ traverseExprsM exprMapper = moduleItemMapper
     moduleItemMapper (Instance m p x rs l) = do
         p' <- mapM paramBindingMapper p
         l' <- mapM portBindingMapper l
-        rs' <- mapM rangeMapper rs
+        rs' <- mapM (mapBothM exprMapper) rs
         return $ Instance m p' x rs' l'
     moduleItemMapper (Modport x l) =
         mapM modportDeclMapper l >>= return . Modport x
@@ -655,6 +592,8 @@ traverseExprsM exprMapper = moduleItemMapper
         a'' <- traverseAssertionExprsM exprMapper a'
         return $ AssertionItem (mx, a'')
 
+    genItemMapper = traverseGenItemExprsM exprMapper
+
     modportDeclMapper (dir, ident, t, e) = do
         t' <- typeMapper t
         e' <- exprMapper e
@@ -669,7 +608,8 @@ traverseStmtExprsM :: Monad m => MapperM m Expr -> MapperM m Stmt
 traverseStmtExprsM exprMapper = flatStmtMapper
     where
 
-    (_, declMapper, lhsMapper, _, _) = exprMapperHelpers exprMapper
+    declMapper = traverseDeclExprsM exprMapper
+    lhsMapper = traverseNestedLHSsM (traverseLHSExprsM exprMapper)
 
     caseMapper (exprs, stmt) = do
         exprs' <- mapM exprMapper exprs
@@ -818,9 +758,14 @@ traverseNestedTypesM :: Monad m => MapperM m Type -> MapperM m Type
 traverseNestedTypesM mapper = fullMapper
     where
         fullMapper = mapper >=> tm
+        typeOrExprMapper (Left t) = mapper t >>= return . Left
+        typeOrExprMapper (Right e) = return $ Right e
         tm (Alias         xx    rs) = return $ Alias         xx    rs
         tm (PSAlias ps    xx    rs) = return $ PSAlias ps    xx    rs
-        tm (CSAlias ps pm xx    rs) = return $ CSAlias ps pm xx    rs
+        tm (CSAlias ps pm xx    rs) = do
+            vals' <- mapM typeOrExprMapper $ map snd pm
+            let pm' = zip (map fst pm) vals'
+            return $ CSAlias ps pm' xx rs
         tm (Net           kw sg rs) = return $ Net           kw sg rs
         tm (Implicit         sg rs) = return $ Implicit         sg rs
         tm (IntegerVector kw sg rs) = return $ IntegerVector kw sg rs
@@ -869,9 +814,22 @@ collectExprTypesM :: Monad m => CollectorM m Type -> CollectorM m Expr
 collectExprTypesM = collectify traverseExprTypesM
 
 traverseTypeExprsM :: Monad m => MapperM m Expr -> MapperM m Type
-traverseTypeExprsM mapper =
+traverseTypeExprsM exprMapper =
     typeMapper
-    where (_, _, _, typeMapper, _) = exprMapperHelpers mapper
+    where
+        typeOrExprMapper (Left t) = return $ Left t
+        typeOrExprMapper (Right e) = exprMapper e >>= return . Right
+        typeMapper (TypeOf expr) =
+            exprMapper expr >>= return . TypeOf
+        typeMapper (CSAlias ps pm xx rs) = do
+            vals' <- mapM typeOrExprMapper $ map snd pm
+            let pm' = zip (map fst pm) vals'
+            rs' <- mapM (mapBothM exprMapper) rs
+            return $ CSAlias ps pm' xx rs'
+        typeMapper t = do
+            let (tf, rs) = typeRanges t
+            rs' <- mapM (mapBothM exprMapper) rs
+            return $ tf rs'
 
 traverseTypeExprs :: Mapper Expr -> Mapper Type
 traverseTypeExprs = unmonad traverseTypeExprsM
@@ -879,9 +837,23 @@ collectTypeExprsM :: Monad m => CollectorM m Expr -> CollectorM m Type
 collectTypeExprsM = collectify traverseTypeExprsM
 
 traverseGenItemExprsM :: Monad m => MapperM m Expr -> MapperM m GenItem
-traverseGenItemExprsM mapper =
+traverseGenItemExprsM exprMapper =
     genItemMapper
-    where (_, _, _, _, genItemMapper) = exprMapperHelpers mapper
+    where
+        genItemMapper (GenFor (x1, e1) cc (x2, op2, e2) subItem) = do
+            e1' <- exprMapper e1
+            e2' <- exprMapper e2
+            cc' <- exprMapper cc
+            return $ GenFor (x1, e1') cc' (x2, op2, e2') subItem
+        genItemMapper (GenIf e i1 i2) = do
+            e' <- exprMapper e
+            return $ GenIf e' i1 i2
+        genItemMapper (GenCase e cases) = do
+            e' <- exprMapper e
+            caseExprs <- mapM (mapM exprMapper . fst) cases
+            let cases' = zip caseExprs (map snd cases)
+            return $ GenCase e' cases'
+        genItemMapper other = return other
 
 traverseGenItemExprs :: Mapper Expr -> Mapper GenItem
 traverseGenItemExprs = unmonad traverseGenItemExprsM
@@ -889,9 +861,25 @@ collectGenItemExprsM :: Monad m => CollectorM m Expr -> CollectorM m GenItem
 collectGenItemExprsM = collectify traverseGenItemExprsM
 
 traverseDeclExprsM :: Monad m => MapperM m Expr -> MapperM m Decl
-traverseDeclExprsM mapper =
+traverseDeclExprsM exprMapper =
     declMapper
-    where (_, declMapper, _, _, _) = exprMapperHelpers mapper
+    where
+        typeMapper = traverseNestedTypesM (traverseTypeExprsM exprMapper)
+
+        declMapper (Param s t x e) = do
+            t' <- typeMapper t
+            e' <- exprMapper e
+            return $ Param s t' x e'
+        declMapper (ParamType s x mt) = do
+            mt' <- mapM typeMapper mt
+            return $ ParamType s x mt'
+        declMapper (Variable d t x a e) = do
+            t' <- typeMapper t
+            a' <- mapM (mapBothM exprMapper) a
+            e' <- exprMapper e
+            return $ Variable d t' x a' e'
+        declMapper (CommentDecl c) =
+            return $ CommentDecl c
 
 traverseDeclExprs :: Mapper Expr -> Mapper Decl
 traverseDeclExprs = unmonad traverseDeclExprsM
@@ -918,13 +906,12 @@ traverseTypesM' strategy mapper =
     traverseDeclsM declMapper >=>
     traverseExprsM (traverseNestedExprsM exprMapper)
     where
-        fullMapper = traverseNestedTypesM mapper
-        exprMapper = traverseExprTypesM fullMapper
-        declMapper = traverseDeclTypesM fullMapper
+        exprMapper = traverseExprTypesM mapper
+        declMapper = traverseDeclTypesM mapper
         miMapper (MIPackageItem (Typedef t x)) =
-            fullMapper t >>= \t' -> return $ MIPackageItem $ Typedef t' x
+            mapper t >>= \t' -> return $ MIPackageItem $ Typedef t' x
         miMapper (MIPackageItem (Function l t x d s)) =
-            fullMapper t >>= \t' -> return $ MIPackageItem $ Function l t' x d s
+            mapper t >>= \t' -> return $ MIPackageItem $ Function l t' x d s
         miMapper (MIPackageItem (other @ (Task _ _ _ _))) =
             return $ MIPackageItem other
         miMapper (Instance m params x rs p) = do
@@ -933,14 +920,14 @@ traverseTypesM' strategy mapper =
             where
                 mapParam (i, Left t) =
                     if strategy == IncludeParamTypes
-                        then fullMapper t >>= \t' -> return (i, Left t')
+                        then mapper t >>= \t' -> return (i, Left t')
                         else return (i, Left t)
                 mapParam (i, Right e) = return $ (i, Right e)
         miMapper (Modport name decls) =
             mapM mapModportDecl decls >>= return . Modport name
             where
                 mapModportDecl (d, x, t, e) =
-                    fullMapper t >>= \t' -> return (d, x, t', e)
+                    mapper t >>= \t' -> return (d, x, t', e)
         miMapper other = return other
 
 traverseTypes' :: TypeStrategy -> Mapper Type -> Mapper ModuleItem

src/Convert/TypeOf.hs

@@ -38,7 +38,7 @@ traverseDeclM decl = do
         CommentDecl{} -> return decl'
 
 traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
-traverseModuleItemM = traverseTypesM traverseTypeM
+traverseModuleItemM = traverseTypesM $ traverseNestedTypesM traverseTypeM
 
 traverseGenItemM :: GenItem -> Scoper Type GenItem
 traverseGenItemM = traverseGenItemExprsM traverseExprM
@@ -47,7 +47,8 @@ traverseStmtM :: Stmt -> Scoper Type Stmt
 traverseStmtM = traverseStmtExprsM traverseExprM
 
 traverseExprM :: Expr -> Scoper Type Expr
-traverseExprM = traverseNestedExprsM $ traverseExprTypesM traverseTypeM
+traverseExprM = traverseNestedExprsM $ traverseExprTypesM $
+    traverseNestedTypesM traverseTypeM
 
 traverseTypeM :: Type -> Scoper Type Type
 traverseTypeM (TypeOf expr) = typeof expr
@@ -62,7 +63,9 @@ lookupTypeOf expr = do
         Just (_, _, Implicit Unspecified []) ->
             return $ IntegerVector TLogic Unspecified []
         Just (_, replacements, typ) ->
-            return $ rewriteType typ
+            return $ if Map.null replacements
+                then typ
+                else rewriteType typ
             where
                 rewriteType = traverseNestedTypes $ traverseTypeExprs $
                     traverseNestedExprs replace

src/Convert/Typedef.hs

@@ -57,7 +57,7 @@ traverseModuleItemM item = traverseModuleItemM' item
 
 traverseModuleItemM' :: ModuleItem -> Scoper Type ModuleItem
 traverseModuleItemM' =
-    traverseTypesM traverseTypeM >=>
+    traverseTypesM (traverseNestedTypesM traverseTypeM) >=>
     traverseExprsM (traverseNestedExprsM traverseExprM)
 
 traverseGenItemM :: GenItem -> Scoper Type GenItem

src/Convert/Unsigned.hs

@@ -18,7 +18,7 @@ convert =
     map $
     traverseDescriptions $
     traverseModuleItems $
-    traverseTypes convertType
+    traverseTypes $ traverseNestedTypes convertType
 
 convertType :: Type -> Type
 convertType (Implicit        Unsigned rs) = Implicit        Unspecified rs