diff --git a/common/Types.hs b/common/Types.hs index 0dce4fe..f815770 100644 --- a/common/Types.hs +++ b/common/Types.hs @@ -45,6 +45,7 @@ import Errors import EvalLiterals import Intrinsics import Metadata +import Pass import ShowCode import Utils @@ -309,14 +310,21 @@ abbrevModeOfSpec s -- | Resolve a datatype into its underlying type -- i.e. if it's a named data -- type, then return the underlying real type. This will recurse. -underlyingType :: (CSMR m, Die m) => Meta -> A.Type -> m A.Type -underlyingType m = everywhereM (mkM underlyingType') + +underlyingType :: forall m. (CSMR m, Die m) => Meta -> A.Type -> m A.Type +underlyingType m = underlyingType' where - underlyingType' :: (CSMR m, Die m) => A.Type -> m A.Type - underlyingType' t@(A.UserDataType _) + underlyingType' :: Data t => t -> m t + underlyingType' = doGeneric `extM` underlyingType'' + + doGeneric :: Data t => t -> m t + doGeneric = makeGeneric underlyingType' + + underlyingType'' :: A.Type -> m A.Type + underlyingType'' t@(A.UserDataType _) = resolveUserType m t >>= underlyingType m - underlyingType' (A.Array ds t) = return $ addDimensions ds t - underlyingType' t = return t + underlyingType'' (A.Array ds t) = return $ addDimensions ds t + underlyingType'' t = doGeneric t -- | Like underlyingType, but only do the "outer layer": if you give this a -- user type that's an array of user types, then you'll get back an array of diff --git a/pass/Pass.hs b/pass/Pass.hs index 751922c..fea3daf 100644 --- a/pass/Pass.hs +++ b/pass/Pass.hs @@ -146,11 +146,11 @@ applyToOnly f (A.Several m ss) = mapM (applyToOnly f) ss >>* A.Several m applyToOnly f (A.Only m o) = f o >>* A.Only m -- | Make a generic rule for a pass. -makeGeneric :: (Data t) => (forall s. Data s => s -> PassM s) -> t -> PassM t +makeGeneric :: forall m t. (Data t, Monad m) => (forall s. Data s => s -> m s) -> t -> m t makeGeneric top = (gmapM top) - `extM` (return :: String -> PassM String) - `extM` (return :: Meta -> PassM Meta) + `extM` (return :: String -> m String) + `extM` (return :: Meta -> m Meta) excludeConstr :: (Data a, CSMR m) => [Constr] -> a -> m a excludeConstr cons x