diff --git a/transformations/ImplicitMobility.hs b/transformations/ImplicitMobility.hs index 4fb1c7f..6c83f37 100644 --- a/transformations/ImplicitMobility.hs +++ b/transformations/ImplicitMobility.hs @@ -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 diff --git a/transformations/SimplifyAbbrevs.hs b/transformations/SimplifyAbbrevs.hs index db2833f..3521b15 100644 --- a/transformations/SimplifyAbbrevs.hs +++ b/transformations/SimplifyAbbrevs.hs @@ -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 diff --git a/transformations/SimplifyTypes.hs b/transformations/SimplifyTypes.hs index 1ff5af7..7e8a983 100644 --- a/transformations/SimplifyTypes.hs +++ b/transformations/SimplifyTypes.hs @@ -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