-\begin{code}
--- NB mkFunTy, mkFunTys puts in Omega usages, for now at least
-mkFunTy arg res = FunTy arg res usageOmega
-
-mkFunTys :: [GenType t u] -> GenType t u -> GenType t u
-mkFunTys ts t = foldr (\ f a -> FunTy f a usageOmega) t ts
-
- -- getFunTy_maybe and splitFunTy *must* have the general type given, which
- -- means they *can't* do the DictTy jiggery-pokery that
- -- *is* sometimes required. Hence we also have the ExpandingDicts variants
- -- The relationship between these
- -- two functions is like that between eqTy and eqSimpleTy.
- -- ToDo: NUKE when we do dicts via newtype
-
-getFunTy_maybe :: GenType t u -> Maybe (GenType t u, GenType t u)
-getFunTy_maybe t
- = go t t
- where
- -- See notes on type synonyms above
- go syn_t (FunTy arg result _) = Just (arg,result)
- go syn_t (AppTy (AppTy (TyConTy tycon _) arg) res)
- | isFunTyCon tycon = Just (arg, res)
- go syn_t (SynTy _ _ t) = go syn_t t
- go syn_t other = Nothing
-
-getFunTyExpandingDicts_maybe :: Bool -- True <=> peek inside newtype applicatons
- -> Type
- -> Maybe (Type, Type)
-
-getFunTyExpandingDicts_maybe peek (FunTy arg result _) = Just (arg,result)
-getFunTyExpandingDicts_maybe peek
- (AppTy (AppTy (TyConTy tycon _) arg) res) | isFunTyCon tycon = Just (arg, res)
-getFunTyExpandingDicts_maybe peek (SynTy _ _ t) = getFunTyExpandingDicts_maybe peek t
-getFunTyExpandingDicts_maybe peek ty@(DictTy _ _ _) = getFunTyExpandingDicts_maybe peek (expandTy ty)
-
-getFunTyExpandingDicts_maybe True (ForAllTy _ ty) = getFunTyExpandingDicts_maybe True ty
- -- Ignore for-alls when peeking. See note with defn of getFunTyExpandingDictsAndPeeking
-
-
-{- This is a truly disgusting bit of code.
- It's used by the code generator to look at the rep of a newtype.
- The code gen will have thrown away coercions involving that newtype, so
- this is the other side of the coin.
- Gruesome in the extreme.
--}
-
-getFunTyExpandingDicts_maybe peek other
- | not peek = Nothing -- that was easy
- | otherwise
- = case (maybeAppTyCon other) of
- Just (tc, arg_tys)
- | isNewTyCon tc && not (null data_cons)
- -> getFunTyExpandingDicts_maybe peek inside_ty
- where
- data_cons = tyConDataCons tc
- [the_con] = data_cons
- [inside_ty] = dataConArgTys the_con arg_tys
-
- other -> Nothing
-
-
-splitFunTy :: GenType t u -> ([GenType t u], GenType t u)
-splitFunTyExpandingDicts :: Type -> ([Type], Type)
-splitFunTyExpandingDictsAndPeeking :: Type -> ([Type], Type)
-
-splitFunTy t = split_fun_ty getFunTy_maybe t
-splitFunTyExpandingDicts t = split_fun_ty (getFunTyExpandingDicts_maybe False) t
-splitFunTyExpandingDictsAndPeeking t = split_fun_ty (getFunTyExpandingDicts_maybe True) t
- -- This "peeking" stuff is used only by the code generator.
- -- It's interested in the representation type of things, ignoring:
- -- newtype Why??? Nuked SLPJ May 97. We may not know the
- -- rep of an abstractly imported newtype
- -- foralls
- -- expanding dictionary reps
- -- synonyms, of course
-
-split_fun_ty get t = go t []
- where
- go t ts = case (get t) of
- Just (arg,res) -> go res (arg:ts)
- Nothing -> (reverse ts, t)
+-- Other imports:
+
+import {-# SOURCE #-} Subst ( substTyWith )
+
+-- friends:
+import Kind
+import Var ( TyVar, tyVarKind, tyVarName, setTyVarName )
+import VarEnv
+import VarSet
+
+import Name ( NamedThing(..), mkInternalName, tidyOccName )
+import Class ( Class, classTyCon )
+import TyCon ( TyCon, isRecursiveTyCon, isPrimTyCon,
+ isUnboxedTupleTyCon, isUnLiftedTyCon,
+ isFunTyCon, isNewTyCon, newTyConRep, newTyConRhs,
+ isAlgTyCon, isSynTyCon, tyConArity,
+ tyConKind, getSynTyConDefn, PrimRep(..), tyConPrimRep,
+ )
+
+-- others
+import CmdLineOpts ( opt_DictsStrict )
+import SrcLoc ( noSrcLoc )
+import Unique ( Uniquable(..) )
+import Util ( mapAccumL, seqList, lengthIs, snocView )
+import Outputable
+import UniqSet ( sizeUniqSet ) -- Should come via VarSet
+import Maybe ( isJust )