Commit c28bb71a by Zachary Snow

more careful expr and type traversals

parent efe8de39
...@@ -55,7 +55,8 @@ convertDescription' description = ...@@ -55,7 +55,8 @@ convertDescription' description =
where where
-- replace and collect the enum types in this description -- replace and collect the enum types in this description
(description', enums) = runWriter $ (description', enums) = runWriter $
traverseModuleItemsM (traverseTypesM traverseType) description traverseModuleItemsM traverseModuleItemM description
traverseModuleItemM = traverseTypesM $ traverseNestedTypesM traverseType
-- convert the collected enums into their corresponding localparams -- convert the collected enums into their corresponding localparams
enumItems = concatMap makeEnumItems $ Set.toList enums enumItems = concatMap makeEnumItems $ Set.toList enums
......
...@@ -14,7 +14,7 @@ convert = ...@@ -14,7 +14,7 @@ convert =
map $ map $
traverseDescriptions $ traverseDescriptions $
traverseModuleItems $ traverseModuleItems $
traverseTypes convertType traverseTypes $ traverseNestedTypes convertType
convertType :: Type -> Type convertType :: Type -> Type
convertType (IntegerAtom kw sg) = elaborateIntegerAtom $ IntegerAtom kw sg convertType (IntegerAtom kw sg) = elaborateIntegerAtom $ IntegerAtom kw sg
......
...@@ -124,7 +124,7 @@ prefixPackageItem packageName idents item = ...@@ -124,7 +124,7 @@ prefixPackageItem packageName idents item =
convertLHSM other = return other convertLHSM other = return other
convertModuleItemM = convertModuleItemM =
traverseTypesM convertTypeM >=> traverseTypesM (traverseNestedTypesM convertTypeM) >=>
traverseExprsM (traverseNestedExprsM convertExprM) >=> traverseExprsM (traverseNestedExprsM convertExprM) >=>
traverseLHSsM (traverseNestedLHSsM convertLHSM ) traverseLHSsM (traverseNestedLHSsM convertLHSM )
convertStmtM = convertStmtM =
......
...@@ -243,7 +243,7 @@ isSimpleType typ = ...@@ -243,7 +243,7 @@ isSimpleType typ =
Union _ fields _ -> all (isSimpleType . fst) fields Union _ fields _ -> all (isSimpleType . fst) fields
_ -> False _ -> False
-- returns whether a type contains any dimension queries -- returns whether a top-level type contains any dimension queries
typeHasQueries :: Type -> Bool typeHasQueries :: Type -> Bool
typeHasQueries = typeHasQueries =
not . null . execWriter . collectTypeExprsM not . null . execWriter . collectTypeExprsM
...@@ -257,8 +257,9 @@ typeHasQueries = ...@@ -257,8 +257,9 @@ typeHasQueries =
collectUnresolvedExprM _ = return () collectUnresolvedExprM _ = return ()
prepareTypeIdents :: Identifier -> Type -> (Type, IdentSet) prepareTypeIdents :: Identifier -> Type -> (Type, IdentSet)
prepareTypeIdents prefix typ = prepareTypeIdents prefix =
runWriter $ traverseTypeExprsM (traverseNestedExprsM prepareExprIdents) typ runWriter . traverseNestedTypesM
(traverseTypeExprsM $ traverseNestedExprsM prepareExprIdents)
where where
prepareExprIdents :: Expr -> Writer IdentSet Expr prepareExprIdents :: Expr -> Writer IdentSet Expr
prepareExprIdents (Ident x) = do prepareExprIdents (Ident x) = do
......
...@@ -58,7 +58,7 @@ traverseModuleItemM (Instance m p x rs l) = do ...@@ -58,7 +58,7 @@ traverseModuleItemM (Instance m p x rs l) = do
traverseExprsM traverseExprM $ Instance m p' x rs l traverseExprsM traverseExprM $ Instance m p' x rs l
where where
paramBindingMapper (param, Left t) = do paramBindingMapper (param, Left t) = do
t' <- traverseTypeExprsM substituteExprM t t' <- traverseNestedTypesM (traverseTypeExprsM substituteExprM) t
return (param, Left t') return (param, Left t')
paramBindingMapper (param, Right e) = return (param, Right e) paramBindingMapper (param, Right e) = return (param, Right e)
traverseModuleItemM item = traverseExprsM traverseExprM item traverseModuleItemM item = traverseExprsM traverseExprM item
......
...@@ -24,7 +24,8 @@ convert = map $ traverseDescriptions convertDescription ...@@ -24,7 +24,8 @@ convert = map $ traverseDescriptions convertDescription
convertDescription :: Description -> Description convertDescription :: Description -> Description
convertDescription (description @ (Part _ _ Module _ _ _ _)) = convertDescription (description @ (Part _ _ Module _ _ _ _)) =
traverseModuleItems (traverseTypes' ExcludeParamTypes convertType) $ traverseModuleItems
(traverseTypes' ExcludeParamTypes $ traverseNestedTypes convertType) $
partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM partScoper traverseDeclM traverseModuleItemM traverseGenItemM traverseStmtM
description description
convertDescription other = other convertDescription other = other
......
...@@ -38,7 +38,7 @@ traverseDeclM decl = do ...@@ -38,7 +38,7 @@ traverseDeclM decl = do
CommentDecl{} -> return decl' CommentDecl{} -> return decl'
traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem traverseModuleItemM :: ModuleItem -> Scoper Type ModuleItem
traverseModuleItemM = traverseTypesM traverseTypeM traverseModuleItemM = traverseTypesM $ traverseNestedTypesM traverseTypeM
traverseGenItemM :: GenItem -> Scoper Type GenItem traverseGenItemM :: GenItem -> Scoper Type GenItem
traverseGenItemM = traverseGenItemExprsM traverseExprM traverseGenItemM = traverseGenItemExprsM traverseExprM
...@@ -47,7 +47,8 @@ traverseStmtM :: Stmt -> Scoper Type Stmt ...@@ -47,7 +47,8 @@ traverseStmtM :: Stmt -> Scoper Type Stmt
traverseStmtM = traverseStmtExprsM traverseExprM traverseStmtM = traverseStmtExprsM traverseExprM
traverseExprM :: Expr -> Scoper Type Expr traverseExprM :: Expr -> Scoper Type Expr
traverseExprM = traverseNestedExprsM $ traverseExprTypesM traverseTypeM traverseExprM = traverseNestedExprsM $ traverseExprTypesM $
traverseNestedTypesM traverseTypeM
traverseTypeM :: Type -> Scoper Type Type traverseTypeM :: Type -> Scoper Type Type
traverseTypeM (TypeOf expr) = typeof expr traverseTypeM (TypeOf expr) = typeof expr
...@@ -62,7 +63,9 @@ lookupTypeOf expr = do ...@@ -62,7 +63,9 @@ lookupTypeOf expr = do
Just (_, _, Implicit Unspecified []) -> Just (_, _, Implicit Unspecified []) ->
return $ IntegerVector TLogic Unspecified [] return $ IntegerVector TLogic Unspecified []
Just (_, replacements, typ) -> Just (_, replacements, typ) ->
return $ rewriteType typ return $ if Map.null replacements
then typ
else rewriteType typ
where where
rewriteType = traverseNestedTypes $ traverseTypeExprs $ rewriteType = traverseNestedTypes $ traverseTypeExprs $
traverseNestedExprs replace traverseNestedExprs replace
......
...@@ -57,7 +57,7 @@ traverseModuleItemM item = traverseModuleItemM' item ...@@ -57,7 +57,7 @@ traverseModuleItemM item = traverseModuleItemM' item
traverseModuleItemM' :: ModuleItem -> Scoper Type ModuleItem traverseModuleItemM' :: ModuleItem -> Scoper Type ModuleItem
traverseModuleItemM' = traverseModuleItemM' =
traverseTypesM traverseTypeM >=> traverseTypesM (traverseNestedTypesM traverseTypeM) >=>
traverseExprsM (traverseNestedExprsM traverseExprM) traverseExprsM (traverseNestedExprsM traverseExprM)
traverseGenItemM :: GenItem -> Scoper Type GenItem traverseGenItemM :: GenItem -> Scoper Type GenItem
......
...@@ -18,7 +18,7 @@ convert = ...@@ -18,7 +18,7 @@ convert =
map $ map $
traverseDescriptions $ traverseDescriptions $
traverseModuleItems $ traverseModuleItems $
traverseTypes convertType traverseTypes $ traverseNestedTypes convertType
convertType :: Type -> Type convertType :: Type -> Type
convertType (Implicit Unsigned rs) = Implicit Unspecified rs convertType (Implicit Unsigned rs) = Implicit Unspecified rs
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment