Adjusted all the remaining modules in the transformations directory to work with the new Pass system

This commit is contained in:
Neil Brown 2008-12-14 18:30:02 +00:00
parent 1d73b56988
commit a0c58ae836
3 changed files with 11 additions and 24 deletions

View File

@ -183,7 +183,7 @@ effectMoveCopyDecisions g decs = foldFuncsM $ map effect $ Map.toList decs
Nothing -> const $ dieP (findMeta v) "Could not find label for node"
Just mod -> effectDecision v dec mod
implicitMobility :: Pass
implicitMobility :: Pass A.AST
implicitMobility
= pass "Implicit mobility optimisation"
[] [] --TODO properties

View File

@ -41,7 +41,7 @@ import Traversal
import UsageCheckUtils
import Utils
simplifyAbbrevs :: [Pass]
simplifyAbbrevs :: [Pass A.AST]
simplifyAbbrevs =
[ removeInitial
, removeResult
@ -49,14 +49,14 @@ simplifyAbbrevs =
]
-- | Rewrite 'InitialAbbrev' into a variable and an assignment.
removeInitial :: Pass
removeInitial :: PassOnOps (ExtOpMSP BaseOp)
removeInitial
= pass "Remove INITIAL abbreviations"
[]
[Prop.initialRemoved]
(applyDepthSM doStructured)
(applyBottomUpMS doStructured)
where
doStructured :: Data t => A.Structured t -> PassM (A.Structured t)
doStructured :: TransformStructured (ExtOpMSP BaseOp)
doStructured (A.Spec m spec s) = doSpec m spec s
doStructured s = return s
@ -166,25 +166,24 @@ removeInitial
specVar (A.Specification m n _) = A.Variable m n
-- | Rewrite 'ResultAbbrev' into just 'Abbrev'.
removeResult :: Pass
removeResult :: Polyplate t (OneOp A.AbbrevMode) () => Pass t
removeResult
= pass "Remove RESULT abbreviations"
[]
[Prop.resultRemoved]
(applyDepthM (return . doAbbrevMode))
(return . applyBottomUp doAbbrevMode)
where
doAbbrevMode :: A.AbbrevMode -> A.AbbrevMode
doAbbrevMode A.ResultAbbrev = A.Abbrev
doAbbrevMode s = s
-- | Rewrite abbreviation modes in the state.
updateAbbrevsInState :: Pass
updateAbbrevsInState :: Pass t
updateAbbrevsInState
= pass "Update INITIAL and RESULT abbreviations in state"
[Prop.initialRemoved, Prop.resultRemoved]
[]
(\v -> get >>* doNameAbbrevs >>= applyDepthM (return . doAbbrevMode)
>>= put >> return v)
(\v -> get >>= applyDepthM (return . doAbbrevMode) >>= put >> return v)
where
doAbbrevMode :: A.AbbrevMode -> A.AbbrevMode
doAbbrevMode A.InitialAbbrev = A.Original

View File

@ -34,13 +34,13 @@ import Traversal
import Types
import Utils
simplifyTypes :: [Pass]
simplifyTypes :: [Pass A.AST]
simplifyTypes
= [ resolveNamedTypes
]
-- | Turn named data types into their underlying types.
resolveNamedTypes :: Pass
resolveNamedTypes :: PassOn A.Type
resolveNamedTypes
= pass "Resolve user-defined types"
(Prop.agg_namesDone
@ -49,21 +49,9 @@ resolveNamedTypes
(\t -> do get >>= resolve >>= flatten >>= onCsNames (flatten <.< resolve) >>= put
resolve t >>= flatten)
where
-- Work-around for data types not being resolved:
onCsNames :: Transform A.NameDef -> Transform CompState
onCsNames f cs = do csNames' <- T.mapM f $ csNames cs
return $ cs { csNames = csNames' }
resolve :: PassType
resolve = applyDepthM doType
where
doType :: A.Type -> PassM A.Type
doType t@(A.UserDataType _) = underlyingType emptyMeta t
doType t = return t
flatten :: PassType
flatten = applyDepthM doType
where
doType :: Transform A.Type
doType (A.Array dsA (A.Array dsB t)) = return $ A.Array (dsA++dsB) t
doType t = return t