Changed the use of everywhereM in underlyingType to use makeGeneric instead
This commit is contained in:
parent
d5773ee4e0
commit
caff04c548
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user