Changed the use of everywhereM in underlyingType to use makeGeneric instead

This commit is contained in:
Neil Brown 2008-02-24 15:52:09 +00:00
parent d5773ee4e0
commit caff04c548
2 changed files with 17 additions and 9 deletions

View File

@ -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

View File

@ -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