Refactoring around TyCon.isSynTyCon
[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 {-# LANGUAGE CPP #-}
19
20 module TcType (
21   --------------------------------
22   -- Types
23   TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
24   TcTyVar, TcTyVarSet, TcKind, TcCoVar,
25
26   -- Untouchables
27   Untouchables(..), noUntouchables, pushUntouchables, isTouchable,
28
29   --------------------------------
30   -- MetaDetails
31   UserTypeCtxt(..), pprUserTypeCtxt,
32   TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTv, superSkolemTv,
33   MetaDetails(Flexi, Indirect), MetaInfo(..),
34   isImmutableTyVar, isSkolemTyVar, isMetaTyVar,  isMetaTyVarTy, isTyVarTy,
35   isSigTyVar, isOverlappableTyVar,  isTyConableTyVar, isFlatSkolTyVar,
36   isAmbiguousTyVar, metaTvRef, metaTyVarInfo,
37   isFlexi, isIndirect, isRuntimeUnkSkol,
38   isTypeVar, isKindVar,
39   metaTyVarUntouchables, setMetaTyVarUntouchables,
40   isTouchableMetaTyVar, isFloatedTouchableMetaTyVar,
41
42   --------------------------------
43   -- Builders
44   mkPhiTy, mkSigmaTy, mkTcEqPred,
45
46   --------------------------------
47   -- Splitters
48   -- These are important because they do not look through newtypes
49   tcView,
50   tcSplitForAllTys, tcSplitPhiTy, tcSplitPredFunTy_maybe,
51   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
52   tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
53   tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
54   tcInstHeadTyNotSynonym, tcInstHeadTyAppAllTyVars,
55   tcGetTyVar_maybe, tcGetTyVar,
56   tcSplitSigmaTy, tcDeepSplitSigmaTy_maybe,
57
58   ---------------------------------
59   -- Predicates.
60   -- Again, newtypes are opaque
61   eqType, eqTypes, eqPred, cmpType, cmpTypes, cmpPred, eqTypeX,
62   pickyEqType, tcEqType, tcEqKind,
63   isSigmaTy, isOverloadedTy,
64   isDoubleTy, isFloatTy, isIntTy, isWordTy, isStringTy,
65   isIntegerTy, isBoolTy, isUnitTy, isCharTy,
66   isTauTy, isTauTyCon, tcIsTyVarTy, tcIsForAllTy,
67   isSynFamilyTyConApp,
68   isPredTy, isTyVarClassPred,
69
70   ---------------------------------
71   -- Misc type manipulators
72   deNoteType, occurCheckExpand, OccCheckResult(..),
73   orphNamesOfType, orphNamesOfDFunHead, orphNamesOfCo,
74   orphNamesOfTypes, orphNamesOfCoCon,
75   getDFunTyKey,
76   evVarPred_maybe, evVarPred,
77
78   ---------------------------------
79   -- Predicate types
80   mkMinimalBySCs, transSuperClasses, immSuperClasses,
81
82   -- * Finding type instances
83   tcTyFamInsts,
84
85   -- * Finding "exact" (non-dead) type variables
86   exactTyVarsOfType, exactTyVarsOfTypes,
87
88   ---------------------------------
89   -- Foreign import and export
90   isFFIArgumentTy,     -- :: DynFlags -> Safety -> Type -> Bool
91   isFFIImportResultTy, -- :: DynFlags -> Type -> Bool
92   isFFIExportResultTy, -- :: Type -> Bool
93   isFFIExternalTy,     -- :: Type -> Bool
94   isFFIDynTy,          -- :: Type -> Type -> Bool
95   isFFIPrimArgumentTy, -- :: DynFlags -> Type -> Bool
96   isFFIPrimResultTy,   -- :: DynFlags -> Type -> Bool
97   isFFILabelTy,        -- :: Type -> Bool
98   isFFIDotnetTy,       -- :: DynFlags -> Type -> Bool
99   isFFIDotnetObjTy,    -- :: Type -> Bool
100   isFFITy,             -- :: Type -> Bool
101   isFunPtrTy,          -- :: Type -> Bool
102   tcSplitIOType_maybe, -- :: Type -> Maybe Type
103
104   --------------------------------
105   -- Rexported from Kind
106   Kind, typeKind,
107   unliftedTypeKind, liftedTypeKind,
108   openTypeKind, constraintKind, mkArrowKind, mkArrowKinds,
109   isLiftedTypeKind, isUnliftedTypeKind, isSubOpenTypeKind,
110   tcIsSubKind, splitKindFunTys, defaultKind,
111
112   --------------------------------
113   -- Rexported from Type
114   Type, PredType, ThetaType,
115   mkForAllTy, mkForAllTys,
116   mkFunTy, mkFunTys, zipFunTys,
117   mkTyConApp, mkAppTy, mkAppTys, applyTy, applyTys,
118   mkTyVarTy, mkTyVarTys, mkTyConTy,
119
120   isClassPred, isEqPred, isIPPred,
121   mkClassPred,
122   isDictLikeTy,
123   tcSplitDFunTy, tcSplitDFunHead,
124   mkEqPred,
125
126   -- Type substitutions
127   TvSubst(..),  -- Representation visible to a few friends
128   TvSubstEnv, emptyTvSubst,
129   mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst,
130   mkTopTvSubst, notElemTvSubst, unionTvSubst,
131   getTvSubstEnv, setTvSubstEnv, getTvInScope, extendTvInScope,
132   Type.lookupTyVar, Type.extendTvSubst, Type.substTyVarBndr,
133   extendTvSubstList, isInScope, mkTvSubst, zipTyEnv,
134   Type.substTy, substTys, substTyWith, substTheta, substTyVar, substTyVars,
135
136   isUnLiftedType,       -- Source types are always lifted
137   isUnboxedTupleType,   -- Ditto
138   isPrimitiveType,
139
140   tyVarsOfType, tyVarsOfTypes, closeOverKinds,
141   tcTyVarsOfType, tcTyVarsOfTypes,
142
143   pprKind, pprParendKind, pprSigmaType,
144   pprType, pprParendType, pprTypeApp, pprTyThingCategory,
145   pprTheta, pprThetaArrowTy, pprClassPred
146
147   ) where
148
149 #include "HsVersions.h"
150
151 -- friends:
152 import Kind
153 import TypeRep
154 import Class
155 import Var
156 import ForeignCall
157 import VarSet
158 import Coercion
159 import Type
160 import TyCon
161 import CoAxiom
162
163 -- others:
164 import DynFlags
165 import Name -- hiding (varName)
166             -- We use this to make dictionaries for type literals.
167             -- Perhaps there's a better way to do this?
168 import NameSet
169 import VarEnv
170 import PrelNames
171 import TysWiredIn
172 import BasicTypes
173 import Util
174 import Maybes
175 import ListSetOps
176 import Outputable
177 import FastString
178
179 import Data.IORef
180 import Control.Monad (liftM, ap)
181 import Control.Applicative (Applicative(..))
182 \end{code}
183
184 %************************************************************************
185 %*                                                                      *
186 \subsection{Types}
187 %*                                                                      *
188 %************************************************************************
189
190 The type checker divides the generic Type world into the
191 following more structured beasts:
192
193 sigma ::= forall tyvars. phi
194         -- A sigma type is a qualified type
195         --
196         -- Note that even if 'tyvars' is empty, theta
197         -- may not be: e.g.   (?x::Int) => Int
198
199         -- Note that 'sigma' is in prenex form:
200         -- all the foralls are at the front.
201         -- A 'phi' type has no foralls to the right of
202         -- an arrow
203
204 phi :: theta => rho
205
206 rho ::= sigma -> rho
207      |  tau
208
209 -- A 'tau' type has no quantification anywhere
210 -- Note that the args of a type constructor must be taus
211 tau ::= tyvar
212      |  tycon tau_1 .. tau_n
213      |  tau_1 tau_2
214      |  tau_1 -> tau_2
215
216 -- In all cases, a (saturated) type synonym application is legal,
217 -- provided it expands to the required form.
218
219 \begin{code}
220 type TcTyVar = TyVar    -- Used only during type inference
221 type TcCoVar = CoVar    -- Used only during type inference; mutable
222 type TcType = Type      -- A TcType can have mutable type variables
223         -- Invariant on ForAllTy in TcTypes:
224         --      forall a. T
225         -- a cannot occur inside a MutTyVar in T; that is,
226         -- T is "flattened" before quantifying over a
227
228 -- These types do not have boxy type variables in them
229 type TcPredType     = PredType
230 type TcThetaType    = ThetaType
231 type TcSigmaType    = TcType
232 type TcRhoType      = TcType
233 type TcTauType      = TcType
234 type TcKind         = Kind
235 type TcTyVarSet     = TyVarSet
236 \end{code}
237
238
239 %************************************************************************
240 %*                                                                      *
241 \subsection{TyVarDetails}
242 %*                                                                      *
243 %************************************************************************
244
245 TyVarDetails gives extra info about type variables, used during type
246 checking.  It's attached to mutable type variables only.
247 It's knot-tied back to Var.lhs.  There is no reason in principle
248 why Var.lhs shouldn't actually have the definition, but it "belongs" here.
249
250 Note [Signature skolems]
251 ~~~~~~~~~~~~~~~~~~~~~~~~
252 Consider this
253
254   f :: forall a. [a] -> Int
255   f (x::b : xs) = 3
256
257 Here 'b' is a lexically scoped type variable, but it turns out to be
258 the same as the skolem 'a'.  So we have a special kind of skolem
259 constant, SigTv, which can unify with other SigTvs. They are used
260 *only* for pattern type signatures.
261
262 Similarly consider
263   data T (a:k1) = MkT (S a)
264   data S (b:k2) = MkS (T b)
265 When doing kind inference on {S,T} we don't want *skolems* for k1,k2,
266 because they end up unifying; we want those SigTvs again.
267
268 \begin{code}
269 -- A TyVarDetails is inside a TyVar
270 data TcTyVarDetails
271   = SkolemTv      -- A skolem
272        Bool       -- True <=> this skolem type variable can be overlapped
273                   --          when looking up instances
274                   -- See Note [Binding when looking up instances] in InstEnv
275
276   | RuntimeUnk    -- Stands for an as-yet-unknown type in the GHCi
277                   -- interactive context
278
279   | FlatSkol TcType
280            -- The "skolem" obtained by flattening during
281            -- constraint simplification
282
283            -- In comments we will use the notation alpha[flat = ty]
284            -- to represent a flattening skolem variable alpha
285            -- identified with type ty.
286
287   | MetaTv { mtv_info  :: MetaInfo
288            , mtv_ref   :: IORef MetaDetails
289            , mtv_untch :: Untouchables }  -- See Note [Untouchable type variables]
290
291 vanillaSkolemTv, superSkolemTv :: TcTyVarDetails
292 -- See Note [Binding when looking up instances] in InstEnv
293 vanillaSkolemTv = SkolemTv False  -- Might be instantiated
294 superSkolemTv   = SkolemTv True   -- Treat this as a completely distinct type
295
296 -----------------------------
297 data MetaDetails
298   = Flexi  -- Flexi type variables unify to become Indirects
299   | Indirect TcType
300
301 instance Outputable MetaDetails where
302   ppr Flexi         = ptext (sLit "Flexi")
303   ppr (Indirect ty) = ptext (sLit "Indirect") <+> ppr ty
304
305 data MetaInfo
306    = TauTv         -- This MetaTv is an ordinary unification variable
307                    -- A TauTv is always filled in with a tau-type, which
308                    -- never contains any ForAlls
309
310    | PolyTv        -- Like TauTv, but can unify with a sigma-type
311
312    | SigTv         -- A variant of TauTv, except that it should not be
313                    -- unified with a type, only with a type variable
314                    -- SigTvs are only distinguished to improve error messages
315                    --      see Note [Signature skolems]
316                    --      The MetaDetails, if filled in, will
317                    --      always be another SigTv or a SkolemTv
318
319 -------------------------------------
320 -- UserTypeCtxt describes the origin of the polymorphic type
321 -- in the places where we need to an expression has that type
322
323 data UserTypeCtxt
324   = FunSigCtxt Name     -- Function type signature
325                         -- Also used for types in SPECIALISE pragmas
326   | InfSigCtxt Name     -- Inferred type for function
327   | ExprSigCtxt         -- Expression type signature
328   | ConArgCtxt Name     -- Data constructor argument
329   | TySynCtxt Name      -- RHS of a type synonym decl
330   | LamPatSigCtxt               -- Type sig in lambda pattern
331                         --      f (x::t) = ...
332   | BindPatSigCtxt      -- Type sig in pattern binding pattern
333                         --      (x::t, y) = e
334   | RuleSigCtxt Name    -- LHS of a RULE forall
335                         --    RULE "foo" forall (x :: a -> a). f (Just x) = ...
336   | ResSigCtxt          -- Result type sig
337                         --      f x :: t = ....
338   | ForSigCtxt Name     -- Foreign import or export signature
339   | DefaultDeclCtxt     -- Types in a default declaration
340   | InstDeclCtxt        -- An instance declaration
341   | SpecInstCtxt        -- SPECIALISE instance pragma
342   | ThBrackCtxt         -- Template Haskell type brackets [t| ... |]
343   | GenSigCtxt          -- Higher-rank or impredicative situations
344                         -- e.g. (f e) where f has a higher-rank type
345                         -- We might want to elaborate this
346   | GhciCtxt            -- GHCi command :kind <type>
347
348   | ClassSCCtxt Name    -- Superclasses of a class
349   | SigmaCtxt           -- Theta part of a normal for-all type
350                         --      f :: <S> => a -> a
351   | DataTyCtxt Name     -- Theta part of a data decl
352                         --      data <S> => T a = MkT a
353 \end{code}
354
355
356 -- Notes re TySynCtxt
357 -- We allow type synonyms that aren't types; e.g.  type List = []
358 --
359 -- If the RHS mentions tyvars that aren't in scope, we'll
360 -- quantify over them:
361 --      e.g.    type T = a->a
362 -- will become  type T = forall a. a->a
363 --
364 -- With gla-exts that's right, but for H98 we should complain.
365
366
367 %************************************************************************
368 %*                                                                      *
369                 Untoucable type variables
370 %*                                                                      *
371 %************************************************************************
372
373 Note [Untouchable type variables]
374 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
375 * Each unification variable (MetaTv)
376   and each Implication
377   has a level number (of type Untouchables)
378
379 * INVARIANTS.  In a tree of Implications,
380
381     (ImplicInv) The level number of an Implication is
382                 STRICTLY GREATER THAN that of its parent
383
384     (MetaTvInv) The level number of a unification variable is
385                 LESS THAN OR EQUAL TO that of its parent
386                 implication
387
388 * A unification variable is *touchable* if its level number
389   is EQUAL TO that of its immediate parent implication.
390
391 * INVARIANT
392     (GivenInv)  The free variables of the ic_given of an
393                 implication are all untouchable; ie their level
394                 numbers are LESS THAN the ic_untch of the implication
395
396
397 Note [Skolem escape prevention]
398 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
399 We only unify touchable unification variables.  Because of
400 (MetaTvInv), there can be no occurrences of he variable further out,
401 so the unification can't cause the kolems to escape. Example:
402      data T = forall a. MkT a (a->Int)
403      f x (MkT v f) = length [v,x]
404 We decide (x::alpha), and generate an implication like
405       [1]forall a. (a ~ alpha[0])
406 But we must not unify alpha:=a, because the skolem would escape.
407
408 For the cases where we DO want to unify, we rely on floating the
409 equality.   Example (with same T)
410      g x (MkT v f) = x && True
411 We decide (x::alpha), and generate an implication like
412       [1]forall a. (Bool ~ alpha[0])
413 We do NOT unify directly, bur rather float out (if the constraint
414 does not mention 'a') to get
415       (Bool ~ alpha[0]) /\ [1]forall a.()
416 and NOW we can unify alpha.
417
418 The same idea of only unifying touchables solves another problem.
419 Suppose we had
420    (F Int ~ uf[0])  /\  [1](forall a. C a => F Int ~ beta[1])
421 In this example, beta is touchable inside the implication. The
422 first solveInteract step leaves 'uf' un-unified. Then we move inside
423 the implication where a new constraint
424        uf  ~  beta
425 emerges. If we (wrongly) spontaneously solved it to get uf := beta,
426 the whole implication disappears but when we pop out again we are left with
427 (F Int ~ uf) which will be unified by our final solveCTyFunEqs stage and
428 uf will get unified *once more* to (F Int).
429
430 \begin{code}
431 newtype Untouchables = Untouchables Int
432   -- See Note [Untouchable type variables] for what this Int is
433
434 noUntouchables :: Untouchables
435 noUntouchables = Untouchables 0   -- 0 = outermost level
436
437 pushUntouchables :: Untouchables -> Untouchables
438 pushUntouchables (Untouchables us) = Untouchables (us+1)
439
440 isFloatedTouchable :: Untouchables -> Untouchables -> Bool
441 isFloatedTouchable (Untouchables ctxt_untch) (Untouchables tv_untch)
442   = ctxt_untch < tv_untch
443
444 isTouchable :: Untouchables -> Untouchables -> Bool
445 isTouchable (Untouchables ctxt_untch) (Untouchables tv_untch)
446   = ctxt_untch == tv_untch   -- NB: invariant ctxt_untch >= tv_untch
447                              --     So <= would be equivalent
448
449 checkTouchableInvariant :: Untouchables -> Untouchables -> Bool
450 -- Checks (MetaTvInv) from Note [Untouchable type variables]
451 checkTouchableInvariant (Untouchables ctxt_untch) (Untouchables tv_untch)
452   = ctxt_untch >= tv_untch
453
454 instance Outputable Untouchables where
455   ppr (Untouchables us) = ppr us
456 \end{code}
457
458
459 %************************************************************************
460 %*                                                                      *
461                 Pretty-printing
462 %*                                                                      *
463 %************************************************************************
464
465 \begin{code}
466 pprTcTyVarDetails :: TcTyVarDetails -> SDoc
467 -- For debugging
468 pprTcTyVarDetails (SkolemTv True)  = ptext (sLit "ssk")
469 pprTcTyVarDetails (SkolemTv False) = ptext (sLit "sk")
470 pprTcTyVarDetails (RuntimeUnk {})  = ptext (sLit "rt")
471 pprTcTyVarDetails (FlatSkol {})    = ptext (sLit "fsk")
472 pprTcTyVarDetails (MetaTv { mtv_info = info, mtv_untch = untch })
473   = pp_info <> brackets (ppr untch)
474   where
475     pp_info = case info of
476                 PolyTv -> ptext (sLit "poly")
477                 TauTv  -> ptext (sLit "tau")
478                 SigTv  -> ptext (sLit "sig")
479
480 pprUserTypeCtxt :: UserTypeCtxt -> SDoc
481 pprUserTypeCtxt (InfSigCtxt n)    = ptext (sLit "the inferred type for") <+> quotes (ppr n)
482 pprUserTypeCtxt (FunSigCtxt n)    = ptext (sLit "the type signature for") <+> quotes (ppr n)
483 pprUserTypeCtxt (RuleSigCtxt n)    = ptext (sLit "a RULE for") <+> quotes (ppr n)
484 pprUserTypeCtxt ExprSigCtxt       = ptext (sLit "an expression type signature")
485 pprUserTypeCtxt (ConArgCtxt c)    = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
486 pprUserTypeCtxt (TySynCtxt c)     = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
487 pprUserTypeCtxt ThBrackCtxt       = ptext (sLit "a Template Haskell quotation [t|...|]")
488 pprUserTypeCtxt LamPatSigCtxt     = ptext (sLit "a pattern type signature")
489 pprUserTypeCtxt BindPatSigCtxt    = ptext (sLit "a pattern type signature")
490 pprUserTypeCtxt ResSigCtxt        = ptext (sLit "a result type signature")
491 pprUserTypeCtxt (ForSigCtxt n)    = ptext (sLit "the foreign declaration for") <+> quotes (ppr n)
492 pprUserTypeCtxt DefaultDeclCtxt   = ptext (sLit "a type in a `default' declaration")
493 pprUserTypeCtxt InstDeclCtxt      = ptext (sLit "an instance declaration")
494 pprUserTypeCtxt SpecInstCtxt      = ptext (sLit "a SPECIALISE instance pragma")
495 pprUserTypeCtxt GenSigCtxt        = ptext (sLit "a type expected by the context")
496 pprUserTypeCtxt GhciCtxt          = ptext (sLit "a type in a GHCi command")
497 pprUserTypeCtxt (ClassSCCtxt c)   = ptext (sLit "the super-classes of class") <+> quotes (ppr c)
498 pprUserTypeCtxt SigmaCtxt         = ptext (sLit "the context of a polymorphic type")
499 pprUserTypeCtxt (DataTyCtxt tc)   = ptext (sLit "the context of the data type declaration for") <+> quotes (ppr tc)
500 \end{code}
501
502
503 %************************************************************************
504 %*                  *
505     Finding type family instances
506 %*                  *
507 %************************************************************************
508
509 \begin{code}
510 -- | Finds outermost type-family applications occuring in a type,
511 -- after expanding synonyms.
512 tcTyFamInsts :: Type -> [(TyCon, [Type])]
513 tcTyFamInsts ty
514   | Just exp_ty <- tcView ty    = tcTyFamInsts exp_ty
515 tcTyFamInsts (TyVarTy _)        = []
516 tcTyFamInsts (TyConApp tc tys)
517   | isSynFamilyTyCon tc         = [(tc, tys)]
518   | otherwise                   = concat (map tcTyFamInsts tys)
519 tcTyFamInsts (LitTy {})         = []
520 tcTyFamInsts (FunTy ty1 ty2)    = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
521 tcTyFamInsts (AppTy ty1 ty2)    = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
522 tcTyFamInsts (ForAllTy _ ty)    = tcTyFamInsts ty
523 \end{code}
524
525 %************************************************************************
526 %*                  *
527           The "exact" free variables of a type
528 %*                  *
529 %************************************************************************
530
531 Note [Silly type synonym]
532 ~~~~~~~~~~~~~~~~~~~~~~~~~
533 Consider
534   type T a = Int
535 What are the free tyvars of (T x)?  Empty, of course!
536 Here's the example that Ralf Laemmel showed me:
537   foo :: (forall a. C u a -> C u a) -> u
538   mappend :: Monoid u => u -> u -> u
539
540   bar :: Monoid u => u
541   bar = foo (\t -> t `mappend` t)
542 We have to generalise at the arg to f, and we don't
543 want to capture the constraint (Monad (C u a)) because
544 it appears to mention a.  Pretty silly, but it was useful to him.
545
546 exactTyVarsOfType is used by the type checker to figure out exactly
547 which type variables are mentioned in a type.  It's also used in the
548 smart-app checking code --- see TcExpr.tcIdApp
549
550 On the other hand, consider a *top-level* definition
551   f = (\x -> x) :: T a -> T a
552 If we don't abstract over 'a' it'll get fixed to GHC.Prim.Any, and then
553 if we have an application like (f "x") we get a confusing error message
554 involving Any.  So the conclusion is this: when generalising
555   - at top level use tyVarsOfType
556   - in nested bindings use exactTyVarsOfType
557 See Trac #1813 for example.
558
559 \begin{code}
560 exactTyVarsOfType :: Type -> TyVarSet
561 -- Find the free type variables (of any kind)
562 -- but *expand* type synonyms.  See Note [Silly type synonym] above.
563 exactTyVarsOfType ty
564   = go ty
565   where
566     go ty | Just ty' <- tcView ty = go ty'  -- This is the key line
567     go (TyVarTy tv)         = unitVarSet tv
568     go (TyConApp _ tys)     = exactTyVarsOfTypes tys
569     go (LitTy {})           = emptyVarSet
570     go (FunTy arg res)      = go arg `unionVarSet` go res
571     go (AppTy fun arg)      = go fun `unionVarSet` go arg
572     go (ForAllTy tyvar ty)  = delVarSet (go ty) tyvar
573
574 exactTyVarsOfTypes :: [Type] -> TyVarSet
575 exactTyVarsOfTypes tys = foldr (unionVarSet . exactTyVarsOfType) emptyVarSet tys
576 \end{code}
577
578 %************************************************************************
579 %*                                                                      *
580                 Predicates
581 %*                                                                      *
582 %************************************************************************
583
584 \begin{code}
585 isTouchableMetaTyVar :: Untouchables -> TcTyVar -> Bool
586 isTouchableMetaTyVar ctxt_untch tv
587   = ASSERT2( isTcTyVar tv, ppr tv )
588     case tcTyVarDetails tv of
589       MetaTv { mtv_untch = tv_untch }
590         -> ASSERT2( checkTouchableInvariant ctxt_untch tv_untch,
591                     ppr tv $$ ppr tv_untch $$ ppr ctxt_untch )
592            isTouchable ctxt_untch tv_untch
593       _ -> False
594
595 isFloatedTouchableMetaTyVar :: Untouchables -> TcTyVar -> Bool
596 isFloatedTouchableMetaTyVar ctxt_untch tv
597   = ASSERT2( isTcTyVar tv, ppr tv )
598     case tcTyVarDetails tv of
599       MetaTv { mtv_untch = tv_untch } -> isFloatedTouchable ctxt_untch tv_untch
600       _ -> False
601
602 isImmutableTyVar :: TyVar -> Bool
603 isImmutableTyVar tv
604   | isTcTyVar tv = isSkolemTyVar tv
605   | otherwise    = True
606
607 isTyConableTyVar, isSkolemTyVar, isOverlappableTyVar,
608   isMetaTyVar, isAmbiguousTyVar, isFlatSkolTyVar :: TcTyVar -> Bool
609
610 isTyConableTyVar tv
611         -- True of a meta-type variable that can be filled in
612         -- with a type constructor application; in particular,
613         -- not a SigTv
614   = ASSERT( isTcTyVar tv)
615     case tcTyVarDetails tv of
616         MetaTv { mtv_info = SigTv } -> False
617         _                           -> True
618
619 isFlatSkolTyVar tv
620   = ASSERT2( isTcTyVar tv, ppr tv )
621     case tcTyVarDetails tv of
622         FlatSkol {} -> True
623         _           -> False
624
625 isSkolemTyVar tv
626   = ASSERT2( isTcTyVar tv, ppr tv )
627     case tcTyVarDetails tv of
628         SkolemTv {}   -> True
629         FlatSkol {}   -> True
630         RuntimeUnk {} -> True
631         MetaTv {}     -> False
632
633 isOverlappableTyVar tv
634   = ASSERT( isTcTyVar tv )
635     case tcTyVarDetails tv of
636         SkolemTv overlappable -> overlappable
637         _                     -> False
638
639 isMetaTyVar tv
640   = ASSERT2( isTcTyVar tv, ppr tv )
641     case tcTyVarDetails tv of
642         MetaTv {} -> True
643         _         -> False
644
645 -- isAmbiguousTyVar is used only when reporting type errors
646 -- It picks out variables that are unbound, namely meta
647 -- type variables and the RuntimUnk variables created by
648 -- RtClosureInspect.zonkRTTIType.  These are "ambiguous" in
649 -- the sense that they stand for an as-yet-unknown type
650 isAmbiguousTyVar tv
651   = ASSERT2( isTcTyVar tv, ppr tv )
652     case tcTyVarDetails tv of
653         MetaTv {}     -> True
654         RuntimeUnk {} -> True
655         _             -> False
656
657 isMetaTyVarTy :: TcType -> Bool
658 isMetaTyVarTy (TyVarTy tv) = isMetaTyVar tv
659 isMetaTyVarTy _            = False
660
661 metaTyVarInfo :: TcTyVar -> MetaInfo
662 metaTyVarInfo tv
663   = ASSERT( isTcTyVar tv )
664     case tcTyVarDetails tv of
665       MetaTv { mtv_info = info } -> info
666       _ -> pprPanic "metaTyVarInfo" (ppr tv)
667
668 metaTyVarUntouchables :: TcTyVar -> Untouchables
669 metaTyVarUntouchables tv
670   = ASSERT( isTcTyVar tv )
671     case tcTyVarDetails tv of
672       MetaTv { mtv_untch = untch } -> untch
673       _ -> pprPanic "metaTyVarUntouchables" (ppr tv)
674
675 setMetaTyVarUntouchables :: TcTyVar -> Untouchables -> TcTyVar
676 setMetaTyVarUntouchables tv untch
677   = ASSERT( isTcTyVar tv )
678     case tcTyVarDetails tv of
679       details@(MetaTv {}) -> setTcTyVarDetails tv (details { mtv_untch = untch })
680       _ -> pprPanic "metaTyVarUntouchables" (ppr tv)
681
682 isSigTyVar :: Var -> Bool
683 isSigTyVar tv
684   = ASSERT( isTcTyVar tv )
685     case tcTyVarDetails tv of
686         MetaTv { mtv_info = SigTv } -> True
687         _                           -> False
688
689 metaTvRef :: TyVar -> IORef MetaDetails
690 metaTvRef tv
691   = ASSERT2( isTcTyVar tv, ppr tv )
692     case tcTyVarDetails tv of
693         MetaTv { mtv_ref = ref } -> ref
694         _ -> pprPanic "metaTvRef" (ppr tv)
695
696 isFlexi, isIndirect :: MetaDetails -> Bool
697 isFlexi Flexi = True
698 isFlexi _     = False
699
700 isIndirect (Indirect _) = True
701 isIndirect _            = False
702
703 isRuntimeUnkSkol :: TyVar -> Bool
704 -- Called only in TcErrors; see Note [Runtime skolems] there
705 isRuntimeUnkSkol x
706   | isTcTyVar x, RuntimeUnk <- tcTyVarDetails x = True
707   | otherwise                                   = False
708 \end{code}
709
710
711 %************************************************************************
712 %*                                                                      *
713 \subsection{Tau, sigma and rho}
714 %*                                                                      *
715 %************************************************************************
716
717 \begin{code}
718 mkSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
719 mkSigmaTy tyvars theta tau = mkForAllTys tyvars (mkPhiTy theta tau)
720
721 mkPhiTy :: [PredType] -> Type -> Type
722 mkPhiTy theta ty = foldr mkFunTy ty theta
723
724 mkTcEqPred :: TcType -> TcType -> Type
725 -- During type checking we build equalities between
726 -- type variables with OpenKind or ArgKind.  Ultimately
727 -- they will all settle, but we want the equality predicate
728 -- itself to have kind '*'.  I think.
729 --
730 -- But for now we call mkTyConApp, not mkEqPred, because the invariants
731 -- of the latter might not be satisfied during type checking.
732 -- Notably when we form an equalty   (a : OpenKind) ~ (Int : *)
733 --
734 -- But this is horribly delicate: what about type variables
735 -- that turn out to be bound to Int#?
736 mkTcEqPred ty1 ty2
737   = mkTyConApp eqTyCon [k, ty1, ty2]
738   where
739     k = defaultKind (typeKind ty1)
740 \end{code}
741
742 @isTauTy@ tests for nested for-alls.  It should not be called on a boxy type.
743
744 \begin{code}
745 isTauTy :: Type -> Bool
746 isTauTy ty | Just ty' <- tcView ty = isTauTy ty'
747 isTauTy (TyVarTy _)       = True
748 isTauTy (LitTy {})        = True
749 isTauTy (TyConApp tc tys) = all isTauTy tys && isTauTyCon tc
750 isTauTy (AppTy a b)       = isTauTy a && isTauTy b
751 isTauTy (FunTy a b)       = isTauTy a && isTauTy b
752 isTauTy (ForAllTy {})     = False
753
754 isTauTyCon :: TyCon -> Bool
755 -- Returns False for type synonyms whose expansion is a polytype
756 isTauTyCon tc
757   | Just (_, rhs) <- synTyConDefn_maybe tc = isTauTy rhs
758   | otherwise                              = True
759
760 ---------------
761 getDFunTyKey :: Type -> OccName -- Get some string from a type, to be used to
762                                 -- construct a dictionary function name
763 getDFunTyKey ty | Just ty' <- tcView ty = getDFunTyKey ty'
764 getDFunTyKey (TyVarTy tv)    = getOccName tv
765 getDFunTyKey (TyConApp tc _) = getOccName tc
766 getDFunTyKey (LitTy x)       = getDFunTyLitKey x
767 getDFunTyKey (AppTy fun _)   = getDFunTyKey fun
768 getDFunTyKey (FunTy _ _)     = getOccName funTyCon
769 getDFunTyKey (ForAllTy _ t)  = getDFunTyKey t
770
771 getDFunTyLitKey :: TyLit -> OccName
772 getDFunTyLitKey (NumTyLit n) = mkOccName Name.varName (show n)
773 getDFunTyLitKey (StrTyLit n) = mkOccName Name.varName (show n)  -- hm
774 \end{code}
775
776
777 %************************************************************************
778 %*                                                                      *
779 \subsection{Expanding and splitting}
780 %*                                                                      *
781 %************************************************************************
782
783 These tcSplit functions are like their non-Tc analogues, but
784         *) they do not look through newtypes
785
786 However, they are non-monadic and do not follow through mutable type
787 variables.  It's up to you to make sure this doesn't matter.
788
789 \begin{code}
790 tcSplitForAllTys :: Type -> ([TyVar], Type)
791 tcSplitForAllTys ty = split ty ty []
792    where
793      split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
794      split _ (ForAllTy tv ty) tvs = split ty ty (tv:tvs)
795      split orig_ty _          tvs = (reverse tvs, orig_ty)
796
797 tcIsForAllTy :: Type -> Bool
798 tcIsForAllTy ty | Just ty' <- tcView ty = tcIsForAllTy ty'
799 tcIsForAllTy (ForAllTy {}) = True
800 tcIsForAllTy _             = False
801
802 tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
803 -- Split off the first predicate argument from a type
804 tcSplitPredFunTy_maybe ty
805   | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'
806 tcSplitPredFunTy_maybe (FunTy arg res)
807   | isPredTy arg = Just (arg, res)
808 tcSplitPredFunTy_maybe _
809   = Nothing
810
811 tcSplitPhiTy :: Type -> (ThetaType, Type)
812 tcSplitPhiTy ty
813   = split ty []
814   where
815     split ty ts
816       = case tcSplitPredFunTy_maybe ty of
817           Just (pred, ty) -> split ty (pred:ts)
818           Nothing         -> (reverse ts, ty)
819
820 tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
821 tcSplitSigmaTy ty = case tcSplitForAllTys ty of
822                         (tvs, rho) -> case tcSplitPhiTy rho of
823                                         (theta, tau) -> (tvs, theta, tau)
824
825 -----------------------
826 tcDeepSplitSigmaTy_maybe
827   :: TcSigmaType -> Maybe ([TcType], [TyVar], ThetaType, TcSigmaType)
828 -- Looks for a *non-trivial* quantified type, under zero or more function arrows
829 -- By "non-trivial" we mean either tyvars or constraints are non-empty
830
831 tcDeepSplitSigmaTy_maybe ty
832   | Just (arg_ty, res_ty)           <- tcSplitFunTy_maybe ty
833   , Just (arg_tys, tvs, theta, rho) <- tcDeepSplitSigmaTy_maybe res_ty
834   = Just (arg_ty:arg_tys, tvs, theta, rho)
835
836   | (tvs, theta, rho) <- tcSplitSigmaTy ty
837   , not (null tvs && null theta)
838   = Just ([], tvs, theta, rho)
839
840   | otherwise = Nothing
841
842 -----------------------
843 tcTyConAppTyCon :: Type -> TyCon
844 tcTyConAppTyCon ty = case tcSplitTyConApp_maybe ty of
845                         Just (tc, _) -> tc
846                         Nothing      -> pprPanic "tcTyConAppTyCon" (pprType ty)
847
848 tcTyConAppArgs :: Type -> [Type]
849 tcTyConAppArgs ty = case tcSplitTyConApp_maybe ty of
850                         Just (_, args) -> args
851                         Nothing        -> pprPanic "tcTyConAppArgs" (pprType ty)
852
853 tcSplitTyConApp :: Type -> (TyCon, [Type])
854 tcSplitTyConApp ty = case tcSplitTyConApp_maybe ty of
855                         Just stuff -> stuff
856                         Nothing    -> pprPanic "tcSplitTyConApp" (pprType ty)
857
858 tcSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
859 tcSplitTyConApp_maybe ty | Just ty' <- tcView ty = tcSplitTyConApp_maybe ty'
860 tcSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
861 tcSplitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
862         -- Newtypes are opaque, so they may be split
863         -- However, predicates are not treated
864         -- as tycon applications by the type checker
865 tcSplitTyConApp_maybe _                 = Nothing
866
867 -----------------------
868 tcSplitFunTys :: Type -> ([Type], Type)
869 tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
870                         Nothing        -> ([], ty)
871                         Just (arg,res) -> (arg:args, res')
872                                        where
873                                           (args,res') = tcSplitFunTys res
874
875 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
876 tcSplitFunTy_maybe ty | Just ty' <- tcView ty           = tcSplitFunTy_maybe ty'
877 tcSplitFunTy_maybe (FunTy arg res) | not (isPredTy arg) = Just (arg, res)
878 tcSplitFunTy_maybe _                                    = Nothing
879         -- Note the typeKind guard
880         -- Consider     (?x::Int) => Bool
881         -- We don't want to treat this as a function type!
882         -- A concrete example is test tc230:
883         --      f :: () -> (?p :: ()) => () -> ()
884         --
885         --      g = f () ()
886
887 tcSplitFunTysN
888         :: TcRhoType
889         -> Arity                -- N: Number of desired args
890         -> ([TcSigmaType],      -- Arg types (N or fewer)
891             TcSigmaType)        -- The rest of the type
892
893 tcSplitFunTysN ty n_args
894   | n_args == 0
895   = ([], ty)
896   | Just (arg,res) <- tcSplitFunTy_maybe ty
897   = case tcSplitFunTysN res (n_args - 1) of
898         (args, res) -> (arg:args, res)
899   | otherwise
900   = ([], ty)
901
902 tcSplitFunTy :: Type -> (Type, Type)
903 tcSplitFunTy  ty = expectJust "tcSplitFunTy" (tcSplitFunTy_maybe ty)
904
905 tcFunArgTy :: Type -> Type
906 tcFunArgTy    ty = fst (tcSplitFunTy ty)
907
908 tcFunResultTy :: Type -> Type
909 tcFunResultTy ty = snd (tcSplitFunTy ty)
910
911 -----------------------
912 tcSplitAppTy_maybe :: Type -> Maybe (Type, Type)
913 tcSplitAppTy_maybe ty | Just ty' <- tcView ty = tcSplitAppTy_maybe ty'
914 tcSplitAppTy_maybe ty = repSplitAppTy_maybe ty
915
916 tcSplitAppTy :: Type -> (Type, Type)
917 tcSplitAppTy ty = case tcSplitAppTy_maybe ty of
918                     Just stuff -> stuff
919                     Nothing    -> pprPanic "tcSplitAppTy" (pprType ty)
920
921 tcSplitAppTys :: Type -> (Type, [Type])
922 tcSplitAppTys ty
923   = go ty []
924   where
925     go ty args = case tcSplitAppTy_maybe ty of
926                    Just (ty', arg) -> go ty' (arg:args)
927                    Nothing         -> (ty,args)
928
929 -----------------------
930 tcGetTyVar_maybe :: Type -> Maybe TyVar
931 tcGetTyVar_maybe ty | Just ty' <- tcView ty = tcGetTyVar_maybe ty'
932 tcGetTyVar_maybe (TyVarTy tv)   = Just tv
933 tcGetTyVar_maybe _              = Nothing
934
935 tcGetTyVar :: String -> Type -> TyVar
936 tcGetTyVar msg ty = expectJust msg (tcGetTyVar_maybe ty)
937
938 tcIsTyVarTy :: Type -> Bool
939 tcIsTyVarTy ty = isJust (tcGetTyVar_maybe ty)
940
941 -----------------------
942 tcSplitDFunTy :: Type -> ([TyVar], [Type], Class, [Type])
943 -- Split the type of a dictionary function
944 -- We don't use tcSplitSigmaTy,  because a DFun may (with NDP)
945 -- have non-Pred arguments, such as
946 --     df :: forall m. (forall b. Eq b => Eq (m b)) -> C m
947 --
948 -- Also NB splitFunTys, not tcSplitFunTys;
949 -- the latter  specifically stops at PredTy arguments,
950 -- and we don't want to do that here
951 tcSplitDFunTy ty
952   = case tcSplitForAllTys ty   of { (tvs, rho)   ->
953     case splitFunTys rho       of { (theta, tau) ->
954     case tcSplitDFunHead tau   of { (clas, tys)  ->
955     (tvs, theta, clas, tys) }}}
956
957 tcSplitDFunHead :: Type -> (Class, [Type])
958 tcSplitDFunHead = getClassPredTys
959
960 tcInstHeadTyNotSynonym :: Type -> Bool
961 -- Used in Haskell-98 mode, for the argument types of an instance head
962 -- These must not be type synonyms, but everywhere else type synonyms
963 -- are transparent, so we need a special function here
964 tcInstHeadTyNotSynonym ty
965   = case ty of
966         TyConApp tc _ -> not (isTypeSynonymTyCon tc)
967         _ -> True
968
969 tcInstHeadTyAppAllTyVars :: Type -> Bool
970 -- Used in Haskell-98 mode, for the argument types of an instance head
971 -- These must be a constructor applied to type variable arguments.
972 -- But we allow kind instantiations.
973 tcInstHeadTyAppAllTyVars ty
974   | Just ty' <- tcView ty       -- Look through synonyms
975   = tcInstHeadTyAppAllTyVars ty'
976   | otherwise
977   = case ty of
978         TyConApp _ tys  -> ok (filter (not . isKind) tys)  -- avoid kinds
979         FunTy arg res   -> ok [arg, res]
980         _               -> False
981   where
982         -- Check that all the types are type variables,
983         -- and that each is distinct
984     ok tys = equalLength tvs tys && hasNoDups tvs
985            where
986              tvs = mapMaybe get_tv tys
987
988     get_tv (TyVarTy tv)  = Just tv      -- through synonyms
989     get_tv _             = Nothing
990 \end{code}
991
992 \begin{code}
993 tcEqKind :: TcKind -> TcKind -> Bool
994 tcEqKind = tcEqType
995
996 tcEqType :: TcType -> TcType -> Bool
997 -- tcEqType is a proper, sensible type-equality function, that does
998 -- just what you'd expect The function Type.eqType (currently) has a
999 -- grotesque hack that makes OpenKind = *, and that is NOT what we
1000 -- want in the type checker!  Otherwise, for example, TcCanonical.reOrient
1001 -- thinks the LHS and RHS have the same kinds, when they don't, and
1002 -- fails to re-orient.  That in turn caused Trac #8553.
1003
1004 tcEqType ty1 ty2
1005   = go init_env ty1 ty2
1006   where
1007     init_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2))
1008     go env t1 t2 | Just t1' <- tcView t1 = go env t1' t2
1009                  | Just t2' <- tcView t2 = go env t1 t2'
1010     go env (TyVarTy tv1)       (TyVarTy tv2)     = rnOccL env tv1 == rnOccR env tv2
1011     go _   (LitTy lit1)        (LitTy lit2)      = lit1 == lit2
1012     go env (ForAllTy tv1 t1)   (ForAllTy tv2 t2) = go env (tyVarKind tv1) (tyVarKind tv2)
1013                                                 && go (rnBndr2 env tv1 tv2) t1 t2
1014     go env (AppTy s1 t1)       (AppTy s2 t2)     = go env s1 s2 && go env t1 t2
1015     go env (FunTy s1 t1)       (FunTy s2 t2)     = go env s1 s2 && go env t1 t2
1016     go env (TyConApp tc1 ts1) (TyConApp tc2 ts2) = (tc1 == tc2) && gos env ts1 ts2
1017     go _ _ _ = False
1018
1019     gos _   []       []       = True
1020     gos env (t1:ts1) (t2:ts2) = go env t1 t2 && gos env ts1 ts2
1021     gos _ _ _ = False
1022
1023 pickyEqType :: TcType -> TcType -> Bool
1024 -- Check when two types _look_ the same, _including_ synonyms.
1025 -- So (pickyEqType String [Char]) returns False
1026 pickyEqType ty1 ty2
1027   = go init_env ty1 ty2
1028   where
1029     init_env = mkRnEnv2 (mkInScopeSet (tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2))
1030     go env (TyVarTy tv1)       (TyVarTy tv2)     = rnOccL env tv1 == rnOccR env tv2
1031     go _   (LitTy lit1)        (LitTy lit2)      = lit1 == lit2
1032     go env (ForAllTy tv1 t1)   (ForAllTy tv2 t2) = go env (tyVarKind tv1) (tyVarKind tv2)
1033                                                 && go (rnBndr2 env tv1 tv2) t1 t2
1034     go env (AppTy s1 t1)       (AppTy s2 t2)     = go env s1 s2 && go env t1 t2
1035     go env (FunTy s1 t1)       (FunTy s2 t2)     = go env s1 s2 && go env t1 t2
1036     go env (TyConApp tc1 ts1) (TyConApp tc2 ts2) = (tc1 == tc2) && gos env ts1 ts2
1037     go _ _ _ = False
1038
1039     gos _   []       []       = True
1040     gos env (t1:ts1) (t2:ts2) = go env t1 t2 && gos env ts1 ts2
1041     gos _ _ _ = False
1042 \end{code}
1043
1044 Note [Occurs check expansion]
1045 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1046 (occurCheckExpand tv xi) expands synonyms in xi just enough to get rid
1047 of occurrences of tv outside type function arguments, if that is
1048 possible; otherwise, it returns Nothing.
1049
1050 For example, suppose we have
1051   type F a b = [a]
1052 Then
1053   occurCheckExpand b (F Int b) = Just [Int]
1054 but
1055   occurCheckExpand a (F a Int) = Nothing
1056
1057 We don't promise to do the absolute minimum amount of expanding
1058 necessary, but we try not to do expansions we don't need to.  We
1059 prefer doing inner expansions first.  For example,
1060   type F a b = (a, Int, a, [a])
1061   type G b   = Char
1062 We have
1063   occurCheckExpand b (F (G b)) = F Char
1064 even though we could also expand F to get rid of b.
1065
1066 See also Note [occurCheckExpand] in TcCanonical
1067
1068 \begin{code}
1069 data OccCheckResult a
1070   = OC_OK a
1071   | OC_Forall
1072   | OC_NonTyVar
1073   | OC_Occurs
1074
1075 instance Functor OccCheckResult where
1076       fmap = liftM
1077
1078 instance Applicative OccCheckResult where
1079       pure = return
1080       (<*>) = ap
1081
1082 instance Monad OccCheckResult where
1083   return x = OC_OK x
1084   OC_OK x     >>= k = k x
1085   OC_Forall   >>= _ = OC_Forall
1086   OC_NonTyVar >>= _ = OC_NonTyVar
1087   OC_Occurs   >>= _ = OC_Occurs
1088
1089 occurCheckExpand :: DynFlags -> TcTyVar -> Type -> OccCheckResult Type
1090 -- See Note [Occurs check expansion]
1091 -- Check whether
1092 --   a) the given variable occurs in the given type.
1093 --   b) there is a forall in the type (unless we have -XImpredicativeTypes
1094 --                                     or it's a PolyTv
1095 --   c) if it's a SigTv, ty should be a tyvar
1096 --
1097 -- We may have needed to do some type synonym unfolding in order to
1098 -- get rid of the variable (or forall), so we also return the unfolded
1099 -- version of the type, which is guaranteed to be syntactically free
1100 -- of the given type variable.  If the type is already syntactically
1101 -- free of the variable, then the same type is returned.
1102
1103 occurCheckExpand dflags tv ty
1104   | MetaTv { mtv_info = SigTv } <- details
1105                   = go_sig_tv ty
1106   | fast_check ty = return ty
1107   | otherwise     = go ty
1108   where
1109     details = ASSERT2( isTcTyVar tv, ppr tv ) tcTyVarDetails tv
1110
1111     impredicative
1112       = case details of
1113           MetaTv { mtv_info = PolyTv } -> True
1114           MetaTv { mtv_info = SigTv }  -> False
1115           MetaTv { mtv_info = TauTv }  -> xopt Opt_ImpredicativeTypes dflags
1116                                        || isOpenTypeKind (tyVarKind tv)
1117                                           -- Note [OpenTypeKind accepts foralls]
1118                                           -- in TcUnify
1119           _other                       -> True
1120           -- We can have non-meta tyvars in given constraints
1121
1122     -- Check 'ty' is a tyvar, or can be expanded into one
1123     go_sig_tv ty@(TyVarTy {})            = OC_OK ty
1124     go_sig_tv ty | Just ty' <- tcView ty = go_sig_tv ty'
1125     go_sig_tv _                          = OC_NonTyVar
1126
1127     -- True => fine
1128     fast_check (LitTy {})        = True
1129     fast_check (TyVarTy tv')     = tv /= tv'
1130     fast_check (TyConApp _ tys)  = all fast_check tys
1131     fast_check (FunTy arg res)   = fast_check arg && fast_check res
1132     fast_check (AppTy fun arg)   = fast_check fun && fast_check arg
1133     fast_check (ForAllTy tv' ty) = impredicative
1134                                 && fast_check (tyVarKind tv')
1135                                 && (tv == tv' || fast_check ty)
1136
1137     go t@(TyVarTy tv') | tv == tv' = OC_Occurs
1138                        | otherwise = return t
1139     go ty@(LitTy {}) = return ty
1140     go (AppTy ty1 ty2) = do { ty1' <- go ty1
1141                             ; ty2' <- go ty2
1142                             ; return (mkAppTy ty1' ty2') }
1143     go (FunTy ty1 ty2) = do { ty1' <- go ty1
1144                             ; ty2' <- go ty2
1145                             ; return (mkFunTy ty1' ty2') }
1146     go ty@(ForAllTy tv' body_ty)
1147        | not impredicative                = OC_Forall
1148        | not (fast_check (tyVarKind tv')) = OC_Occurs
1149            -- Can't expand away the kinds unless we create
1150            -- fresh variables which we don't want to do at this point.
1151            -- In principle fast_check might fail because of a for-all
1152            -- but we don't yet have poly-kinded tyvars so I'm not
1153            -- going to worry about that now
1154        | tv == tv' = return ty
1155        | otherwise = do { body' <- go body_ty
1156                         ; return (ForAllTy tv' body') }
1157
1158     -- For a type constructor application, first try expanding away the
1159     -- offending variable from the arguments.  If that doesn't work, next
1160     -- see if the type constructor is a type synonym, and if so, expand
1161     -- it and try again.
1162     go ty@(TyConApp tc tys)
1163       = case do { tys <- mapM go tys; return (mkTyConApp tc tys) } of
1164           OC_OK ty -> return ty  -- First try to eliminate the tyvar from the args
1165           bad | Just ty' <- tcView ty -> go ty'
1166               | otherwise             -> bad
1167                       -- Failing that, try to expand a synonym
1168 \end{code}
1169
1170 %************************************************************************
1171 %*                                                                      *
1172 \subsection{Predicate types}
1173 %*                                                                      *
1174 %************************************************************************
1175
1176 Deconstructors and tests on predicate types
1177
1178 \begin{code}
1179 isTyVarClassPred :: PredType -> Bool
1180 isTyVarClassPred ty = case getClassPredTys_maybe ty of
1181     Just (_, tys) -> all isTyVarTy tys
1182     _             -> False
1183
1184 evVarPred_maybe :: EvVar -> Maybe PredType
1185 evVarPred_maybe v = if isPredTy ty then Just ty else Nothing
1186   where ty = varType v
1187
1188 evVarPred :: EvVar -> PredType
1189 evVarPred var
1190  | debugIsOn
1191   = case evVarPred_maybe var of
1192       Just pred -> pred
1193       Nothing   -> pprPanic "tcEvVarPred" (ppr var <+> ppr (varType var))
1194  | otherwise
1195   = varType var
1196 \end{code}
1197
1198 Superclasses
1199
1200 \begin{code}
1201 mkMinimalBySCs :: [PredType] -> [PredType]
1202 -- Remove predicates that can be deduced from others by superclasses
1203 mkMinimalBySCs ptys = [ ploc |  ploc <- ptys
1204                              ,  ploc `not_in_preds` rec_scs ]
1205  where
1206    rec_scs = concatMap trans_super_classes ptys
1207    not_in_preds p ps = not (any (eqPred p) ps)
1208
1209    trans_super_classes pred   -- Superclasses of pred, excluding pred itself
1210      = case classifyPredType pred of
1211          ClassPred cls tys -> transSuperClasses cls tys
1212          TuplePred ts      -> concatMap trans_super_classes ts
1213          _                 -> []
1214
1215 transSuperClasses :: Class -> [Type] -> [PredType]
1216 transSuperClasses cls tys    -- Superclasses of (cls tys),
1217                              -- excluding (cls tys) itself
1218   = concatMap trans_sc (immSuperClasses cls tys)
1219   where
1220     trans_sc :: PredType -> [PredType]
1221     -- (trans_sc p) returns (p : p's superclasses)
1222     trans_sc p = case classifyPredType p of
1223                    ClassPred cls tys -> p : transSuperClasses cls tys
1224                    TuplePred ps      -> concatMap trans_sc ps
1225                    _                 -> [p]
1226
1227 immSuperClasses :: Class -> [Type] -> [PredType]
1228 immSuperClasses cls tys
1229   = substTheta (zipTopTvSubst tyvars tys) sc_theta
1230   where
1231     (tyvars,sc_theta,_,_) = classBigSig cls
1232 \end{code}
1233
1234
1235 %************************************************************************
1236 %*                                                                      *
1237 \subsection{Predicates}
1238 %*                                                                      *
1239 %************************************************************************
1240
1241 isSigmaTy returns true of any qualified type.  It doesn't *necessarily* have
1242 any foralls.  E.g.
1243         f :: (?x::Int) => Int -> Int
1244
1245 \begin{code}
1246 isSigmaTy :: Type -> Bool
1247 isSigmaTy ty | Just ty' <- tcView ty = isSigmaTy ty'
1248 isSigmaTy (ForAllTy _ _) = True
1249 isSigmaTy (FunTy a _)    = isPredTy a
1250 isSigmaTy _              = False
1251
1252 isOverloadedTy :: Type -> Bool
1253 -- Yes for a type of a function that might require evidence-passing
1254 -- Used only by bindLocalMethods
1255 isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
1256 isOverloadedTy (ForAllTy _ ty) = isOverloadedTy ty
1257 isOverloadedTy (FunTy a _)     = isPredTy a
1258 isOverloadedTy _               = False
1259 \end{code}
1260
1261 \begin{code}
1262 isFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy,
1263     isUnitTy, isCharTy, isAnyTy :: Type -> Bool
1264 isFloatTy      = is_tc floatTyConKey
1265 isDoubleTy     = is_tc doubleTyConKey
1266 isIntegerTy    = is_tc integerTyConKey
1267 isIntTy        = is_tc intTyConKey
1268 isWordTy       = is_tc wordTyConKey
1269 isBoolTy       = is_tc boolTyConKey
1270 isUnitTy       = is_tc unitTyConKey
1271 isCharTy       = is_tc charTyConKey
1272 isAnyTy        = is_tc anyTyConKey
1273
1274 isStringTy :: Type -> Bool
1275 isStringTy ty
1276   = case tcSplitTyConApp_maybe ty of
1277       Just (tc, [arg_ty]) -> tc == listTyCon && isCharTy arg_ty
1278       _                   -> False
1279
1280 is_tc :: Unique -> Type -> Bool
1281 -- Newtypes are opaque to this
1282 is_tc uniq ty = case tcSplitTyConApp_maybe ty of
1283                         Just (tc, _) -> uniq == getUnique tc
1284                         Nothing      -> False
1285 \end{code}
1286
1287 \begin{code}
1288 -- NB: Currently used in places where we have already expanded type synonyms;
1289 --     hence no 'coreView'.  This could, however, be changed without breaking
1290 --     any code.
1291 isSynFamilyTyConApp :: TcTauType -> Bool
1292 isSynFamilyTyConApp (TyConApp tc tys) = isSynFamilyTyCon tc &&
1293                                       length tys == tyConArity tc
1294 isSynFamilyTyConApp _other            = False
1295 \end{code}
1296
1297
1298 %************************************************************************
1299 %*                                                                      *
1300 \subsection{Misc}
1301 %*                                                                      *
1302 %************************************************************************
1303
1304 \begin{code}
1305 deNoteType :: Type -> Type
1306 -- Remove all *outermost* type synonyms and other notes
1307 deNoteType ty | Just ty' <- tcView ty = deNoteType ty'
1308 deNoteType ty = ty
1309
1310 tcTyVarsOfType :: Type -> TcTyVarSet
1311 -- Just the *TcTyVars* free in the type
1312 -- (Types.tyVarsOfTypes finds all free TyVars)
1313 tcTyVarsOfType (TyVarTy tv)         = if isTcTyVar tv then unitVarSet tv
1314                                                       else emptyVarSet
1315 tcTyVarsOfType (TyConApp _ tys)     = tcTyVarsOfTypes tys
1316 tcTyVarsOfType (LitTy {})           = emptyVarSet
1317 tcTyVarsOfType (FunTy arg res)      = tcTyVarsOfType arg `unionVarSet` tcTyVarsOfType res
1318 tcTyVarsOfType (AppTy fun arg)      = tcTyVarsOfType fun `unionVarSet` tcTyVarsOfType arg
1319 tcTyVarsOfType (ForAllTy tyvar ty)  = tcTyVarsOfType ty `delVarSet` tyvar
1320         -- We do sometimes quantify over skolem TcTyVars
1321
1322 tcTyVarsOfTypes :: [Type] -> TyVarSet
1323 tcTyVarsOfTypes tys = foldr (unionVarSet.tcTyVarsOfType) emptyVarSet tys
1324 \end{code}
1325
1326 Find the free tycons and classes of a type.  This is used in the front
1327 end of the compiler.
1328
1329 \begin{code}
1330 orphNamesOfTyCon :: TyCon -> NameSet
1331 orphNamesOfTyCon tycon = unitNameSet (getName tycon) `unionNameSets` case tyConClass_maybe tycon of
1332     Nothing  -> emptyNameSet
1333     Just cls -> unitNameSet (getName cls)
1334
1335 orphNamesOfType :: Type -> NameSet
1336 orphNamesOfType ty | Just ty' <- tcView ty = orphNamesOfType ty'
1337                 -- Look through type synonyms (Trac #4912)
1338 orphNamesOfType (TyVarTy _)          = emptyNameSet
1339 orphNamesOfType (LitTy {})           = emptyNameSet
1340 orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon
1341                                        `unionNameSets` orphNamesOfTypes tys
1342 orphNamesOfType (FunTy arg res)      = orphNamesOfTyCon funTyCon   -- NB!  See Trac #8535
1343                                        `unionNameSets` orphNamesOfType arg
1344                                        `unionNameSets` orphNamesOfType res
1345 orphNamesOfType (AppTy fun arg)      = orphNamesOfType fun `unionNameSets` orphNamesOfType arg
1346 orphNamesOfType (ForAllTy _ ty)      = orphNamesOfType ty
1347
1348 orphNamesOfThings :: (a -> NameSet) -> [a] -> NameSet
1349 orphNamesOfThings f = foldr (unionNameSets . f) emptyNameSet
1350
1351 orphNamesOfTypes :: [Type] -> NameSet
1352 orphNamesOfTypes = orphNamesOfThings orphNamesOfType
1353
1354 orphNamesOfDFunHead :: Type -> NameSet
1355 -- Find the free type constructors and classes
1356 -- of the head of the dfun instance type
1357 -- The 'dfun_head_type' is because of
1358 --      instance Foo a => Baz T where ...
1359 -- The decl is an orphan if Baz and T are both not locally defined,
1360 --      even if Foo *is* locally defined
1361 orphNamesOfDFunHead dfun_ty
1362   = case tcSplitSigmaTy dfun_ty of
1363         (_, _, head_ty) -> orphNamesOfType head_ty
1364
1365 orphNamesOfCo :: Coercion -> NameSet
1366 orphNamesOfCo (Refl _ ty)           = orphNamesOfType ty
1367 orphNamesOfCo (TyConAppCo _ tc cos) = unitNameSet (getName tc) `unionNameSets` orphNamesOfCos cos
1368 orphNamesOfCo (AppCo co1 co2)       = orphNamesOfCo co1 `unionNameSets` orphNamesOfCo co2
1369 orphNamesOfCo (ForAllCo _ co)       = orphNamesOfCo co
1370 orphNamesOfCo (CoVarCo _)           = emptyNameSet
1371 orphNamesOfCo (AxiomInstCo con _ cos) = orphNamesOfCoCon con `unionNameSets` orphNamesOfCos cos
1372 orphNamesOfCo (UnivCo _ ty1 ty2)    = orphNamesOfType ty1 `unionNameSets` orphNamesOfType ty2
1373 orphNamesOfCo (SymCo co)            = orphNamesOfCo co
1374 orphNamesOfCo (TransCo co1 co2)     = orphNamesOfCo co1 `unionNameSets` orphNamesOfCo co2
1375 orphNamesOfCo (NthCo _ co)          = orphNamesOfCo co
1376 orphNamesOfCo (LRCo  _ co)          = orphNamesOfCo co
1377 orphNamesOfCo (InstCo co ty)        = orphNamesOfCo co `unionNameSets` orphNamesOfType ty
1378 orphNamesOfCo (SubCo co)            = orphNamesOfCo co
1379 orphNamesOfCo (AxiomRuleCo _ ts cs) = orphNamesOfTypes ts `unionNameSets`
1380                                       orphNamesOfCos cs
1381
1382 orphNamesOfCos :: [Coercion] -> NameSet
1383 orphNamesOfCos = orphNamesOfThings orphNamesOfCo
1384
1385 orphNamesOfCoCon :: CoAxiom br -> NameSet
1386 orphNamesOfCoCon (CoAxiom { co_ax_tc = tc, co_ax_branches = branches })
1387   = orphNamesOfTyCon tc `unionNameSets` orphNamesOfCoAxBranches branches
1388
1389 orphNamesOfCoAxBranches :: BranchList CoAxBranch br -> NameSet
1390 orphNamesOfCoAxBranches = brListFoldr (unionNameSets . orphNamesOfCoAxBranch) emptyNameSet
1391
1392 orphNamesOfCoAxBranch :: CoAxBranch -> NameSet
1393 orphNamesOfCoAxBranch (CoAxBranch { cab_lhs = lhs, cab_rhs = rhs })
1394   = orphNamesOfTypes lhs `unionNameSets` orphNamesOfType rhs
1395 \end{code}
1396
1397
1398 %************************************************************************
1399 %*                                                                      *
1400 \subsection[TysWiredIn-ext-type]{External types}
1401 %*                                                                      *
1402 %************************************************************************
1403
1404 The compiler's foreign function interface supports the passing of a
1405 restricted set of types as arguments and results (the restricting factor
1406 being the )
1407
1408 \begin{code}
1409 tcSplitIOType_maybe :: Type -> Maybe (TyCon, Type)
1410 -- (tcSplitIOType_maybe t) returns Just (IO,t',co)
1411 --              if co : t ~ IO t'
1412 --              returns Nothing otherwise
1413 tcSplitIOType_maybe ty
1414   = case tcSplitTyConApp_maybe ty of
1415         Just (io_tycon, [io_res_ty])
1416          | io_tycon `hasKey` ioTyConKey ->
1417             Just (io_tycon, io_res_ty)
1418         _ ->
1419             Nothing
1420
1421 isFFITy :: Type -> Bool
1422 -- True for any TyCon that can possibly be an arg or result of an FFI call
1423 isFFITy ty = checkRepTyCon legalFFITyCon ty
1424
1425 isFFIArgumentTy :: DynFlags -> Safety -> Type -> Bool
1426 -- Checks for valid argument type for a 'foreign import'
1427 isFFIArgumentTy dflags safety ty
1428    = checkRepTyCon (legalOutgoingTyCon dflags safety) ty
1429
1430 isFFIExternalTy :: Type -> Bool
1431 -- Types that are allowed as arguments of a 'foreign export'
1432 isFFIExternalTy ty = checkRepTyCon legalFEArgTyCon ty
1433
1434 isFFIImportResultTy :: DynFlags -> Type -> Bool
1435 isFFIImportResultTy dflags ty
1436   = checkRepTyCon (legalFIResultTyCon dflags) ty
1437
1438 isFFIExportResultTy :: Type -> Bool
1439 isFFIExportResultTy ty = checkRepTyCon legalFEResultTyCon ty
1440
1441 isFFIDynTy :: Type -> Type -> Bool
1442 -- The type in a foreign import dynamic must be Ptr, FunPtr, or a newtype of
1443 -- either, and the wrapped function type must be equal to the given type.
1444 -- We assume that all types have been run through normalizeFfiType, so we don't
1445 -- need to worry about expanding newtypes here.
1446 isFFIDynTy expected ty
1447     -- Note [Foreign import dynamic]
1448     -- In the example below, expected would be 'CInt -> IO ()', while ty would
1449     -- be 'FunPtr (CDouble -> IO ())'.
1450     | Just (tc, [ty']) <- splitTyConApp_maybe ty
1451     , tyConUnique tc `elem` [ptrTyConKey, funPtrTyConKey]
1452     , eqType ty' expected
1453     = True
1454     | otherwise
1455     = False
1456
1457 isFFILabelTy :: Type -> Bool
1458 -- The type of a foreign label must be Ptr, FunPtr, or a newtype of either.
1459 isFFILabelTy = checkRepTyConKey [ptrTyConKey, funPtrTyConKey]
1460
1461 isFFIPrimArgumentTy :: DynFlags -> Type -> Bool
1462 -- Checks for valid argument type for a 'foreign import prim'
1463 -- Currently they must all be simple unlifted types, or the well-known type
1464 -- Any, which can be used to pass the address to a Haskell object on the heap to
1465 -- the foreign function.
1466 isFFIPrimArgumentTy dflags ty
1467    = isAnyTy ty || checkRepTyCon (legalFIPrimArgTyCon dflags) ty
1468
1469 isFFIPrimResultTy :: DynFlags -> Type -> Bool
1470 -- Checks for valid result type for a 'foreign import prim'
1471 -- Currently it must be an unlifted type, including unboxed tuples.
1472 isFFIPrimResultTy dflags ty
1473    = checkRepTyCon (legalFIPrimResultTyCon dflags) ty
1474
1475 isFFIDotnetTy :: DynFlags -> Type -> Bool
1476 isFFIDotnetTy dflags ty
1477   = checkRepTyCon (\ tc -> (legalFIResultTyCon dflags tc ||
1478                            isFFIDotnetObjTy ty || isStringTy ty)) ty
1479         -- NB: isStringTy used to look through newtypes, but
1480         --     it no longer does so.  May need to adjust isFFIDotNetTy
1481         --     if we do want to look through newtypes.
1482
1483 isFFIDotnetObjTy :: Type -> Bool
1484 isFFIDotnetObjTy ty
1485   = checkRepTyCon check_tc t_ty
1486   where
1487    (_, t_ty) = tcSplitForAllTys ty
1488    check_tc tc = getName tc == objectTyConName
1489
1490 isFunPtrTy :: Type -> Bool
1491 isFunPtrTy = checkRepTyConKey [funPtrTyConKey]
1492
1493 -- normaliseFfiType gets run before checkRepTyCon, so we don't
1494 -- need to worry about looking through newtypes or type functions
1495 -- here; that's already been taken care of.
1496 checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
1497 checkRepTyCon check_tc ty
1498     | Just (tc, _) <- splitTyConApp_maybe ty
1499     = check_tc tc
1500     | otherwise
1501     = False
1502
1503 checkRepTyConKey :: [Unique] -> Type -> Bool
1504 -- Like checkRepTyCon, but just looks at the TyCon key
1505 checkRepTyConKey keys
1506   = checkRepTyCon (\tc -> tyConUnique tc `elem` keys)
1507 \end{code}
1508
1509 Note [Foreign import dynamic]
1510 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1511 A dynamic stub must be of the form 'FunPtr ft -> ft' where ft is any foreign
1512 type.  Similarly, a wrapper stub must be of the form 'ft -> IO (FunPtr ft)'.
1513
1514 We use isFFIDynTy to check whether a signature is well-formed. For example,
1515 given a (illegal) declaration like:
1516
1517 foreign import ccall "dynamic"
1518   foo :: FunPtr (CDouble -> IO ()) -> CInt -> IO ()
1519
1520 isFFIDynTy will compare the 'FunPtr' type 'CDouble -> IO ()' with the curried
1521 result type 'CInt -> IO ()', and return False, as they are not equal.
1522
1523
1524 ----------------------------------------------
1525 These chaps do the work; they are not exported
1526 ----------------------------------------------
1527
1528 \begin{code}
1529 legalFEArgTyCon :: TyCon -> Bool
1530 legalFEArgTyCon tc
1531   -- It's illegal to make foreign exports that take unboxed
1532   -- arguments.  The RTS API currently can't invoke such things.  --SDM 7/2000
1533   = boxedMarshalableTyCon tc
1534
1535 legalFIResultTyCon :: DynFlags -> TyCon -> Bool
1536 legalFIResultTyCon dflags tc
1537   | tc == unitTyCon         = True
1538   | otherwise               = marshalableTyCon dflags tc
1539
1540 legalFEResultTyCon :: TyCon -> Bool
1541 legalFEResultTyCon tc
1542   | tc == unitTyCon         = True
1543   | otherwise               = boxedMarshalableTyCon tc
1544
1545 legalOutgoingTyCon :: DynFlags -> Safety -> TyCon -> Bool
1546 -- Checks validity of types going from Haskell -> external world
1547 legalOutgoingTyCon dflags _ tc
1548   = marshalableTyCon dflags tc
1549
1550 legalFFITyCon :: TyCon -> Bool
1551 -- True for any TyCon that can possibly be an arg or result of an FFI call
1552 legalFFITyCon tc
1553   = isUnLiftedTyCon tc || boxedMarshalableTyCon tc || tc == unitTyCon
1554
1555 marshalableTyCon :: DynFlags -> TyCon -> Bool
1556 marshalableTyCon dflags tc
1557   =  (xopt Opt_UnliftedFFITypes dflags
1558       && isUnLiftedTyCon tc
1559       && not (isUnboxedTupleTyCon tc)
1560       && case tyConPrimRep tc of        -- Note [Marshalling VoidRep]
1561            VoidRep -> False
1562            _       -> True)
1563   || boxedMarshalableTyCon tc
1564
1565 boxedMarshalableTyCon :: TyCon -> Bool
1566 boxedMarshalableTyCon tc
1567    = getUnique tc `elem` [ intTyConKey, int8TyConKey, int16TyConKey
1568                          , int32TyConKey, int64TyConKey
1569                          , wordTyConKey, word8TyConKey, word16TyConKey
1570                          , word32TyConKey, word64TyConKey
1571                          , floatTyConKey, doubleTyConKey
1572                          , ptrTyConKey, funPtrTyConKey
1573                          , charTyConKey
1574                          , stablePtrTyConKey
1575                          , boolTyConKey
1576                          ]
1577
1578 legalFIPrimArgTyCon :: DynFlags -> TyCon -> Bool
1579 -- Check args of 'foreign import prim', only allow simple unlifted types.
1580 -- Strictly speaking it is unnecessary to ban unboxed tuples here since
1581 -- currently they're of the wrong kind to use in function args anyway.
1582 legalFIPrimArgTyCon dflags tc
1583   = xopt Opt_UnliftedFFITypes dflags
1584     && isUnLiftedTyCon tc
1585     && not (isUnboxedTupleTyCon tc)
1586
1587 legalFIPrimResultTyCon :: DynFlags -> TyCon -> Bool
1588 -- Check result type of 'foreign import prim'. Allow simple unlifted
1589 -- types and also unboxed tuple result types '... -> (# , , #)'
1590 legalFIPrimResultTyCon dflags tc
1591   = xopt Opt_UnliftedFFITypes dflags
1592     && isUnLiftedTyCon tc
1593     && (isUnboxedTupleTyCon tc
1594         || case tyConPrimRep tc of      -- Note [Marshalling VoidRep]
1595            VoidRep -> False
1596            _       -> True)
1597 \end{code}
1598
1599 Note [Marshalling VoidRep]
1600 ~~~~~~~~~~~~~~~~~~~~~~~~~~
1601 We don't treat State# (whose PrimRep is VoidRep) as marshalable.
1602 In turn that means you can't write
1603         foreign import foo :: Int -> State# RealWorld
1604
1605 Reason: the back end falls over with panic "primRepHint:VoidRep";
1606         and there is no compelling reason to permit it