This BIG PATCH contains most of the work for the New Coercion Representation
[ghc.git] / compiler / typecheck / TcType.lhs
1 %
2 % (c) The University of Glasgow 2006
3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 %
5 \section[TcType]{Types used in the typechecker}
6
7 This module provides the Type interface for front-end parts of the 
8 compiler.  These parts 
9
10         * treat "source types" as opaque: 
11                 newtypes, and predicates are meaningful. 
12         * look through usage types
13
14 The "tc" prefix is for "TypeChecker", because the type checker
15 is the principal client.
16
17 \begin{code}
18 module TcType (
19   --------------------------------
20   -- Types 
21   TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType, 
22   TcCoercion, TcTyVar, TcTyVarSet, TcKind, TcCoVar,
23
24   --------------------------------
25   -- MetaDetails
26   UserTypeCtxt(..), pprUserTypeCtxt,
27   TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTv, superSkolemTv,
28   MetaDetails(Flexi, Indirect), MetaInfo(..), 
29   isImmutableTyVar, isSkolemTyVar, isMetaTyVar,  isMetaTyVarTy,
30   isSigTyVar, isOverlappableTyVar,  isTyConableTyVar,
31   metaTvRef, 
32   isFlexi, isIndirect, isRuntimeUnkSkol,
33
34   --------------------------------
35   -- Builders
36   mkPhiTy, mkSigmaTy, 
37
38   --------------------------------
39   -- Splitters  
40   -- These are important because they do not look through newtypes
41   tcView,
42   tcSplitForAllTys, tcSplitPhiTy, tcSplitPredFunTy_maybe,
43   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
44   tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
45   tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
46   tcInstHeadTyNotSynonym, tcInstHeadTyAppAllTyVars,
47   tcGetTyVar_maybe, tcGetTyVar,
48   tcSplitSigmaTy, tcDeepSplitSigmaTy_maybe, 
49
50   ---------------------------------
51   -- Predicates. 
52   -- Again, newtypes are opaque
53   eqType, eqTypes, eqPred, cmpType, cmpTypes, cmpPred, eqTypeX,
54   eqKind, 
55   isSigmaTy, isOverloadedTy,
56   isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
57   isIntegerTy, isBoolTy, isUnitTy, isCharTy,
58   isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy, 
59   isSynFamilyTyConApp,
60
61   ---------------------------------
62   -- Misc type manipulators
63   deNoteType,
64   orphNamesOfType, orphNamesOfDFunHead, orphNamesOfCo,
65   getDFunTyKey,
66
67   ---------------------------------
68   -- Predicate types  
69   mkMinimalBySCs, transSuperClasses, immSuperClasses,
70
71   -- * Tidying type related things up for printing
72   tidyType,      tidyTypes,
73   tidyOpenType,  tidyOpenTypes,
74   tidyTyVarBndr, tidyFreeTyVars,
75   tidyOpenTyVar, tidyOpenTyVars,
76   tidyTopType,   tidyPred,
77   tidyKind, 
78   tidyCo, tidyCos,
79
80   ---------------------------------
81   -- Foreign import and export
82   isFFIArgumentTy,     -- :: DynFlags -> Safety -> Type -> Bool
83   isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
84   isFFIExportResultTy, -- :: Type -> Bool
85   isFFIExternalTy,     -- :: Type -> Bool
86   isFFIDynArgumentTy,  -- :: Type -> Bool
87   isFFIDynResultTy,    -- :: Type -> Bool
88   isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
89   isFFIPrimResultTy,   -- :: DynFlags -> Type -> Bool
90   isFFILabelTy,        -- :: Type -> Bool
91   isFFIDotnetTy,       -- :: DynFlags -> Type -> Bool
92   isFFIDotnetObjTy,    -- :: Type -> Bool
93   isFFITy,             -- :: Type -> Bool
94   isFunPtrTy,          -- :: Type -> Bool
95   tcSplitIOType_maybe, -- :: Type -> Maybe Type  
96
97   --------------------------------
98   -- Rexported from Kind
99   Kind, typeKind,
100   unliftedTypeKind, liftedTypeKind, argTypeKind,
101   openTypeKind, mkArrowKind, mkArrowKinds, 
102   isLiftedTypeKind, isUnliftedTypeKind, isSubOpenTypeKind, 
103   isSubArgTypeKind, isSubKind, splitKindFunTys, defaultKind,
104   kindVarRef, mkKindVar,  
105
106   --------------------------------
107   -- Rexported from Type
108   Type, Pred(..), PredType, ThetaType,
109   mkForAllTy, mkForAllTys, 
110   mkFunTy, mkFunTys, zipFunTys, 
111   mkTyConApp, mkAppTy, mkAppTys, applyTy, applyTys,
112   mkTyVarTy, mkTyVarTys, mkTyConTy, mkPredTy, mkPredTys, 
113
114   getClassPredTys_maybe, getClassPredTys, 
115   isClassPred, isTyVarClassPred, isEqPred, 
116   mkClassPred, mkIPPred, splitPredTy_maybe, 
117   mkDictTy, isPredTy, isDictTy, isDictLikeTy,
118   tcSplitDFunTy, tcSplitDFunHead, 
119   isIPPred, mkEqPred,
120
121   -- Type substitutions
122   TvSubst(..),  -- Representation visible to a few friends
123   TvSubstEnv, emptyTvSubst, 
124   mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, 
125   mkTopTvSubst, notElemTvSubst, unionTvSubst,
126   getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope, 
127   Type.lookupTyVar, Type.extendTvSubst, Type.substTyVarBndr,
128   extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
129   Type.substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars, 
130
131   isUnLiftedType,       -- Source types are always lifted
132   isUnboxedTupleType,   -- Ditto
133   isPrimitiveType, 
134
135   tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
136   tcTyVarsOfType, tcTyVarsOfTypes, tcTyVarsOfPred, exactTyVarsOfType,
137   exactTyVarsOfTypes, 
138
139   pprKind, pprParendKind,
140   pprType, pprParendType, pprTypeApp, pprTyThingCategory,
141   pprPred, pprTheta, pprThetaArrow, pprThetaArrowTy, pprClassPred
142
143   ) where
144
145 #include "HsVersions.h"
146
147 -- friends:
148 import Kind
149 import TypeRep
150 import Class
151 import Var
152 import ForeignCall
153 import VarSet
154 import Type
155 import Coercion
156 import TyCon
157
158 -- others:
159 import DynFlags
160 import Name hiding (varName)
161 import NameSet
162 import VarEnv
163 import PrelNames
164 import TysWiredIn
165 import BasicTypes
166 import Util
167 import Maybes
168 import ListSetOps
169 import Outputable
170 import FastString
171
172 import qualified Data.Foldable as Foldable
173 import Data.Functor( (<$>) )
174 import Data.List( mapAccumL )
175 import Data.IORef
176 \end{code}
177
178 %************************************************************************
179 %*                                                                      *
180 \subsection{Types}
181 %*                                                                      *
182 %************************************************************************
183
184 The type checker divides the generic Type world into the 
185 following more structured beasts:
186
187 sigma ::= forall tyvars. phi
188         -- A sigma type is a qualified type
189         --
190         -- Note that even if 'tyvars' is empty, theta
191         -- may not be: e.g.   (?x::Int) => Int
192
193         -- Note that 'sigma' is in prenex form:
194         -- all the foralls are at the front.
195         -- A 'phi' type has no foralls to the right of
196         -- an arrow
197
198 phi :: theta => rho
199
200 rho ::= sigma -> rho
201      |  tau
202
203 -- A 'tau' type has no quantification anywhere
204 -- Note that the args of a type constructor must be taus
205 tau ::= tyvar
206      |  tycon tau_1 .. tau_n
207      |  tau_1 tau_2
208      |  tau_1 -> tau_2
209
210 -- In all cases, a (saturated) type synonym application is legal,
211 -- provided it expands to the required form.
212
213 \begin{code}
214 type TcTyVar = TyVar    -- Used only during type inference
215 type TcCoVar = CoVar    -- Used only during type inference; mutable
216 type TcType = Type      -- A TcType can have mutable type variables
217         -- Invariant on ForAllTy in TcTypes:
218         --      forall a. T
219         -- a cannot occur inside a MutTyVar in T; that is,
220         -- T is "flattened" before quantifying over a
221
222 type TcCoercion = Coercion  -- A TcCoercion can contain TcTypes.
223
224 -- These types do not have boxy type variables in them
225 type TcPredType     = PredType
226 type TcThetaType    = ThetaType
227 type TcSigmaType    = TcType
228 type TcRhoType      = TcType
229 type TcTauType      = TcType
230 type TcKind         = Kind
231 type TcTyVarSet     = TyVarSet
232 \end{code}
233
234
235 %************************************************************************
236 %*                                                                      *
237 \subsection{TyVarDetails}
238 %*                                                                      *
239 %************************************************************************
240
241 TyVarDetails gives extra info about type variables, used during type
242 checking.  It's attached to mutable type variables only.
243 It's knot-tied back to Var.lhs.  There is no reason in principle
244 why Var.lhs shouldn't actually have the definition, but it "belongs" here.
245
246
247 Note [Signature skolems]
248 ~~~~~~~~~~~~~~~~~~~~~~~~
249 Consider this
250
251   x :: [a]
252   y :: b
253   (x,y,z) = ([y,z], z, head x)
254
255 Here, x and y have type sigs, which go into the environment.  We used to
256 instantiate their types with skolem constants, and push those types into
257 the RHS, so we'd typecheck the RHS with type
258         ( [a*], b*, c )
259 where a*, b* are skolem constants, and c is an ordinary meta type varible.
260
261 The trouble is that the occurrences of z in the RHS force a* and b* to 
262 be the *same*, so we can't make them into skolem constants that don't unify
263 with each other.  Alas.
264
265 One solution would be insist that in the above defn the programmer uses
266 the same type variable in both type signatures.  But that takes explanation.
267
268 The alternative (currently implemented) is to have a special kind of skolem
269 constant, SigTv, which can unify with other SigTvs.  These are *not* treated
270 as rigid for the purposes of GADTs.  And they are used *only* for pattern
271 bindings and mutually recursive function bindings.  See the function
272 TcBinds.tcInstSig, and its use_skols parameter.
273
274
275 \begin{code}
276 -- A TyVarDetails is inside a TyVar
277 data TcTyVarDetails
278   = SkolemTv      -- A skolem
279        Bool       -- True <=> this skolem type variable can be overlapped
280                   --          when looking up instances
281                   -- See Note [Binding when looking up instances] in InstEnv
282
283   | RuntimeUnk    -- Stands for an as-yet-unknown type in the GHCi
284                   -- interactive context
285
286   | FlatSkol TcType
287            -- The "skolem" obtained by flattening during
288            -- constraint simplification
289     
290            -- In comments we will use the notation alpha[flat = ty]
291            -- to represent a flattening skolem variable alpha
292            -- identified with type ty.
293           
294   | MetaTv MetaInfo (IORef MetaDetails)
295
296 vanillaSkolemTv, superSkolemTv :: TcTyVarDetails
297 -- See Note [Binding when looking up instances] in InstEnv
298 vanillaSkolemTv = SkolemTv False  -- Might be instantiated
299 superSkolemTv   = SkolemTv True   -- Treat this as a completely distinct type
300
301 data MetaDetails
302   = Flexi  -- Flexi type variables unify to become Indirects  
303   | Indirect TcType
304
305 instance Outputable MetaDetails where
306   ppr Flexi         = ptext (sLit "Flexi")
307   ppr (Indirect ty) = ptext (sLit "Indirect") <+> ppr ty
308
309 data MetaInfo
310    = TauTv         -- This MetaTv is an ordinary unification variable
311                    -- A TauTv is always filled in with a tau-type, which
312                    -- never contains any ForAlls 
313
314    | SigTv Name    -- A variant of TauTv, except that it should not be
315                    -- unified with a type, only with a type variable
316                    -- SigTvs are only distinguished to improve error messages
317                    --      see Note [Signature skolems]        
318                    --      The MetaDetails, if filled in, will 
319                    --      always be another SigTv or a SkolemTv
320                    -- The Name is the name of the function from whose
321                    -- type signature we got this skolem
322
323    | TcsTv         -- A MetaTv allocated by the constraint solver
324                    -- Its particular property is that it is always "touchable"
325                    -- Nevertheless, the constraint solver has to try to guess
326                    -- what type to instantiate it to
327
328 -------------------------------------
329 -- UserTypeCtxt describes the origin of the polymorphic type
330 -- in the places where we need to an expression has that type
331
332 data UserTypeCtxt
333   = FunSigCtxt Name     -- Function type signature
334                         -- Also used for types in SPECIALISE pragmas
335   | ExprSigCtxt         -- Expression type signature
336   | ConArgCtxt Name     -- Data constructor argument
337   | TySynCtxt Name      -- RHS of a type synonym decl
338   | GenPatCtxt          -- Pattern in generic decl
339                         --      f{| a+b |} (Inl x) = ...
340   | LamPatSigCtxt               -- Type sig in lambda pattern
341                         --      f (x::t) = ...
342   | BindPatSigCtxt      -- Type sig in pattern binding pattern
343                         --      (x::t, y) = e
344   | ResSigCtxt          -- Result type sig
345                         --      f x :: t = ....
346   | ForSigCtxt Name     -- Foreign inport or export signature
347   | DefaultDeclCtxt     -- Types in a default declaration
348   | SpecInstCtxt        -- SPECIALISE instance pragma
349   | ThBrackCtxt         -- Template Haskell type brackets [t| ... |]
350
351   | GenSigCtxt          -- Higher-rank or impredicative situations
352                         -- e.g. (f e) where f has a higher-rank type
353                         -- We might want to elaborate this
354
355 -- Notes re TySynCtxt
356 -- We allow type synonyms that aren't types; e.g.  type List = []
357 --
358 -- If the RHS mentions tyvars that aren't in scope, we'll 
359 -- quantify over them:
360 --      e.g.    type T = a->a
361 -- will become  type T = forall a. a->a
362 --
363 -- With gla-exts that's right, but for H98 we should complain. 
364
365 ---------------------------------
366 -- Kind variables:
367
368 mkKindName :: Unique -> Name
369 mkKindName unique = mkSystemName unique kind_var_occ
370
371 kindVarRef :: KindVar -> IORef MetaDetails
372 kindVarRef tc = 
373   ASSERT ( isTcTyVar tc )
374   case tcTyVarDetails tc of
375     MetaTv TauTv ref -> ref
376     _                -> pprPanic "kindVarRef" (ppr tc)
377
378 mkKindVar :: Unique -> IORef MetaDetails -> KindVar
379 mkKindVar u r 
380   = mkTcTyVar (mkKindName u)
381               tySuperKind  -- not sure this is right,
382                             -- do we need kind vars for
383                             -- coercions?
384               (MetaTv TauTv r)
385
386 kind_var_occ :: OccName -- Just one for all KindVars
387                         -- They may be jiggled by tidying
388 kind_var_occ = mkOccName tvName "k"
389 \end{code}
390
391 %************************************************************************
392 %*                                                                      *
393                 Pretty-printing
394 %*                                                                      *
395 %************************************************************************
396
397 \begin{code}
398 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
399 -- For debugging
400 pprTcTyVarDetails (SkolemTv _)         = ptext (sLit "sk")
401 pprTcTyVarDetails (RuntimeUnk {})      = ptext (sLit "rt")
402 pprTcTyVarDetails (FlatSkol {})        = ptext (sLit "fsk")
403 pprTcTyVarDetails (MetaTv TauTv _)     = ptext (sLit "tau")
404 pprTcTyVarDetails (MetaTv TcsTv _)     = ptext (sLit "tcs")
405 pprTcTyVarDetails (MetaTv (SigTv _) _) = ptext (sLit "sig")
406
407 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
408 pprUserTypeCtxt (FunSigCtxt n)  = ptext (sLit "the type signature for") <+> quotes (ppr n)
409 pprUserTypeCtxt ExprSigCtxt     = ptext (sLit "an expression type signature")
410 pprUserTypeCtxt (ConArgCtxt c)  = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
411 pprUserTypeCtxt (TySynCtxt c)   = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
412 pprUserTypeCtxt GenPatCtxt      = ptext (sLit "the type pattern of a generic definition")
413 pprUserTypeCtxt ThBrackCtxt     = ptext (sLit "a Template Haskell quotation [t|...|]")
414 pprUserTypeCtxt LamPatSigCtxt   = ptext (sLit "a pattern type signature")
415 pprUserTypeCtxt BindPatSigCtxt  = ptext (sLit "a pattern type signature")
416 pprUserTypeCtxt ResSigCtxt      = ptext (sLit "a result type signature")
417 pprUserTypeCtxt (ForSigCtxt n)  = ptext (sLit "the foreign declaration for") <+> quotes (ppr n)
418 pprUserTypeCtxt DefaultDeclCtxt = ptext (sLit "a type in a `default' declaration")
419 pprUserTypeCtxt SpecInstCtxt    = ptext (sLit "a SPECIALISE instance pragma")
420 pprUserTypeCtxt GenSigCtxt      = ptext (sLit "a type expected by the context")
421 \end{code}
422
423
424 %************************************************************************
425 %*                                                                      *
426 \subsection{TidyType}
427 %*                                                                      *
428 %************************************************************************
429
430 \begin{code}
431 -- | This tidies up a type for printing in an error message, or in
432 -- an interface file.
433 -- 
434 -- It doesn't change the uniques at all, just the print names.
435 tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
436 tidyTyVarBndr (tidy_env, subst) tyvar
437   = case tidyOccName tidy_env occ1 of
438       (tidy', occ') -> ((tidy', subst'), tyvar')
439         where
440           subst' = extendVarEnv subst tyvar tyvar'
441           tyvar' = setTyVarName tyvar name'
442           name'  = tidyNameOcc name occ'
443   where
444     name = tyVarName tyvar
445     occ  = getOccName name
446     -- System Names are for unification variables;
447     -- when we tidy them we give them a trailing "0" (or 1 etc)
448     -- so that they don't take precedence for the un-modified name
449     occ1 | isSystemName name = mkTyVarOcc (occNameString occ ++ "0")
450          | otherwise         = occ
451
452
453 ---------------
454 tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
455 -- ^ Add the free 'TyVar's to the env in tidy form,
456 -- so that we can tidy the type they are free in
457 tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))
458
459 ---------------
460 tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
461 tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars
462
463 ---------------
464 tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
465 -- ^ Treat a new 'TyVar' as a binder, and give it a fresh tidy name
466 -- using the environment if one has not already been allocated. See
467 -- also 'tidyTyVarBndr'
468 tidyOpenTyVar env@(_, subst) tyvar
469   = case lookupVarEnv subst tyvar of
470         Just tyvar' -> (env, tyvar')            -- Already substituted
471         Nothing     -> tidyTyVarBndr env tyvar  -- Treat it as a binder
472
473 ---------------
474 tidyType :: TidyEnv -> Type -> Type
475 tidyType env@(_, subst) ty
476   = go ty
477   where
478     go (TyVarTy tv)         = case lookupVarEnv subst tv of
479                                 Nothing  -> expand tv
480                                 Just tv' -> expand tv'
481     go (TyConApp tycon tys) = let args = map go tys
482                               in args `seqList` TyConApp tycon args
483     go (PredTy sty)         = PredTy (tidyPred env sty)
484     go (AppTy fun arg)      = (AppTy $! (go fun)) $! (go arg)
485     go (FunTy fun arg)      = (FunTy $! (go fun)) $! (go arg)
486     go (ForAllTy tv ty)     = ForAllTy tvp $! (tidyType envp ty)
487                               where
488                                 (envp, tvp) = tidyTyVarBndr env tv
489
490     -- Expand FlatSkols, the skolems introduced by flattening process
491     -- We don't want to show them in type error messages
492     expand tv | isTcTyVar tv
493               , FlatSkol ty <- tcTyVarDetails tv
494               = go ty
495               | otherwise
496               = TyVarTy tv
497
498 ---------------
499 tidyTypes :: TidyEnv -> [Type] -> [Type]
500 tidyTypes env tys = map (tidyType env) tys
501
502 ---------------
503 tidyPred :: TidyEnv -> PredType -> PredType
504 tidyPred env (IParam n ty)     = IParam n (tidyType env ty)
505 tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
506 tidyPred env (EqPred ty1 ty2)  = EqPred (tidyType env ty1) (tidyType env ty2)
507
508 ---------------
509 -- | Grabs the free type variables, tidies them
510 -- and then uses 'tidyType' to work over the type itself
511 tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
512 tidyOpenType env ty
513   = (env', tidyType env' ty)
514   where
515     env' = tidyFreeTyVars env (tyVarsOfType ty)
516
517 ---------------
518 tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
519 tidyOpenTypes env tys = mapAccumL tidyOpenType env tys
520
521 ---------------
522 -- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)
523 tidyTopType :: Type -> Type
524 tidyTopType ty = tidyType emptyTidyEnv ty
525
526 ---------------
527 tidyKind :: TidyEnv -> Kind -> (TidyEnv, Kind)
528 tidyKind env k = tidyOpenType env k
529 \end{code}
530
531 %************************************************************************
532 %*                                                                      *
533                             Tidying coercions
534 %*                                                                      *
535 %************************************************************************
536
537 \begin{code}
538
539 tidyCo :: TidyEnv -> Coercion -> Coercion
540 tidyCo env@(_, subst) co
541   = go co
542   where
543     go (Refl ty)             = Refl (tidyType env ty)
544     go (TyConAppCo tc cos)   = let args = map go cos
545                                in args `seqList` TyConAppCo tc args
546     go (AppCo co1 co2)       = (AppCo $! go co1) $! go co2
547     go (ForAllCo tv co)      = ForAllCo tvp $! (tidyCo envp co)
548                                where
549                                  (envp, tvp) = tidyTyVarBndr env tv
550     go (PredCo pco)          = PredCo $! (go <$> pco)
551     go (CoVarCo cv)          = case lookupVarEnv subst cv of
552                                  Nothing  -> CoVarCo cv
553                                  Just cv' -> CoVarCo cv'
554     go (AxiomInstCo con cos) = let args = tidyCos env cos
555                                in  args `seqList` AxiomInstCo con args
556     go (UnsafeCo ty1 ty2)    = (UnsafeCo $! tidyType env ty1) $! tidyType env ty2
557     go (SymCo co)            = SymCo $! go co
558     go (TransCo co1 co2)     = (TransCo $! go co1) $! go co2
559     go (NthCo d co)          = NthCo d $! go co
560     go (InstCo co ty)        = (InstCo $! go co) $! tidyType env ty
561
562 tidyCos :: TidyEnv -> [Coercion] -> [Coercion]
563 tidyCos env = map (tidyCo env)
564
565 \end{code}
566
567 %************************************************************************
568 %*                                                                      *
569                 Predicates
570 %*                                                                      *
571 %************************************************************************
572
573 \begin{code}
574 isImmutableTyVar :: TyVar -> Bool
575
576 isImmutableTyVar tv
577   | isTcTyVar tv = isSkolemTyVar tv
578   | otherwise    = True
579
580 isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,
581   isMetaTyVar :: TcTyVar -> Bool 
582
583 isTyConableTyVar tv     
584         -- True of a meta-type variable that can be filled in 
585         -- with a type constructor application; in particular,
586         -- not a SigTv
587   = ASSERT( isTcTyVar tv) 
588     case tcTyVarDetails tv of
589         MetaTv (SigTv _) _ -> False
590         _                  -> True
591
592 isSkolemTyVar tv 
593   = ASSERT2( isTcTyVar tv, ppr tv )
594     case tcTyVarDetails tv of
595         SkolemTv {}   -> True
596         FlatSkol {}   -> True
597         RuntimeUnk {} -> True
598         MetaTv {}     -> False
599
600 isOverlappableTyVar tv
601   = ASSERT( isTcTyVar tv )
602     case tcTyVarDetails tv of
603         SkolemTv overlappable -> overlappable
604         _                     -> False
605
606 isMetaTyVar tv 
607   = ASSERT2( isTcTyVar tv, ppr tv )
608     case tcTyVarDetails tv of
609         MetaTv _ _ -> True
610         _          -> False
611
612 isMetaTyVarTy :: TcType -> Bool
613 isMetaTyVarTy (TyVarTy tv) = isMetaTyVar tv
614 isMetaTyVarTy _            = False
615
616 isSigTyVar :: Var -> Bool
617 isSigTyVar tv 
618   = ASSERT( isTcTyVar tv )
619     case tcTyVarDetails tv of
620         MetaTv (SigTv _) _ -> True
621         _                  -> False
622
623 metaTvRef :: TyVar -> IORef MetaDetails
624 metaTvRef tv 
625   = ASSERT2( isTcTyVar tv, ppr tv )
626     case tcTyVarDetails tv of
627         MetaTv _ ref -> ref
628         _          -> pprPanic "metaTvRef" (ppr tv)
629
630 isFlexi, isIndirect :: MetaDetails -> Bool
631 isFlexi Flexi = True
632 isFlexi _     = False
633
634 isIndirect (Indirect _) = True
635 isIndirect _            = False
636
637 isRuntimeUnkSkol :: TyVar -> Bool
638 -- Called only in TcErrors; see Note [Runtime skolems] there
639 isRuntimeUnkSkol x
640   | isTcTyVar x, RuntimeUnk <- tcTyVarDetails x = True
641   | otherwise                                   = False
642 \end{code}
643
644
645 %************************************************************************
646 %*                                                                      *
647 \subsection{Tau, sigma and rho}
648 %*                                                                      *
649 %************************************************************************
650
651 \begin{code}
652 mkSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
653 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
654
655 mkPhiTy :: [PredType] -> Type -> Type
656 mkPhiTy theta ty = foldr (\p r -> mkFunTy (mkPredTy p) r) ty theta
657 \end{code}
658
659 @isTauTy@ tests for nested for-alls.  It should not be called on a boxy type.
660
661 \begin{code}
662 isTauTy :: Type -> Bool
663 isTauTy ty | Just ty' <- tcView ty = isTauTy ty'
664 isTauTy (TyVarTy _)       = True
665 isTauTy (TyConApp tc tys) = all isTauTy tys && isTauTyCon tc
666 isTauTy (AppTy a b)       = isTauTy a && isTauTy b
667 isTauTy (FunTy a b)       = isTauTy a && isTauTy b
668 isTauTy (PredTy _)        = True                -- Don't look through source types
669 isTauTy _                 = False
670
671 isTauTyCon :: TyCon -> Bool
672 -- Returns False for type synonyms whose expansion is a polytype
673 isTauTyCon tc 
674   | isClosedSynTyCon tc = isTauTy (snd (synTyConDefn tc))
675   | otherwise           = True
676
677 ---------------
678 getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to
679                                 -- construct a dictionary function name
680 getDFunTyKey ty | Just ty' <- tcView ty = getDFunTyKey ty'
681 getDFunTyKey (TyVarTy tv)    = getOccName tv
682 getDFunTyKey (TyConApp tc _) = getOccName tc
683 getDFunTyKey (AppTy fun _)   = getDFunTyKey fun
684 getDFunTyKey (FunTy _ _)     = getOccName funTyCon
685 getDFunTyKey (ForAllTy _ t)  = getDFunTyKey t
686 getDFunTyKey ty              = pprPanic "getDFunTyKey" (pprType ty)
687 -- PredTy shouldn't happen
688 \end{code}
689
690
691 %************************************************************************
692 %*                                                                      *
693 \subsection{Expanding and splitting}
694 %*                                                                      *
695 %************************************************************************
696
697 These tcSplit functions are like their non-Tc analogues, but
698         a) they do not look through newtypes
699         b) they do not look through PredTys
700
701 However, they are non-monadic and do not follow through mutable type
702 variables.  It's up to you to make sure this doesn't matter.
703
704 \begin{code}
705 tcSplitForAllTys :: Type -> ([TyVar], Type)
706 tcSplitForAllTys ty = split ty ty []
707    where
708      split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
709      split _ (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
710      split orig_ty _          tvs = (reverse tvs, orig_ty)
711
712 tcIsForAllTy :: Type -> Bool
713 tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
714 tcIsForAllTy (ForAllTy {}) = True
715 tcIsForAllTy _             = False
716
717 tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
718 -- Split off the first predicate argument from a type
719 tcSplitPredFunTy_maybe ty | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'
720 tcSplitPredFunTy_maybe (FunTy arg res)
721   | Just p <- splitPredTy_maybe arg = Just (p, res)
722 tcSplitPredFunTy_maybe _
723   = Nothing
724
725 tcSplitPhiTy :: Type -> (ThetaType, Type)
726 tcSplitPhiTy ty
727   = split ty []
728   where
729     split ty ts 
730       = case tcSplitPredFunTy_maybe ty of
731           Just (pred, ty) -> split ty (pred:ts)
732           Nothing         -> (reverse ts, ty)
733
734 tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
735 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
736                         (tvs, rho) -> case tcSplitPhiTy rho of
737                                         (theta, tau) -> (tvs, theta, tau)
738
739 -----------------------
740 tcDeepSplitSigmaTy_maybe
741   :: TcSigmaType -> Maybe ([TcType], [TyVar], ThetaType, TcSigmaType)
742 -- Looks for a *non-trivial* quantified type, under zero or more function arrows
743 -- By "non-trivial" we mean either tyvars or constraints are non-empty
744
745 tcDeepSplitSigmaTy_maybe ty
746   | Just (arg_ty, res_ty)           <- tcSplitFunTy_maybe ty
747   , Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe res_ty
748   = Just (arg_ty:arg_tys, tvs, theta, rho)
749
750   | (tvs, theta, rho) <- tcSplitSigmaTy ty
751   , not (null tvs && null theta)
752   = Just ([], tvs, theta, rho)
753
754   | otherwise = Nothing
755
756 -----------------------
757 tcTyConAppTyCon :: Type -> TyCon
758 tcTyConAppTyCon ty = case tcSplitTyConApp_maybe ty of
759                         Just (tc, _) -> tc
760                         Nothing      -> pprPanic "tcTyConAppTyCon" (pprType ty)
761
762 tcTyConAppArgs :: Type -> [Type]
763 tcTyConAppArgs ty = case tcSplitTyConApp_maybe ty of
764                         Just (_, args) -> args
765                         Nothing        -> pprPanic "tcTyConAppArgs" (pprType ty)
766
767 tcSplitTyConApp :: Type -> (TyCon, [Type])
768 tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
769                         Just stuff -> stuff
770                         Nothing    -> pprPanic "tcSplitTyConApp" (pprType ty)
771
772 tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
773 tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'
774 tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
775 tcSplitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
776         -- Newtypes are opaque, so they may be split
777         -- However, predicates are not treated
778         -- as tycon applications by the type checker
779 tcSplitTyConApp_maybe _                 = Nothing
780
781 -----------------------
782 tcSplitFunTys :: Type -> ([Type], Type)
783 tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
784                         Nothing        -> ([], ty)
785                         Just (arg,res) -> (arg:args, res')
786                                        where
787                                           (args,res') = tcSplitFunTys res
788
789 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
790 tcSplitFunTy_maybe ty | Just ty' <- tcView ty           = tcSplitFunTy_maybe ty'
791 tcSplitFunTy_maybe (FunTy arg res) | not (isPredTy arg) = Just (arg, res)
792 tcSplitFunTy_maybe _                                    = Nothing
793         -- Note the (not (isPredTy arg)) guard
794         -- Consider     (?x::Int) => Bool
795         -- We don't want to treat this as a function type!
796         -- A concrete example is test tc230:
797         --      f :: () -> (?p :: ()) => () -> ()
798         --
799         --      g = f () ()
800
801 tcSplitFunTysN
802         :: TcRhoType 
803         -> Arity                -- N: Number of desired args
804         -> ([TcSigmaType],      -- Arg types (N or fewer)
805             TcSigmaType)        -- The rest of the type
806
807 tcSplitFunTysN ty n_args
808   | n_args == 0
809   = ([], ty)
810   | Just (arg,res) <- tcSplitFunTy_maybe ty
811   = case tcSplitFunTysN res (n_args - 1) of
812         (args, res) -> (arg:args, res)
813   | otherwise
814   = ([], ty)
815
816 tcSplitFunTy :: Type -> (Type, Type)
817 tcSplitFunTy  ty = expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty)
818
819 tcFunArgTy :: Type -> Type
820 tcFunArgTy    ty = fst (tcSplitFunTy ty)
821
822 tcFunResultTy :: Type -> Type
823 tcFunResultTy ty = snd (tcSplitFunTy ty)
824
825 -----------------------
826 tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
827 tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'
828 tcSplitAppTy_maybe ty = repSplitAppTy_maybe ty
829
830 tcSplitAppTy :: Type -> (Type, Type)
831 tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
832                     Just stuff -> stuff
833                     Nothing    -> pprPanic "tcSplitAppTy" (pprType ty)
834
835 tcSplitAppTys :: Type -> (Type, [Type])
836 tcSplitAppTys ty
837   = go ty []
838   where
839     go ty args = case tcSplitAppTy_maybe ty of
840                    Just (ty', arg) -> go ty' (arg:args)
841                    Nothing         -> (ty,args)
842
843 -----------------------
844 tcGetTyVar_maybe :: Type -> Maybe TyVar
845 tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'
846 tcGetTyVar_maybe (TyVarTy tv)   = Just tv
847 tcGetTyVar_maybe _              = Nothing
848
849 tcGetTyVar :: String -> Type -> TyVar
850 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
851
852 tcIsTyVarTy :: Type -> Bool
853 tcIsTyVarTy ty = maybeToBool (tcGetTyVar_maybe ty)
854
855 -----------------------
856 tcSplitDFunTy :: Type -> ([TyVar], Int, Class, [Type])
857 -- Split the type of a dictionary function
858 -- We don't use tcSplitSigmaTy,  because a DFun may (with NDP)
859 -- have non-Pred arguments, such as
860 --     df :: forall m. (forall b. Eq b => Eq (m b)) -> C m
861 tcSplitDFunTy ty 
862   = case tcSplitForAllTys ty   of { (tvs, rho)  ->
863     case split_dfun_args 0 rho of { (n_theta, tau) ->
864     case tcSplitDFunHead tau   of { (clas, tys) ->
865     (tvs, n_theta, clas, tys) }}}
866   where
867     -- Count the context of the dfun.  This can be a mix of
868     -- coercion and class constraints; or (in the general NDP case)
869     -- some other function argument
870     split_dfun_args n ty | Just ty' <- tcView ty = split_dfun_args n ty'
871     split_dfun_args n (FunTy _ ty)     = split_dfun_args (n+1) ty
872     split_dfun_args n ty               = (n, ty)
873
874 tcSplitDFunHead :: Type -> (Class, [Type])
875 tcSplitDFunHead tau  
876   = case splitPredTy_maybe tau of 
877         Just (ClassP clas tys) -> (clas, tys)
878         _ -> pprPanic "tcSplitDFunHead" (ppr tau)
879
880 tcInstHeadTyNotSynonym :: Type -> Bool
881 -- Used in Haskell-98 mode, for the argument types of an instance head
882 -- These must not be type synonyms, but everywhere else type synonyms
883 -- are transparent, so we need a special function here
884 tcInstHeadTyNotSynonym ty
885   = case ty of
886         TyConApp tc _ -> not (isSynTyCon tc)
887         _ -> True
888
889 tcInstHeadTyAppAllTyVars :: Type -> Bool
890 -- Used in Haskell-98 mode, for the argument types of an instance head
891 -- These must be a constructor applied to type variable arguments
892 tcInstHeadTyAppAllTyVars ty
893   | Just ty' <- tcView ty       -- Look through synonyms
894   = tcInstHeadTyAppAllTyVars ty'
895   | otherwise
896   = case ty of
897         TyConApp _ tys  -> ok tys
898         FunTy arg res   -> ok [arg, res]
899         _               -> False
900   where
901         -- Check that all the types are type variables,
902         -- and that each is distinct
903     ok tys = equalLength tvs tys && hasNoDups tvs
904            where
905              tvs = mapCatMaybes get_tv tys
906
907     get_tv (TyVarTy tv)  = Just tv      -- through synonyms
908     get_tv _             = Nothing
909 \end{code}
910
911
912
913 %************************************************************************
914 %*                                                                      *
915 \subsection{Predicate types}
916 %*                                                                      *
917 %************************************************************************
918
919 Superclasses
920
921 \begin{code}
922 mkMinimalBySCs :: [PredType] -> [PredType]
923 -- Remove predicates that can be deduced from others by superclasses
924 mkMinimalBySCs ptys = [ ploc |  ploc <- ptys
925                              ,  ploc `not_in_preds` rec_scs ]
926  where
927    rec_scs = concatMap trans_super_classes ptys
928    not_in_preds p ps = null (filter (eqPred p) ps)
929    trans_super_classes (ClassP cls tys) = transSuperClasses cls tys
930    trans_super_classes _other_pty       = []
931
932 transSuperClasses :: Class -> [Type] -> [PredType]
933 transSuperClasses cls tys
934   = foldl (\pts p -> trans_sc p ++ pts) [] $
935     immSuperClasses cls tys
936   where trans_sc :: PredType -> [PredType]
937         trans_sc this_pty@(ClassP cls tys)
938           = foldl (\pts p -> trans_sc p ++ pts) [this_pty] $
939             immSuperClasses cls tys
940         trans_sc pty = [pty]
941
942 immSuperClasses :: Class -> [Type] -> [PredType]
943 immSuperClasses cls tys
944   = substTheta (zipTopTvSubst tyvars tys) sc_theta
945   where (tyvars,sc_theta,_,_) = classBigSig cls
946 \end{code}
947
948
949 %************************************************************************
950 %*                                                                      *
951 \subsection{Predicates}
952 %*                                                                      *
953 %************************************************************************
954
955 isSigmaTy returns true of any qualified type.  It doesn't *necessarily* have 
956 any foralls.  E.g.
957         f :: (?x::Int) => Int -> Int
958
959 \begin{code}
960 isSigmaTy :: Type -> Bool
961 isSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'
962 isSigmaTy (ForAllTy _ _) = True
963 isSigmaTy (FunTy a _)    = isPredTy a
964 isSigmaTy _              = False
965
966 isOverloadedTy :: Type -> Bool
967 -- Yes for a type of a function that might require evidence-passing
968 -- Used only by bindLocalMethods
969 isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
970 isOverloadedTy (ForAllTy _ ty) = isOverloadedTy ty
971 isOverloadedTy (FunTy a _)     = isPredTy a
972 isOverloadedTy _               = False
973 \end{code}
974
975 \begin{code}
976 isFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy,
977     isUnitTy, isCharTy :: Type -> Bool
978 isFloatTy      = is_tc floatTyConKey
979 isDoubleTy     = is_tc doubleTyConKey
980 isIntegerTy    = is_tc integerTyConKey
981 isIntTy        = is_tc intTyConKey
982 isWordTy       = is_tc wordTyConKey
983 isBoolTy       = is_tc boolTyConKey
984 isUnitTy       = is_tc unitTyConKey
985 isCharTy       = is_tc charTyConKey
986
987 isStringTy :: Type -> Bool
988 isStringTy ty
989   = case tcSplitTyConApp_maybe ty of
990       Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty
991       _                   -> False
992
993 is_tc :: Unique -> Type -> Bool
994 -- Newtypes are opaque to this
995 is_tc uniq ty = case tcSplitTyConApp_maybe ty of
996                         Just (tc, _) -> uniq == getUnique tc
997                         Nothing      -> False
998 \end{code}
999
1000 \begin{code}
1001 -- NB: Currently used in places where we have already expanded type synonyms;
1002 --     hence no 'coreView'.  This could, however, be changed without breaking
1003 --     any code.
1004 isSynFamilyTyConApp :: TcTauType -> Bool
1005 isSynFamilyTyConApp (TyConApp tc tys) = isSynFamilyTyCon tc && 
1006                                       length tys == tyConArity tc 
1007 isSynFamilyTyConApp _other            = False
1008 \end{code}
1009
1010
1011 %************************************************************************
1012 %*                                                                      *
1013 \subsection{Misc}
1014 %*                                                                      *
1015 %************************************************************************
1016
1017 \begin{code}
1018 deNoteType :: Type -> Type
1019 -- Remove all *outermost* type synonyms and other notes
1020 deNoteType ty | Just ty' <- tcView ty = deNoteType ty'
1021 deNoteType ty = ty
1022 \end{code}
1023
1024 \begin{code}
1025 tcTyVarsOfType :: Type -> TcTyVarSet
1026 -- Just the *TcTyVars* free in the type
1027 -- (Types.tyVarsOfTypes finds all free TyVars)
1028 tcTyVarsOfType (TyVarTy tv)         = if isTcTyVar tv then unitVarSet tv
1029                                                       else emptyVarSet
1030 tcTyVarsOfType (TyConApp _ tys)     = tcTyVarsOfTypes tys
1031 tcTyVarsOfType (PredTy sty)         = tcTyVarsOfPred sty
1032 tcTyVarsOfType (FunTy arg res)      = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
1033 tcTyVarsOfType (AppTy fun arg)      = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
1034 tcTyVarsOfType (ForAllTy tyvar ty)  = tcTyVarsOfType ty `delVarSet` tyvar
1035         -- We do sometimes quantify over skolem TcTyVars
1036
1037 tcTyVarsOfTypes :: [Type] -> TyVarSet
1038 tcTyVarsOfTypes tys = foldr (unionVarSet.tcTyVarsOfType) emptyVarSet tys
1039
1040 tcTyVarsOfPred :: PredType -> TyVarSet
1041 tcTyVarsOfPred (IParam _ ty)    = tcTyVarsOfType ty
1042 tcTyVarsOfPred (ClassP _ tys)   = tcTyVarsOfTypes tys
1043 tcTyVarsOfPred (EqPred ty1 ty2) = tcTyVarsOfType ty1 `unionVarSet` tcTyVarsOfType ty2
1044 \end{code}
1045
1046 Find the free tycons and classes of a type.  This is used in the front
1047 end of the compiler.
1048
1049 \begin{code}
1050 orphNamesOfType :: Type -> NameSet
1051 orphNamesOfType ty | Just ty' <- tcView ty = orphNamesOfType ty'
1052                 -- Look through type synonyms (Trac #4912)
1053 orphNamesOfType (TyVarTy _)                = emptyNameSet
1054 orphNamesOfType (TyConApp tycon tys)       = unitNameSet (getName tycon) 
1055                                              `unionNameSets` orphNamesOfTypes tys
1056 orphNamesOfType (PredTy (IParam _ ty))    = orphNamesOfType ty
1057 orphNamesOfType (PredTy (ClassP cl tys))  = unitNameSet (getName cl) 
1058                                             `unionNameSets` orphNamesOfTypes tys
1059 orphNamesOfType (PredTy (EqPred ty1 ty2)) = orphNamesOfType ty1 
1060                                             `unionNameSets` orphNamesOfType ty2
1061 orphNamesOfType (FunTy arg res)     = orphNamesOfType arg `unionNameSets` orphNamesOfType res
1062 orphNamesOfType (AppTy fun arg)     = orphNamesOfType fun `unionNameSets` orphNamesOfType arg
1063 orphNamesOfType (ForAllTy _ ty)     = orphNamesOfType ty
1064
1065 orphNamesOfTypes :: [Type] -> NameSet
1066 orphNamesOfTypes tys = foldr (unionNameSets . orphNamesOfType) emptyNameSet tys
1067
1068 orphNamesOfDFunHead :: Type -> NameSet
1069 -- Find the free type constructors and classes 
1070 -- of the head of the dfun instance type
1071 -- The 'dfun_head_type' is because of
1072 --      instance Foo a => Baz T where ...
1073 -- The decl is an orphan if Baz and T are both not locally defined,
1074 --      even if Foo *is* locally defined
1075 orphNamesOfDFunHead dfun_ty 
1076   = case tcSplitSigmaTy dfun_ty of
1077         (_, _, head_ty) -> orphNamesOfType head_ty
1078         
1079 orphNamesOfCo :: Coercion -> NameSet
1080 orphNamesOfCo (Refl ty)             = orphNamesOfType ty
1081 orphNamesOfCo (TyConAppCo tc cos)   = unitNameSet (getName tc) `unionNameSets` orphNamesOfCos cos
1082 orphNamesOfCo (AppCo co1 co2)       = orphNamesOfCo co1 `unionNameSets` orphNamesOfCo co2
1083 orphNamesOfCo (ForAllCo _ co)       = orphNamesOfCo co
1084 orphNamesOfCo (PredCo p)            = Foldable.foldr (unionNameSets . orphNamesOfCo)
1085                                                       emptyNameSet p
1086 orphNamesOfCo (CoVarCo _)           = emptyNameSet
1087 orphNamesOfCo (AxiomInstCo con cos) = orphNamesOfCoCon con `unionNameSets` orphNamesOfCos cos
1088 orphNamesOfCo (UnsafeCo ty1 ty2)    = orphNamesOfType ty1 `unionNameSets` orphNamesOfType ty2
1089 orphNamesOfCo (SymCo co)            = orphNamesOfCo co
1090 orphNamesOfCo (TransCo co1 co2)     = orphNamesOfCo co1 `unionNameSets` orphNamesOfCo co2
1091 orphNamesOfCo (NthCo _ co)          = orphNamesOfCo co
1092 orphNamesOfCo (InstCo co ty)        = orphNamesOfCo co `unionNameSets` orphNamesOfType ty
1093
1094 orphNamesOfCos :: [Coercion] -> NameSet
1095 orphNamesOfCos = foldr (unionNameSets . orphNamesOfCo) emptyNameSet
1096
1097 orphNamesOfCoCon :: CoAxiom -> NameSet
1098 orphNamesOfCoCon (CoAxiom { co_ax_lhs = ty1, co_ax_rhs = ty2 })
1099   = orphNamesOfType ty1 `unionNameSets` orphNamesOfType ty2
1100 \end{code}
1101
1102
1103 %************************************************************************
1104 %*                                                                      *
1105 \subsection[TysWiredIn-ext-type]{External types}
1106 %*                                                                      *
1107 %************************************************************************
1108
1109 The compiler's foreign function interface supports the passing of a
1110 restricted set of types as arguments and results (the restricting factor
1111 being the )
1112
1113 \begin{code}
1114 tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type, Coercion)
1115 -- (isIOType t) returns Just (IO,t',co)
1116 --                              if co : t ~ IO t'
1117 --              returns Nothing otherwise
1118 tcSplitIOType_maybe ty 
1119   = case tcSplitTyConApp_maybe ty of
1120         -- This split absolutely has to be a tcSplit, because we must
1121         -- see the IO type; and it's a newtype which is transparent to splitTyConApp.
1122
1123         Just (io_tycon, [io_res_ty]) 
1124            |  io_tycon `hasKey` ioTyConKey 
1125            -> Just (io_tycon, io_res_ty, mkReflCo ty)
1126
1127         Just (tc, tys)
1128            | not (isRecursiveTyCon tc)
1129            , Just (ty, co1) <- instNewTyCon_maybe tc tys
1130                   -- Newtypes that require a coercion are ok
1131            -> case tcSplitIOType_maybe ty of
1132                 Nothing             -> Nothing
1133                 Just (tc, ty', co2) -> Just (tc, ty', co1 `mkTransCo` co2)
1134
1135         _ -> Nothing
1136
1137 isFFITy :: Type -> Bool
1138 -- True for any TyCon that can possibly be an arg or result of an FFI call
1139 isFFITy ty = checkRepTyCon legalFFITyCon ty
1140
1141 isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
1142 -- Checks for valid argument type for a 'foreign import'
1143 isFFIArgumentTy dflags safety ty 
1144    = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
1145
1146 isFFIExternalTy :: Type -> Bool
1147 -- Types that are allowed as arguments of a 'foreign export'
1148 isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
1149
1150 isFFIImportResultTy :: DynFlags -> Type -> Bool
1151 isFFIImportResultTy dflags ty 
1152   = checkRepTyCon (legalFIResultTyCon dflags) ty
1153
1154 isFFIExportResultTy :: Type -> Bool
1155 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
1156
1157 isFFIDynArgumentTy :: Type -> Bool
1158 -- The argument type of a foreign import dynamic must be Ptr, FunPtr, Addr,
1159 -- or a newtype of either.
1160 isFFIDynArgumentTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1161
1162 isFFIDynResultTy :: Type -> Bool
1163 -- The result type of a foreign export dynamic must be Ptr, FunPtr, Addr,
1164 -- or a newtype of either.
1165 isFFIDynResultTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1166
1167 isFFILabelTy :: Type -> Bool
1168 -- The type of a foreign label must be Ptr, FunPtr, Addr,
1169 -- or a newtype of either.
1170 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1171
1172 isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
1173 -- Checks for valid argument type for a 'foreign import prim'
1174 -- Currently they must all be simple unlifted types.
1175 isFFIPrimArgumentTy dflags ty
1176    = checkRepTyCon (legalFIPrimArgTyCon dflags) ty
1177
1178 isFFIPrimResultTy :: DynFlags -> Type -> Bool
1179 -- Checks for valid result type for a 'foreign import prim'
1180 -- Currently it must be an unlifted type, including unboxed tuples.
1181 isFFIPrimResultTy dflags ty
1182    = checkRepTyCon (legalFIPrimResultTyCon dflags) ty
1183
1184 isFFIDotnetTy :: DynFlags -> Type -> Bool
1185 isFFIDotnetTy dflags ty
1186   = checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc || 
1187                            isFFIDotnetObjTy ty || isStringTy ty)) ty
1188         -- NB: isStringTy used to look through newtypes, but
1189         --     it no longer does so.  May need to adjust isFFIDotNetTy
1190         --     if we do want to look through newtypes.
1191
1192 isFFIDotnetObjTy :: Type -> Bool
1193 isFFIDotnetObjTy ty
1194   = checkRepTyCon check_tc t_ty
1195   where
1196    (_, t_ty) = tcSplitForAllTys ty
1197    check_tc tc = getName tc == objectTyConName
1198
1199 isFunPtrTy :: Type -> Bool
1200 isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
1201
1202 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
1203 -- Look through newtypes, but *not* foralls
1204 -- Should work even for recursive newtypes
1205 -- eg Manuel had:       newtype T = MkT (Ptr T)
1206 checkRepTyCon check_tc ty
1207   = go [] ty
1208   where
1209     go rec_nts ty
1210       | Just (tc,tys) <- splitTyConApp_maybe ty
1211       = case carefullySplitNewType_maybe rec_nts tc tys of
1212            Just (rec_nts', ty') -> go rec_nts' ty'
1213            Nothing              -> check_tc tc
1214       | otherwise
1215       = False
1216
1217 checkRepTyConKey :: [Unique] -> Type -> Bool
1218 -- Like checkRepTyCon, but just looks at the TyCon key
1219 checkRepTyConKey keys
1220   = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
1221 \end{code}
1222
1223 ----------------------------------------------
1224 These chaps do the work; they are not exported
1225 ----------------------------------------------
1226
1227 \begin{code}
1228 legalFEArgTyCon :: TyCon -> Bool
1229 legalFEArgTyCon tc
1230   -- It's illegal to make foreign exports that take unboxed
1231   -- arguments.  The RTS API currently can't invoke such things.  --SDM 7/2000
1232   = boxedMarshalableTyCon tc
1233
1234 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
1235 legalFIResultTyCon dflags tc
1236   | tc == unitTyCon         = True
1237   | otherwise               = marshalableTyCon dflags tc
1238
1239 legalFEResultTyCon :: TyCon -> Bool
1240 legalFEResultTyCon tc
1241   | tc == unitTyCon         = True
1242   | otherwise               = boxedMarshalableTyCon tc
1243
1244 legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
1245 -- Checks validity of types going from Haskell -> external world
1246 legalOutgoingTyCon dflags _ tc
1247   = marshalableTyCon dflags tc
1248
1249 legalFFITyCon :: TyCon -> Bool
1250 -- True for any TyCon that can possibly be an arg or result of an FFI call
1251 legalFFITyCon tc
1252   = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
1253
1254 marshalableTyCon :: DynFlags -> TyCon -> Bool
1255 marshalableTyCon dflags tc
1256   =  (xopt Opt_UnliftedFFITypes dflags 
1257       && isUnLiftedTyCon tc
1258       && not (isUnboxedTupleTyCon tc)
1259       && case tyConPrimRep tc of        -- Note [Marshalling VoidRep]
1260            VoidRep -> False
1261            _       -> True)
1262   || boxedMarshalableTyCon tc
1263
1264 boxedMarshalableTyCon :: TyCon -> Bool
1265 boxedMarshalableTyCon tc
1266    = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
1267                          , int32TyConKey, int64TyConKey
1268                          , wordTyConKey, word8TyConKey, word16TyConKey
1269                          , word32TyConKey, word64TyConKey
1270                          , floatTyConKey, doubleTyConKey
1271                          , ptrTyConKey, funPtrTyConKey
1272                          , charTyConKey
1273                          , stablePtrTyConKey
1274                          , boolTyConKey
1275                          ]
1276
1277 legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
1278 -- Check args of 'foreign import prim', only allow simple unlifted types.
1279 -- Strictly speaking it is unnecessary to ban unboxed tuples here since
1280 -- currently they're of the wrong kind to use in function args anyway.
1281 legalFIPrimArgTyCon dflags tc
1282   = xopt Opt_UnliftedFFITypes dflags
1283     && isUnLiftedTyCon tc
1284     && not (isUnboxedTupleTyCon tc)
1285
1286 legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
1287 -- Check result type of 'foreign import prim'. Allow simple unlifted
1288 -- types and also unboxed tuple result types '... -> (# , , #)'
1289 legalFIPrimResultTyCon dflags tc
1290   = xopt Opt_UnliftedFFITypes dflags
1291     && isUnLiftedTyCon tc
1292     && (isUnboxedTupleTyCon tc
1293         || case tyConPrimRep tc of      -- Note [Marshalling VoidRep]
1294            VoidRep -> False
1295            _       -> True)
1296 \end{code}
1297
1298 Note [Marshalling VoidRep]
1299 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1300 We don't treat State# (whose PrimRep is VoidRep) as marshalable.
1301 In turn that means you can't write
1302         foreign import foo :: Int -> State# RealWorld
1303
1304 Reason: the back end falls over with panic "primRepHint:VoidRep";
1305         and there is no compelling reason to permit it