Adjusted all the remaining modules in the transformations directory to work with the new Pass system
This commit is contained in:
parent
1d73b56988
commit
a0c58ae836
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user