-
-splitNewType_maybe :: Type -> Maybe Type
--- Find the representation of a newtype, if it is one
--- Looks through multiple levels of newtype, but does not look through for-alls
-splitNewType_maybe (NoteTy _ ty) = splitNewType_maybe ty
-splitNewType_maybe (PredTy p) = splitNewType_maybe (predRepTy p)
-splitNewType_maybe (TyConApp tc tys) = case newTyConRep tc of
- Just rep_ty -> ASSERT( length tys == tyConArity tc )
- -- The assert should hold because repType should
- -- only be applied to *types* (of kind *)
- Just (applyTys rep_ty tys)
- Nothing -> Nothing
-splitNewType_maybe other = Nothing
-\end{code}
-
-
-
----------------------------------------------------------------------
- UsgNote
- ~~~~~~~
-
-NB: Invariant: if present, usage note is at the very top of the type.
-This should be carefully preserved.
-
-In some parts of the compiler, comments use the _Once Upon a
-Polymorphic Type_ (POPL'99) usage of "rho = generalised
-usage-annotated type; sigma = usage-annotated type; tau =
-usage-annotated type except on top"; unfortunately this conflicts with
-the rho/tau/theta/sigma usage in the rest of the compiler. (KSW
-1999-07)
-
-\begin{code}
-mkUsgTy :: UsageAnn -> Type -> Type
-#ifndef USMANY
-mkUsgTy UsMany ty = ASSERT2( isNotUsgTy ty, pprType ty )
- ty
-#endif
-mkUsgTy usg ty = ASSERT2( isNotUsgTy ty, pprType ty )
- NoteTy (UsgNote usg) ty
-
--- The isUsgTy function is utterly useless if UsManys are omitted.
--- Be warned! KSW 1999-04.
-isUsgTy :: Type -> Bool
-#ifndef USMANY
-isUsgTy _ = True
-#else
-isUsgTy (NoteTy (UsgForAll _) ty) = isUsgTy ty
-isUsgTy (NoteTy (UsgNote _) _ ) = True
-isUsgTy other = False
-#endif
-
--- The isNotUsgTy function may return a false True if UsManys are omitted;
--- in other words, A SSERT( isNotUsgTy ty ) may be useful but
--- A SSERT( not (isNotUsg ty) ) is asking for trouble. KSW 1999-04.
-isNotUsgTy :: Type -> Bool
-isNotUsgTy (NoteTy (UsgForAll _) _) = False
-isNotUsgTy (NoteTy (UsgNote _) _) = False
-isNotUsgTy other = True
-
--- splitUsgTy_maybe is not exported, since it is meaningless if
--- UsManys are omitted. It is used in several places in this module,
--- however. KSW 1999-04.
-splitUsgTy_maybe :: Type -> Maybe (UsageAnn,Type)
-splitUsgTy_maybe (NoteTy (UsgNote usg) ty2) = ASSERT( isNotUsgTy ty2 )
- Just (usg,ty2)
-splitUsgTy_maybe ty@(NoteTy (UsgForAll _) _) = pprPanic "splitUsgTy_maybe:" $ pprType ty
-splitUsgTy_maybe ty = Nothing
-
-splitUsgTy :: Type -> (UsageAnn,Type)
-splitUsgTy ty = case splitUsgTy_maybe ty of
- Just ans -> ans
- Nothing ->
-#ifndef USMANY
- (UsMany,ty)
-#else
- pprPanic "splitUsgTy: no usage annot:" $ pprType ty
-#endif
-
-tyUsg :: Type -> UsageAnn
-tyUsg = fst . splitUsgTy
-
-unUsgTy :: Type -> Type
--- strip outer usage annotation if present
-unUsgTy ty = case splitUsgTy_maybe ty of
- Just (_,ty1) -> ASSERT2( isNotUsgTy ty1, pprType ty )
- ty1
- Nothing -> ty
-
-mkUsForAllTy :: UVar -> Type -> Type
-mkUsForAllTy uv ty = NoteTy (UsgForAll uv) ty
-
-mkUsForAllTys :: [UVar] -> Type -> Type
-mkUsForAllTys uvs ty = foldr (NoteTy . UsgForAll) ty uvs
-
-splitUsForAllTys :: Type -> ([UVar],Type)
-splitUsForAllTys ty = split ty []
- where split (NoteTy (UsgForAll u) ty) uvs = split ty (u:uvs)
- split other_ty uvs = (reverse uvs, other_ty)
-
-substUsTy :: VarEnv UsageAnn -> Type -> Type
--- assumes range is fresh uvars, so no conflicts
-substUsTy ve (NoteTy note@(UsgNote (UsVar u))
- ty ) = NoteTy (case lookupVarEnv ve u of
- Just ua -> UsgNote ua
- Nothing -> note)
- (substUsTy ve ty)
-substUsTy ve (NoteTy (SynNote ty1) ty2) = NoteTy (SynNote (substUsTy ve ty1)) (substUsTy ve ty2)
-substUsTy ve (NoteTy note ty) = NoteTy note (substUsTy ve ty)
-
-substUsTy ve (PredTy (Class c tys)) = PredTy (Class c (map (substUsTy ve) tys))
-substUsTy ve (PredTy (IParam n ty)) = PredTy (IParam n (substUsTy ve ty))
-substUsTy ve (TyVarTy tv) = TyVarTy tv
-substUsTy ve (AppTy ty1 ty2) = AppTy (substUsTy ve ty1) (substUsTy ve ty2)
-substUsTy ve (FunTy ty1 ty2) = FunTy (substUsTy ve ty1) (substUsTy ve ty2)
-substUsTy ve (TyConApp tyc tys) = TyConApp tyc (map (substUsTy ve) tys)
-substUsTy ve (ForAllTy yv ty ) = ForAllTy yv (substUsTy ve ty)