Commit 2961d105 by Zachary Snow

remove deprecated TFStrategy traversals

parent 69b2e86a
...@@ -8,7 +8,6 @@ module Convert.Traverse ...@@ -8,7 +8,6 @@ module Convert.Traverse
( MapperM ( MapperM
, Mapper , Mapper
, CollectorM , CollectorM
, TFStrategy (..)
, TypeStrategy (..) , TypeStrategy (..)
, unmonad , unmonad
, collectify , collectify
...@@ -21,33 +20,21 @@ module Convert.Traverse ...@@ -21,33 +20,21 @@ module Convert.Traverse
, traverseStmtsM , traverseStmtsM
, traverseStmts , traverseStmts
, collectStmtsM , collectStmtsM
, traverseStmtsM'
, traverseStmts'
, collectStmtsM'
, traverseStmtLHSsM , traverseStmtLHSsM
, traverseStmtLHSs , traverseStmtLHSs
, collectStmtLHSsM , collectStmtLHSsM
, traverseExprsM , traverseExprsM
, traverseExprs , traverseExprs
, collectExprsM , collectExprsM
, traverseExprsM'
, traverseExprs'
, collectExprsM'
, traverseStmtExprsM , traverseStmtExprsM
, traverseStmtExprs , traverseStmtExprs
, collectStmtExprsM , collectStmtExprsM
, traverseLHSsM , traverseLHSsM
, traverseLHSs , traverseLHSs
, collectLHSsM , collectLHSsM
, traverseLHSsM'
, traverseLHSs'
, collectLHSsM'
, traverseDeclsM , traverseDeclsM
, traverseDecls , traverseDecls
, collectDeclsM , collectDeclsM
, traverseDeclsM'
, traverseDecls'
, collectDeclsM'
, traverseNestedTypesM , traverseNestedTypesM
, traverseNestedTypes , traverseNestedTypes
, collectNestedTypesM , collectNestedTypesM
...@@ -80,9 +67,6 @@ module Convert.Traverse ...@@ -80,9 +67,6 @@ module Convert.Traverse
, traverseAsgnsM , traverseAsgnsM
, traverseAsgns , traverseAsgns
, collectAsgnsM , collectAsgnsM
, traverseAsgnsM'
, traverseAsgns'
, collectAsgnsM'
, traverseStmtAsgnsM , traverseStmtAsgnsM
, traverseStmtAsgns , traverseStmtAsgns
, collectStmtAsgnsM , collectStmtAsgnsM
...@@ -116,11 +100,6 @@ type MapperM m t = t -> m t ...@@ -116,11 +100,6 @@ type MapperM m t = t -> m t
type Mapper t = t -> t type Mapper t = t -> t
type CollectorM m t = t -> m () type CollectorM m t = t -> m ()
data TFStrategy
= IncludeTFs
| ExcludeTFs
deriving Eq
data TypeStrategy data TypeStrategy
= IncludeParamTypes = IncludeParamTypes
| ExcludeParamTypes | ExcludeParamTypes
...@@ -175,22 +154,16 @@ traverseModuleItems = unmonad traverseModuleItemsM ...@@ -175,22 +154,16 @@ traverseModuleItems = unmonad traverseModuleItemsM
collectModuleItemsM :: Monad m => CollectorM m ModuleItem -> CollectorM m Description collectModuleItemsM :: Monad m => CollectorM m ModuleItem -> CollectorM m Description
collectModuleItemsM = collectify traverseModuleItemsM collectModuleItemsM = collectify traverseModuleItemsM
traverseStmtsM' :: Monad m => TFStrategy -> MapperM m Stmt -> MapperM m ModuleItem traverseStmtsM :: Monad m => MapperM m Stmt -> MapperM m ModuleItem
traverseStmtsM' strat mapper = moduleItemMapper traverseStmtsM mapper = moduleItemMapper
where where
moduleItemMapper (AlwaysC kw stmt) = moduleItemMapper (AlwaysC kw stmt) =
fullMapper stmt >>= return . AlwaysC kw fullMapper stmt >>= return . AlwaysC kw
moduleItemMapper (MIPackageItem (Function lifetime ret name decls stmts)) = do moduleItemMapper (MIPackageItem (Function lifetime ret name decls stmts)) = do
stmts' <- stmts' <- mapM fullMapper stmts
if strat == IncludeTFs
then mapM fullMapper stmts
else return stmts
return $ MIPackageItem $ Function lifetime ret name decls stmts' return $ MIPackageItem $ Function lifetime ret name decls stmts'
moduleItemMapper (MIPackageItem (Task lifetime name decls stmts)) = do moduleItemMapper (MIPackageItem (Task lifetime name decls stmts)) = do
stmts' <- stmts' <- mapM fullMapper stmts
if strat == IncludeTFs
then mapM fullMapper stmts
else return stmts
return $ MIPackageItem $ Task lifetime name decls stmts' return $ MIPackageItem $ Task lifetime name decls stmts'
moduleItemMapper (Initial stmt) = moduleItemMapper (Initial stmt) =
fullMapper stmt >>= return . Initial fullMapper stmt >>= return . Initial
...@@ -199,17 +172,10 @@ traverseStmtsM' strat mapper = moduleItemMapper ...@@ -199,17 +172,10 @@ traverseStmtsM' strat mapper = moduleItemMapper
moduleItemMapper other = return $ other moduleItemMapper other = return $ other
fullMapper = traverseNestedStmtsM mapper fullMapper = traverseNestedStmtsM mapper
traverseStmts' :: TFStrategy -> Mapper Stmt -> Mapper ModuleItem
traverseStmts' strat = unmonad $ traverseStmtsM' strat
collectStmtsM' :: Monad m => TFStrategy -> CollectorM m Stmt -> CollectorM m ModuleItem
collectStmtsM' strat = collectify $ traverseStmtsM' strat
traverseStmtsM :: Monad m => MapperM m Stmt -> MapperM m ModuleItem
traverseStmtsM = traverseStmtsM' IncludeTFs
traverseStmts :: Mapper Stmt -> Mapper ModuleItem traverseStmts :: Mapper Stmt -> Mapper ModuleItem
traverseStmts = traverseStmts' IncludeTFs traverseStmts = unmonad traverseStmtsM
collectStmtsM :: Monad m => CollectorM m Stmt -> CollectorM m ModuleItem collectStmtsM :: Monad m => CollectorM m Stmt -> CollectorM m ModuleItem
collectStmtsM = collectStmtsM' IncludeTFs collectStmtsM = collectify traverseStmtsM
-- private utility for turning a thing which maps over a single lever of -- private utility for turning a thing which maps over a single lever of
-- statements into one that maps over the nested statements first, then the -- statements into one that maps over the nested statements first, then the
...@@ -582,8 +548,8 @@ exprMapperHelpers exprMapper = ...@@ -582,8 +548,8 @@ exprMapperHelpers exprMapper =
return $ GenCase e' cases' return $ GenCase e' cases'
genItemMapper other = return other genItemMapper other = return other
traverseExprsM' :: Monad m => TFStrategy -> MapperM m Expr -> MapperM m ModuleItem traverseExprsM :: Monad m => MapperM m Expr -> MapperM m ModuleItem
traverseExprsM' strat exprMapper = moduleItemMapper traverseExprsM exprMapper = moduleItemMapper
where where
(rangeMapper, declMapper, lhsMapper, typeMapper, genItemMapper) (rangeMapper, declMapper, lhsMapper, typeMapper, genItemMapper)
...@@ -628,24 +594,12 @@ traverseExprsM' strat exprMapper = moduleItemMapper ...@@ -628,24 +594,12 @@ traverseExprsM' strat exprMapper = moduleItemMapper
return $ Assign opt' lhs' expr' return $ Assign opt' lhs' expr'
moduleItemMapper (MIPackageItem (Function lifetime ret f decls stmts)) = do moduleItemMapper (MIPackageItem (Function lifetime ret f decls stmts)) = do
ret' <- typeMapper ret ret' <- typeMapper ret
decls' <- decls' <- mapM declMapper decls
if strat == IncludeTFs stmts' <- mapM stmtMapper stmts
then mapM declMapper decls
else return decls
stmts' <-
if strat == IncludeTFs
then mapM stmtMapper stmts
else return stmts
return $ MIPackageItem $ Function lifetime ret' f decls' stmts' return $ MIPackageItem $ Function lifetime ret' f decls' stmts'
moduleItemMapper (MIPackageItem (Task lifetime f decls stmts)) = do moduleItemMapper (MIPackageItem (Task lifetime f decls stmts)) = do
decls' <- decls' <- mapM declMapper decls
if strat == IncludeTFs stmts' <- mapM stmtMapper stmts
then mapM declMapper decls
else return decls
stmts' <-
if strat == IncludeTFs
then mapM stmtMapper stmts
else return stmts
return $ MIPackageItem $ Task lifetime f decls' stmts' return $ MIPackageItem $ Task lifetime f decls' stmts'
moduleItemMapper (Instance m p x rs l) = do moduleItemMapper (Instance m p x rs l) = do
p' <- mapM paramBindingMapper p p' <- mapM paramBindingMapper p
...@@ -684,17 +638,10 @@ traverseExprsM' strat exprMapper = moduleItemMapper ...@@ -684,17 +638,10 @@ traverseExprsM' strat exprMapper = moduleItemMapper
e' <- exprMapper e e' <- exprMapper e
return (dir, ident, t', e') return (dir, ident, t', e')
traverseExprs' :: TFStrategy -> Mapper Expr -> Mapper ModuleItem
traverseExprs' strat = unmonad $ traverseExprsM' strat
collectExprsM' :: Monad m => TFStrategy -> CollectorM m Expr -> CollectorM m ModuleItem
collectExprsM' strat = collectify $ traverseExprsM' strat
traverseExprsM :: Monad m => MapperM m Expr -> MapperM m ModuleItem
traverseExprsM = traverseExprsM' IncludeTFs
traverseExprs :: Mapper Expr -> Mapper ModuleItem traverseExprs :: Mapper Expr -> Mapper ModuleItem
traverseExprs = traverseExprs' IncludeTFs traverseExprs = unmonad traverseExprsM
collectExprsM :: Monad m => CollectorM m Expr -> CollectorM m ModuleItem collectExprsM :: Monad m => CollectorM m Expr -> CollectorM m ModuleItem
collectExprsM = collectExprsM' IncludeTFs collectExprsM = collectify traverseExprsM
traverseStmtExprsM :: Monad m => MapperM m Expr -> MapperM m Stmt traverseStmtExprsM :: Monad m => MapperM m Expr -> MapperM m Stmt
traverseStmtExprsM exprMapper = flatStmtMapper traverseStmtExprsM exprMapper = flatStmtMapper
...@@ -765,9 +712,9 @@ traverseStmtExprs = unmonad traverseStmtExprsM ...@@ -765,9 +712,9 @@ traverseStmtExprs = unmonad traverseStmtExprsM
collectStmtExprsM :: Monad m => CollectorM m Expr -> CollectorM m Stmt collectStmtExprsM :: Monad m => CollectorM m Expr -> CollectorM m Stmt
collectStmtExprsM = collectify traverseStmtExprsM collectStmtExprsM = collectify traverseStmtExprsM
traverseLHSsM' :: Monad m => TFStrategy -> MapperM m LHS -> MapperM m ModuleItem traverseLHSsM :: Monad m => MapperM m LHS -> MapperM m ModuleItem
traverseLHSsM' strat mapper = traverseLHSsM mapper =
traverseStmtsM' strat (traverseStmtLHSsM mapper) >=> traverseModuleItemLHSsM traverseStmtsM (traverseStmtLHSsM mapper) >=> traverseModuleItemLHSsM
where where
traverseModuleItemLHSsM (Assign delay lhs expr) = do traverseModuleItemLHSsM (Assign delay lhs expr) = do
lhs' <- mapper lhs lhs' <- mapper lhs
...@@ -800,17 +747,10 @@ traverseLHSsM' strat mapper = ...@@ -800,17 +747,10 @@ traverseLHSsM' strat mapper =
return $ GenFor (x1', e1) cc (x2', op2, e2) subItem return $ GenFor (x1', e1) cc (x2', op2, e2) subItem
traverGenItemLHSsM other = return other traverGenItemLHSsM other = return other
traverseLHSs' :: TFStrategy -> Mapper LHS -> Mapper ModuleItem
traverseLHSs' strat = unmonad $ traverseLHSsM' strat
collectLHSsM' :: Monad m => TFStrategy -> CollectorM m LHS -> CollectorM m ModuleItem
collectLHSsM' strat = collectify $ traverseLHSsM' strat
traverseLHSsM :: Monad m => MapperM m LHS -> MapperM m ModuleItem
traverseLHSsM = traverseLHSsM' IncludeTFs
traverseLHSs :: Mapper LHS -> Mapper ModuleItem traverseLHSs :: Mapper LHS -> Mapper ModuleItem
traverseLHSs = traverseLHSs' IncludeTFs traverseLHSs = unmonad traverseLHSsM
collectLHSsM :: Monad m => CollectorM m LHS -> CollectorM m ModuleItem collectLHSsM :: Monad m => CollectorM m LHS -> CollectorM m ModuleItem
collectLHSsM = collectLHSsM' IncludeTFs collectLHSsM = collectify traverseLHSsM
traverseNestedLHSsM :: Monad m => MapperM m LHS -> MapperM m LHS traverseNestedLHSsM :: Monad m => MapperM m LHS -> MapperM m LHS
traverseNestedLHSsM mapper = fullMapper traverseNestedLHSsM mapper = fullMapper
...@@ -828,24 +768,18 @@ traverseNestedLHSs = unmonad traverseNestedLHSsM ...@@ -828,24 +768,18 @@ traverseNestedLHSs = unmonad traverseNestedLHSsM
collectNestedLHSsM :: Monad m => CollectorM m LHS -> CollectorM m LHS collectNestedLHSsM :: Monad m => CollectorM m LHS -> CollectorM m LHS
collectNestedLHSsM = collectify traverseNestedLHSsM collectNestedLHSsM = collectify traverseNestedLHSsM
traverseDeclsM' :: Monad m => TFStrategy -> MapperM m Decl -> MapperM m ModuleItem traverseDeclsM :: Monad m => MapperM m Decl -> MapperM m ModuleItem
traverseDeclsM' strat mapper item = do traverseDeclsM mapper item = do
item' <- miMapper item item' <- miMapper item
traverseStmtsM' strat stmtMapper item' traverseStmtsM stmtMapper item'
where where
miMapper (MIPackageItem (Decl decl)) = miMapper (MIPackageItem (Decl decl)) =
mapper decl >>= return . MIPackageItem . Decl mapper decl >>= return . MIPackageItem . Decl
miMapper (MIPackageItem (Function l t x decls stmts)) = do miMapper (MIPackageItem (Function l t x decls stmts)) = do
decls' <- decls' <- mapM mapper decls
if strat == IncludeTFs
then mapM mapper decls
else return decls
return $ MIPackageItem $ Function l t x decls' stmts return $ MIPackageItem $ Function l t x decls' stmts
miMapper (MIPackageItem (Task l x decls stmts)) = do miMapper (MIPackageItem (Task l x decls stmts)) = do
decls' <- decls' <- mapM mapper decls
if strat == IncludeTFs
then mapM mapper decls
else return decls
return $ MIPackageItem $ Task l x decls' stmts return $ MIPackageItem $ Task l x decls' stmts
miMapper other = return other miMapper other = return other
stmtMapper (Block kw name decls stmts) = do stmtMapper (Block kw name decls stmts) = do
...@@ -853,17 +787,10 @@ traverseDeclsM' strat mapper item = do ...@@ -853,17 +787,10 @@ traverseDeclsM' strat mapper item = do
return $ Block kw name decls' stmts return $ Block kw name decls' stmts
stmtMapper other = return other stmtMapper other = return other
traverseDecls' :: TFStrategy -> Mapper Decl -> Mapper ModuleItem
traverseDecls' strat = unmonad $ traverseDeclsM' strat
collectDeclsM' :: Monad m => TFStrategy -> CollectorM m Decl -> CollectorM m ModuleItem
collectDeclsM' strat = collectify $ traverseDeclsM' strat
traverseDeclsM :: Monad m => MapperM m Decl -> MapperM m ModuleItem
traverseDeclsM = traverseDeclsM' IncludeTFs
traverseDecls :: Mapper Decl -> Mapper ModuleItem traverseDecls :: Mapper Decl -> Mapper ModuleItem
traverseDecls = traverseDecls' IncludeTFs traverseDecls = unmonad traverseDeclsM
collectDeclsM :: Monad m => CollectorM m Decl -> CollectorM m ModuleItem collectDeclsM :: Monad m => CollectorM m Decl -> CollectorM m ModuleItem
collectDeclsM = collectDeclsM' IncludeTFs collectDeclsM = collectify traverseDeclsM
traverseNestedTypesM :: Monad m => MapperM m Type -> MapperM m Type traverseNestedTypesM :: Monad m => MapperM m Type -> MapperM m Type
traverseNestedTypesM mapper = fullMapper traverseNestedTypesM mapper = fullMapper
...@@ -1055,8 +982,8 @@ traverseSinglyNestedGenItemsM fullMapper = gim ...@@ -1055,8 +982,8 @@ traverseSinglyNestedGenItemsM fullMapper = gim
return $ GenModuleItem moduleItem return $ GenModuleItem moduleItem
gim (GenNull) = return GenNull gim (GenNull) = return GenNull
traverseAsgnsM' :: Monad m => TFStrategy -> MapperM m (LHS, Expr) -> MapperM m ModuleItem traverseAsgnsM :: Monad m => MapperM m (LHS, Expr) -> MapperM m ModuleItem
traverseAsgnsM' strat mapper = moduleItemMapper traverseAsgnsM mapper = moduleItemMapper
where where
moduleItemMapper = miMapperA >=> miMapperB moduleItemMapper = miMapperA >=> miMapperB
...@@ -1068,20 +995,13 @@ traverseAsgnsM' strat mapper = moduleItemMapper ...@@ -1068,20 +995,13 @@ traverseAsgnsM' strat mapper = moduleItemMapper
return $ Defparam lhs' expr' return $ Defparam lhs' expr'
miMapperA other = return other miMapperA other = return other
miMapperB = traverseStmtsM' strat stmtMapper miMapperB = traverseStmtsM stmtMapper
stmtMapper = traverseStmtAsgnsM mapper stmtMapper = traverseStmtAsgnsM mapper
traverseAsgns' :: TFStrategy -> Mapper (LHS, Expr) -> Mapper ModuleItem
traverseAsgns' strat = unmonad $ traverseAsgnsM' strat
collectAsgnsM' :: Monad m => TFStrategy -> CollectorM m (LHS, Expr) -> CollectorM m ModuleItem
collectAsgnsM' strat = collectify $ traverseAsgnsM' strat
traverseAsgnsM :: Monad m => MapperM m (LHS, Expr) -> MapperM m ModuleItem
traverseAsgnsM = traverseAsgnsM' IncludeTFs
traverseAsgns :: Mapper (LHS, Expr) -> Mapper ModuleItem traverseAsgns :: Mapper (LHS, Expr) -> Mapper ModuleItem
traverseAsgns = traverseAsgns' IncludeTFs traverseAsgns = unmonad traverseAsgnsM
collectAsgnsM :: Monad m => CollectorM m (LHS, Expr) -> CollectorM m ModuleItem collectAsgnsM :: Monad m => CollectorM m (LHS, Expr) -> CollectorM m ModuleItem
collectAsgnsM = collectAsgnsM' IncludeTFs collectAsgnsM = collectify traverseAsgnsM
traverseStmtAsgnsM :: Monad m => MapperM m (LHS, Expr) -> MapperM m Stmt traverseStmtAsgnsM :: Monad m => MapperM m (LHS, Expr) -> MapperM m Stmt
traverseStmtAsgnsM mapper = stmtMapper traverseStmtAsgnsM mapper = stmtMapper
......
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