Type.lhs 59.2 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006
3
4
5
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%

6
Type - public interface
7

8
\begin{code}
9
10
11
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
Ian Lynagh's avatar
Ian Lynagh committed
12
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
13
14
-- for details

batterseapower's avatar
batterseapower committed
15
-- | Main functions for manipulating types and type-related things
16
module Type (
batterseapower's avatar
batterseapower committed
17
	-- Note some of this is just re-exports from TyCon..
18

batterseapower's avatar
batterseapower committed
19
20
21
22
23
        -- * Main data types representing Types
	-- $type_classification
	
        -- $representation_types
	TyThing(..), Type, PredType(..), ThetaType,
24

batterseapower's avatar
batterseapower committed
25
26
        -- ** Constructing and deconstructing types
        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe,
27

28
29
	mkAppTy, mkAppTys, splitAppTy, splitAppTys, 
	splitAppTy_maybe, repSplitAppTy_maybe,
30

31
32
	mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, 
	splitFunTys, splitFunTysN,
33
	funResultTy, funArgTy, zipFunTys, typeArity,
34

35
	mkTyConApp, mkTyConTy, 
36
	tyConAppTyCon, tyConAppArgs, 
37
	splitTyConApp_maybe, splitTyConApp, 
38

batterseapower's avatar
batterseapower committed
39
        mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, 
40
	applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
batterseapower's avatar
batterseapower committed
41
42
	
	-- (Newtypes)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
43
	newTyConInstRhs, carefullySplitNewType_maybe,
batterseapower's avatar
batterseapower committed
44
45
	
	-- (Type families)
46
        tyFamInsts, predFamInsts,
47

batterseapower's avatar
batterseapower committed
48
        -- (Source types)
49
        mkPredTy, mkPredTys, mkFamilyTyConApp, isEqPred,
50

batterseapower's avatar
batterseapower committed
51
52
	-- ** Common type constructors
        funTyCon,
53

batterseapower's avatar
batterseapower committed
54
        -- ** Predicates on types
55
        isTyVarTy, isFunTy, isDictTy,
batterseapower's avatar
batterseapower committed
56
57

	-- (Lifting and boxity)
58
59
	isUnLiftedType, isUnboxedTupleType, isAlgType, isClosedAlgType,
	isPrimitiveType, isStrictType, isStrictPred, 
60

batterseapower's avatar
batterseapower committed
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
	-- * Main data types representing Kinds
	-- $kind_subtyping
        Kind, SimpleKind, KindVar,
        
        -- ** Common Kinds and SuperKinds
        liftedTypeKind, unliftedTypeKind, openTypeKind,
        argTypeKind, ubxTupleKind,

        tySuperKind, coSuperKind, 

        -- ** Common Kind type constructors
        liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
        argTypeKindTyCon, ubxTupleKindTyCon,

	-- * Type free variables
76
	tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
77
	expandTypeSynonyms,
78

batterseapower's avatar
batterseapower committed
79
	-- * Tidying type related things up for printing
80
81
82
83
84
	tidyType,      tidyTypes,
	tidyOpenType,  tidyOpenTypes,
	tidyTyVarBndr, tidyFreeTyVars,
	tidyOpenTyVar, tidyOpenTyVars,
	tidyTopType,   tidyPred,
85
	tidyKind,
86

batterseapower's avatar
batterseapower committed
87
	-- * Type comparison
88
89
	coreEqType, coreEqType2,
        tcEqType, tcEqTypes, tcCmpType, tcCmpTypes, 
90
	tcEqPred, tcEqPredX, tcCmpPred, tcEqTypeX, tcPartOfType, tcPartOfPred,
91

batterseapower's avatar
batterseapower committed
92
	-- * Forcing evaluation of types
93
	seqType, seqTypes,
94

batterseapower's avatar
batterseapower committed
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
        -- * Other views onto Types
        coreView, tcView, kindView,

        repType, 

	-- * Type representation for the code generator
	PrimRep(..),

	typePrimRep, predTypeRep,

	-- * Main type substitution data types
	TvSubstEnv,	-- Representation widely visible
	TvSubst(..), 	-- Representation visible to a few friends
	
	-- ** Manipulating type substitutions
	emptyTvSubstEnv, emptyTvSubst,
	
112
	mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
113
114
	getTvSubstEnv, setTvSubstEnv, zapTvSubstEnv, getTvInScope, 
        extendTvInScope, extendTvInScopeList,
115
 	extendTvSubst, extendTvSubstList, isInScope, composeTvSubst, zipTyEnv,
116
        isEmptyTvSubst,
117

batterseapower's avatar
batterseapower committed
118
	-- ** Performing substitution on types
119
	substTy, substTys, substTyWith, substTysWith, substTheta, 
120
	substPred, substTyVar, substTyVars, substTyVarBndr, deShadowTy, lookupTyVar,
121

batterseapower's avatar
batterseapower committed
122
	-- * Pretty-printing
123
	pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing, pprForAll,
124
	pprPred, pprEqPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind,
batterseapower's avatar
batterseapower committed
125
126
	
	pprSourceTyCon
127
    ) where
128

129
130
#include "HsVersions.h"

131
132
133
134
135
-- We import the representation and primitive functions from TypeRep.
-- Many things are reexported, but not the representation!

import TypeRep

136
-- friends:
137
import Var
138
139
140
import VarEnv
import VarSet

141
142
143
import Name
import Class
import TyCon
144
import BasicTypes	( Arity )
145

146
-- others
147
148
import StaticFlags
import Util
149
import Outputable
150
import FastString
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
151

152
import Data.List
153
import Data.Maybe	( isJust )
154
155

infixr 3 `mkFunTy`	-- Associates to the right
156
157
\end{code}

batterseapower's avatar
batterseapower committed
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
\begin{code}
-- $type_classification
-- #type_classification#
-- 
-- Types are one of:
-- 
-- [Unboxed]            Iff its representation is other than a pointer
-- 			Unboxed types are also unlifted.
-- 
-- [Lifted]             Iff it has bottom as an element.
-- 			Closures always have lifted types: i.e. any
-- 			let-bound identifier in Core must have a lifted
-- 			type. Operationally, a lifted object is one that
-- 			can be entered.
-- 			Only lifted types may be unified with a type variable.
-- 
-- [Algebraic]          Iff it is a type with one or more constructors, whether
-- 			declared with @data@ or @newtype@.
-- 			An algebraic type is one that can be deconstructed
-- 			with a case expression. This is /not/ the same as 
--			lifted types, because we also include unboxed
-- 			tuples in this classification.
-- 
-- [Data]               Iff it is a type declared with @data@, or a boxed tuple.
-- 
-- [Primitive]          Iff it is a built-in type that can't be expressed in Haskell.
-- 
-- Currently, all primitive types are unlifted, but that's not necessarily
-- the case: for example, @Int@ could be primitive.
-- 
-- Some primitive types are unboxed, such as @Int#@, whereas some are boxed
-- but unlifted (such as @ByteArray#@).  The only primitive types that we
-- classify as algebraic are the unboxed tuples.
-- 
-- Some examples of type classifications that may make this a bit clearer are:
-- 
-- @
-- Type         primitive       boxed           lifted          algebraic
-- -----------------------------------------------------------------------------
-- Int#         Yes             No              No              No
-- ByteArray#   Yes             Yes             No              No
-- (\# a, b \#)   Yes             No              No              Yes
-- (  a, b  )   No              Yes             Yes             Yes
-- [a]          No              Yes             Yes             Yes
-- @

-- $representation_types
-- A /source type/ is a type that is a separate type as far as the type checker is
-- concerned, but which has a more low-level representation as far as Core-to-Core
-- passes and the rest of the back end is concerned. Notably, 'PredTy's are removed
-- from the representation type while they do exist in the source types.
--
-- You don't normally have to worry about this, as the utility functions in
-- this module will automatically convert a source into a representation type
-- if they are spotted, to the best of it's abilities. If you don't want this
-- to happen, use the equivalent functions from the "TcType" module.
\end{code}
215

216
217
218
219
220
221
222
223
224
%************************************************************************
%*									*
		Type representation
%*									*
%************************************************************************

\begin{code}
{-# INLINE coreView #-}
coreView :: Type -> Maybe Type
batterseapower's avatar
batterseapower committed
225
226
227
228
-- ^ In Core, we \"look through\" non-recursive newtypes and 'PredTypes': this
-- function tries to obtain a different view of the supplied type given this
--
-- Strips off the /top layer only/ of a type to give 
229
230
231
-- its underlying representation type. 
-- Returns Nothing if there is nothing to look through.
--
batterseapower's avatar
batterseapower committed
232
233
234
235
236
237
238
239
240
241
242
243
244
-- In the case of @newtype@s, it returns one of:
--
-- 1) A vanilla 'TyConApp' (recursive newtype, or non-saturated)
-- 
-- 2) The newtype representation (otherwise), meaning the
--    type written in the RHS of the newtype declaration,
--    which may itself be a newtype
--
-- For example, with:
--
-- > newtype R = MkR S
-- > newtype S = MkS T
-- > newtype T = MkT (T -> T)
245
--
batterseapower's avatar
batterseapower committed
246
247
248
249
250
-- 'expandNewTcApp' on:
--
--  * @R@ gives @Just S@
--  * @S@ gives @Just T@
--  * @T@ gives @Nothing@ (no expansion)
251

252
253
-- By being non-recursive and inlined, this case analysis gets efficiently
-- joined onto the case analysis that the caller is already doing
254
255
256
coreView (PredTy p)
  | isEqPred p             = Nothing
  | otherwise    	   = Just (predTypeRep p)
257
258
259
260
261
coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc tys 
			   = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
				-- Its important to use mkAppTys, rather than (foldl AppTy),
				-- because the function part might well return a 
				-- partially-applied type constructor; indeed, usually will!
262
coreView _                 = Nothing
263

264
265


266
267
268
-----------------------------------------------
{-# INLINE tcView #-}
tcView :: Type -> Maybe Type
batterseapower's avatar
batterseapower committed
269
-- ^ Similar to 'coreView', but for the type checker, which just looks through synonyms
270
271
tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys 
			 = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
272
tcView _                 = Nothing
273

274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
-----------------------------------------------
expandTypeSynonyms :: Type -> Type
-- ^ Expand out all type synonyms.  Actually, it'd suffice to expand out
-- just the ones that discard type variables (e.g.  type Funny a = Int)
-- But we don't know which those are currently, so we just expand all.
expandTypeSynonyms ty 
  = go ty
  where
    go (TyConApp tc tys)
      | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys 
      = go (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
      | otherwise
      = TyConApp tc (map go tys)
    go (TyVarTy tv)    = TyVarTy tv
    go (AppTy t1 t2)   = AppTy (go t1) (go t2)
    go (FunTy t1 t2)   = FunTy (go t1) (go t2)
    go (ForAllTy tv t) = ForAllTy tv (go t)
    go (PredTy p)      = PredTy (go_pred p)

    go_pred (ClassP c ts)  = ClassP c (map go ts)
    go_pred (IParam ip t)  = IParam ip (go t)
    go_pred (EqPred t1 t2) = EqPred (go t1) (go t2)

297
298
299
-----------------------------------------------
{-# INLINE kindView #-}
kindView :: Kind -> Maybe Kind
batterseapower's avatar
batterseapower committed
300
301
-- ^ Similar to 'coreView' or 'tcView', but works on 'Kind's

302
-- For the moment, we don't even handle synonyms in kinds
303
kindView _            = Nothing
304
305
306
\end{code}


307
308
309
310
311
%************************************************************************
%*									*
\subsection{Constructor-specific functions}
%*									*
%************************************************************************
sof's avatar
sof committed
312
313


314
315
316
---------------------------------------------------------------------
				TyVarTy
				~~~~~~~
317
\begin{code}
318
mkTyVarTy  :: TyVar   -> Type
319
mkTyVarTy  = TyVarTy
320

321
mkTyVarTys :: [TyVar] -> [Type]
322
mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
323

batterseapower's avatar
batterseapower committed
324
325
-- | Attempts to obtain the type variable underlying a 'Type', and panics with the
-- given message if this is not a type variable type. See also 'getTyVar_maybe'
326
getTyVar :: String -> Type -> TyVar
327
328
329
getTyVar msg ty = case getTyVar_maybe ty of
		    Just tv -> tv
		    Nothing -> panic ("getTyVar: " ++ msg)
330

331
isTyVarTy :: Type -> Bool
332
333
isTyVarTy ty = isJust (getTyVar_maybe ty)

batterseapower's avatar
batterseapower committed
334
-- | Attempts to obtain the type variable underlying a 'Type'
335
getTyVar_maybe :: Type -> Maybe TyVar
336
337
getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
getTyVar_maybe (TyVarTy tv) 	 	    = Just tv  
338
getTyVar_maybe _                            = Nothing
339

340
341
342
\end{code}


343
344
345
346
347
348
---------------------------------------------------------------------
				AppTy
				~~~~~
We need to be pretty careful with AppTy to make sure we obey the 
invariant that a TyConApp is always visibly so.  mkAppTy maintains the
invariant: use it.
349

350
\begin{code}
batterseapower's avatar
batterseapower committed
351
-- | Applies a type to another, as in e.g. @k a@
352
mkAppTy :: Type -> Type -> Type
353
mkAppTy orig_ty1 orig_ty2
354
  = mk_app orig_ty1
355
  where
356
    mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ [orig_ty2])
357
    mk_app _                 = AppTy orig_ty1 orig_ty2
358
	-- Note that the TyConApp could be an 
359
360
361
362
363
364
365
	-- under-saturated type synonym.  GHC allows that; e.g.
	--	type Foo k = k a -> k a
	--	type Id x = x
	--	foo :: Foo Id -> Foo Id
	--
	-- Here Id is partially applied in the type sig for Foo,
	-- but once the type synonyms are expanded all is well
366

367
mkAppTys :: Type -> [Type] -> Type
368
369
mkAppTys orig_ty1 []	    = orig_ty1
	-- This check for an empty list of type arguments
370
	-- avoids the needless loss of a type synonym constructor.
371
372
373
	-- For example: mkAppTys Rational []
	--   returns to (Ratio Integer), which has needlessly lost
	--   the Rational part.
374
mkAppTys orig_ty1 orig_tys2
375
  = mk_app orig_ty1
376
  where
377
378
    mk_app (TyConApp tc tys) = mkTyConApp tc (tys ++ orig_tys2)
				-- mkTyConApp: see notes with mkAppTy
379
    mk_app _                 = foldl AppTy orig_ty1 orig_tys2
380

381
-------------
382
splitAppTy_maybe :: Type -> Maybe (Type, Type)
batterseapower's avatar
batterseapower committed
383
384
385
-- ^ Attempt to take a type application apart, whether it is a
-- function, type constructor, or plain type application. Note
-- that type family applications are NEVER unsaturated by this!
386
387
388
splitAppTy_maybe ty | Just ty' <- coreView ty
		    = splitAppTy_maybe ty'
splitAppTy_maybe ty = repSplitAppTy_maybe ty
389

390
391
-------------
repSplitAppTy_maybe :: Type -> Maybe (Type,Type)
batterseapower's avatar
batterseapower committed
392
393
-- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that 
-- any Core view stuff is already done
394
395
repSplitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
repSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
396
repSplitAppTy_maybe (TyConApp tc tys) 
397
  | isDecomposableTyCon tc || length tys > tyConArity tc 
398
399
400
401
  = case snocView tys of       -- never create unsaturated type family apps
      Just (tys', ty') -> Just (TyConApp tc tys', ty')
      Nothing	       -> Nothing
repSplitAppTy_maybe _other = Nothing
402
-------------
403
splitAppTy :: Type -> (Type, Type)
batterseapower's avatar
batterseapower committed
404
405
-- ^ Attempts to take a type application apart, as in 'splitAppTy_maybe',
-- and panics if this is not possible
406
407
408
splitAppTy ty = case splitAppTy_maybe ty of
			Just pr -> pr
			Nothing -> panic "splitAppTy"
409

410
-------------
411
splitAppTys :: Type -> (Type, [Type])
batterseapower's avatar
batterseapower committed
412
413
414
-- ^ Recursively splits a type as far as is possible, leaving a residual
-- type being applied to and the type arguments applied to it. Never fails,
-- even if that means returning an empty list of type applications.
415
splitAppTys ty = split ty ty []
416
  where
417
    split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args
418
419
    split _       (AppTy ty arg)        args = split ty ty (arg:args)
    split _       (TyConApp tc tc_args) args
420
      = let -- keep type families saturated
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
421
422
            n | isDecomposableTyCon tc = 0
              | otherwise              = tyConArity tc
423
            (tc_args1, tc_args2) = splitAt n tc_args
424
425
        in
        (TyConApp tc tc_args1, tc_args2 ++ args)
426
    split _       (FunTy ty1 ty2)       args = ASSERT( null args )
427
					       (TyConApp funTyCon [], [ty1,ty2])
428
    split orig_ty _                     args = (orig_ty, args)
429

430
431
\end{code}

432
433
434
435
436

---------------------------------------------------------------------
				FunTy
				~~~~~

437
\begin{code}
438
mkFunTy :: Type -> Type -> Type
batterseapower's avatar
batterseapower committed
439
-- ^ Creates a function type from the given argument and result type
440
441
mkFunTy arg@(PredTy (EqPred {})) res = ForAllTy (mkWildCoVar arg) res
mkFunTy arg                      res = FunTy    arg               res
442

443
mkFunTys :: [Type] -> Type -> Type
444
mkFunTys tys ty = foldr mkFunTy ty tys
445

446
447
448
isFunTy :: Type -> Bool 
isFunTy ty = isJust (splitFunTy_maybe ty)

449
splitFunTy :: Type -> (Type, Type)
batterseapower's avatar
batterseapower committed
450
451
-- ^ Attempts to extract the argument and result types from a type, and
-- panics if that is not possible. See also 'splitFunTy_maybe'
452
splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
453
splitFunTy (FunTy arg res)   = (arg, res)
454
splitFunTy other	     = pprPanic "splitFunTy" (ppr other)
455

456
splitFunTy_maybe :: Type -> Maybe (Type, Type)
batterseapower's avatar
batterseapower committed
457
-- ^ Attempts to extract the argument and result types from a type
458
splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
459
splitFunTy_maybe (FunTy arg res)   = Just (arg, res)
460
splitFunTy_maybe _                 = Nothing
461

462
splitFunTys :: Type -> ([Type], Type)
463
splitFunTys ty = split [] ty ty
464
  where
465
    split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
466
467
    split args _       (FunTy arg res)   = split (arg:args) res res
    split args orig_ty _                 = (reverse args, orig_ty)
468

469
splitFunTysN :: Int -> Type -> ([Type], Type)
batterseapower's avatar
batterseapower committed
470
-- ^ Split off exactly the given number argument types, and panics if that is not possible
471
472
473
474
475
splitFunTysN 0 ty = ([], ty)
splitFunTysN n ty = case splitFunTy ty of { (arg, res) ->
		    case splitFunTysN (n-1) res of { (args, res) ->
		    (arg:args, res) }}

batterseapower's avatar
batterseapower committed
476
477
478
479
480
481
-- | Splits off argument types from the given type and associating
-- them with the things in the input list from left to right. The
-- final result type is returned, along with the resulting pairs of
-- objects and types, albeit with the list of pairs in reverse order.
-- Panics if there are not enough argument types for the input list.
zipFunTys :: Outputable a => [a] -> Type -> ([(a, Type)], Type)
482
483
zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
  where
484
    split acc []     nty _                 = (reverse acc, nty)
485
486
    split acc xs     nty ty 
	  | Just ty' <- coreView ty 	   = split acc xs nty ty'
487
488
    split acc (x:xs) _   (FunTy arg res)   = split ((x,arg):acc) xs res res
    split _   _      _   _                 = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
489
490
    
funResultTy :: Type -> Type
batterseapower's avatar
batterseapower committed
491
-- ^ Extract the function result type and panic if that is not possible
492
funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
493
494
funResultTy (FunTy _arg res)  = res
funResultTy ty                = pprPanic "funResultTy" (ppr ty)
495
496

funArgTy :: Type -> Type
batterseapower's avatar
batterseapower committed
497
-- ^ Extract the function argument type and panic if that is not possible
498
funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
499
500
funArgTy (FunTy arg _res)  = arg
funArgTy ty                = pprPanic "funArgTy" (ppr ty)
501
502
503
504
505
506
507
508

typeArity :: Type -> Arity
-- How many value arrows are visible in the type?
-- We look through foralls, but not through newtypes, dictionaries etc
typeArity ty | Just ty' <- coreView ty = typeArity ty'
typeArity (FunTy _ ty)    = 1 + typeArity ty
typeArity (ForAllTy _ ty) = typeArity ty
typeArity _               = 0
509
510
\end{code}

511
512
513
---------------------------------------------------------------------
				TyConApp
				~~~~~~~~
514

515
\begin{code}
batterseapower's avatar
batterseapower committed
516
517
-- | A key function: builds a 'TyConApp' or 'FunTy' as apppropriate to its arguments.
-- Applies its arguments to the constructor from left to right
518
mkTyConApp :: TyCon -> [Type] -> Type
519
mkTyConApp tycon tys
520
  | isFunTyCon tycon, [ty1,ty2] <- tys
521
  = FunTy ty1 ty2
522

523
  | otherwise
524
  = TyConApp tycon tys
525

batterseapower's avatar
batterseapower committed
526
-- | Create the plain type constructor type which has been applied to no type arguments at all.
527
mkTyConTy :: TyCon -> Type
528
mkTyConTy tycon = mkTyConApp tycon []
529
530
531
532
533

-- splitTyConApp "looks through" synonyms, because they don't
-- mean a distinct type, but all other type-constructor applications
-- including functions are returned as Just ..

batterseapower's avatar
batterseapower committed
534
-- | The same as @fst . splitTyConApp@
535
tyConAppTyCon :: Type -> TyCon
536
tyConAppTyCon ty = fst (splitTyConApp ty)
537

batterseapower's avatar
batterseapower committed
538
-- | The same as @snd . splitTyConApp@
539
tyConAppArgs :: Type -> [Type]
540
tyConAppArgs ty = snd (splitTyConApp ty)
541

batterseapower's avatar
batterseapower committed
542
543
544
-- | Attempts to tease a type apart into a type constructor and the application
-- of a number of arguments to that constructor. Panics if that is not possible.
-- See also 'splitTyConApp_maybe'
545
546
547
splitTyConApp :: Type -> (TyCon, [Type])
splitTyConApp ty = case splitTyConApp_maybe ty of
			Just stuff -> stuff
548
			Nothing	   -> pprPanic "splitTyConApp" (ppr ty)
549

batterseapower's avatar
batterseapower committed
550
551
-- | Attempts to tease a type apart into a type constructor and the application
-- of a number of arguments to that constructor
552
splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
553
splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'
554
splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
555
splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
556
splitTyConApp_maybe _                 = Nothing
557

558
newTyConInstRhs :: TyCon -> [Type] -> Type
559
-- ^ Unwrap one 'layer' of newtype on a type constructor and its arguments, using an 
batterseapower's avatar
batterseapower committed
560
-- eta-reduced version of the @newtype@ if possible
561
562
563
564
565
566
newTyConInstRhs tycon tys 
    = ASSERT2( equalLength tvs tys1, ppr tycon $$ ppr tys $$ ppr tvs )
      mkAppTys (substTyWith tvs tys1 ty) tys2
  where
    (tvs, ty)    = newTyConEtadRhs tycon
    (tys1, tys2) = splitAtList tvs tys
sof's avatar
sof committed
567
\end{code}
568

569

570
571
572
573
574
575
576
577
---------------------------------------------------------------------
				SynTy
				~~~~~

Notes on type synonyms
~~~~~~~~~~~~~~~~~~~~~~
The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
to return type synonyms whereever possible. Thus
578

579
580
581
582
583
584
585
586
	type Foo a = a -> a

we want 
	splitFunTys (a -> Foo a) = ([a], Foo a)
not			           ([a], a -> a)

The reason is that we then get better (shorter) type signatures in 
interfaces.  Notably this plays a role in tcTySigs in TcBinds.lhs.
587
588


589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
Note [Expanding newtypes]
~~~~~~~~~~~~~~~~~~~~~~~~~
When expanding a type to expose a data-type constructor, we need to be
careful about newtypes, lest we fall into an infinite loop. Here are
the key examples:

  newtype Id  x = MkId x
  newtype Fix f = MkFix (f (Fix f))
  newtype T     = MkT (T -> T) 
  
  Type	         Expansion
 --------------------------
  T		 T -> T
  Fix Maybe      Maybe (Fix Maybe)
  Id (Id Int)    Int
  Fix Id         NO NO NO

Notice that we can expand T, even though it's recursive.
And we can expand Id (Id Int), even though the Id shows up
twice at the outer level.  

So, when expanding, we keep track of when we've seen a recursive
newtype at outermost level; and bale out if we see it again.


614
615
		Representation types
		~~~~~~~~~~~~~~~~~~~~
616
617

\begin{code}
batterseapower's avatar
batterseapower committed
618
619
620
621
622
-- | Looks through:
--
--	1. For-alls
--	2. Synonyms
--	3. Predicates
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
623
--	4. All newtypes, including recursive ones, but not newtype families
batterseapower's avatar
batterseapower committed
624
625
--
-- It's useful in the back end of the compiler.
626
repType :: Type -> Type
627
-- Only applied to types of kind *; hence tycons are saturated
628
629
630
631
632
633
634
635
636
637
repType ty
  = go [] ty
  where
    go :: [TyCon] -> Type -> Type
    go rec_nts ty | Just ty' <- coreView ty 	-- Expand synonyms
	= go rec_nts ty'	

    go rec_nts (ForAllTy _ ty)			-- Look through foralls
	= go rec_nts ty

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
638
639
640
    go rec_nts (TyConApp tc tys)		-- Expand newtypes
      | Just (rec_nts', ty') <- carefullySplitNewType_maybe rec_nts tc tys
      = go rec_nts' ty'
641

642
    go _ ty = ty
643

644

simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
645
646
647
648
649
650
651
652
653
654
655
656
carefullySplitNewType_maybe :: [TyCon] -> TyCon -> [Type] -> Maybe ([TyCon],Type)
-- Return the representation of a newtype, unless 
-- we've seen it already: see Note [Expanding newtypes]
carefullySplitNewType_maybe rec_nts tc tys
  | isNewTyCon tc
  , not (tc `elem` rec_nts)  = Just (rec_nts', newTyConInstRhs tc tys)
  | otherwise	   	     = Nothing
  where
    rec_nts' | isRecursiveTyCon tc = tc:rec_nts
	     | otherwise	   = rec_nts


657
658
-- ToDo: this could be moved to the code generator, using splitTyConApp instead
-- of inspecting the type directly.
batterseapower's avatar
batterseapower committed
659
660

-- | Discovers the primitive representation of a more abstract 'Type'
661
662
663
664
typePrimRep :: Type -> PrimRep
typePrimRep ty = case repType ty of
		   TyConApp tc _ -> tyConPrimRep tc
		   FunTy _ _	 -> PtrRep
665
		   AppTy _ _	 -> PtrRep	-- See note below
666
		   TyVarTy _	 -> PtrRep
667
		   _             -> pprPanic "typePrimRep" (ppr ty)
668
669
670
671
672
	-- Types of the form 'f a' must be of kind *, not *#, so
	-- we are guaranteed that they are represented by pointers.
	-- The reason is that f must have kind *->*, not *->*#, because
	-- (we claim) there is no way to constrain f's kind any other
	-- way.
673
674
675
\end{code}


676
677
678
---------------------------------------------------------------------
				ForAllTy
				~~~~~~~~
679
680

\begin{code}
681
mkForAllTy :: TyVar -> Type -> Type
682
mkForAllTy tyvar ty
683
  = ForAllTy tyvar ty
684

batterseapower's avatar
batterseapower committed
685
-- | Wraps foralls over the type using the provided 'TyVar's from left to right
686
mkForAllTys :: [TyVar] -> Type -> Type
687
mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
688
689
690

isForAllTy :: Type -> Bool
isForAllTy (ForAllTy _ _) = True
691
isForAllTy _              = False
692

batterseapower's avatar
batterseapower committed
693
694
-- | Attempts to take a forall type apart, returning the bound type variable
-- and the remainder of the type
695
splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
696
splitForAllTy_maybe ty = splitFAT_m ty
697
  where
698
699
700
    splitFAT_m ty | Just ty' <- coreView ty = splitFAT_m ty'
    splitFAT_m (ForAllTy tyvar ty)	    = Just(tyvar, ty)
    splitFAT_m _			    = Nothing
sof's avatar
sof committed
701

batterseapower's avatar
batterseapower committed
702
703
704
-- | Attempts to take a forall type apart, returning all the immediate such bound
-- type variables and the remainder of the type. Always suceeds, even if that means
-- returning an empty list of 'TyVar's
705
splitForAllTys :: Type -> ([TyVar], Type)
706
splitForAllTys ty = split ty ty []
707
   where
708
     split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
709
710
     split _       (ForAllTy tv ty)  tvs = split ty ty (tv:tvs)
     split orig_ty _                 tvs = (reverse tvs, orig_ty)
711

batterseapower's avatar
batterseapower committed
712
-- | Equivalent to @snd . splitForAllTys@
713
714
dropForAlls :: Type -> Type
dropForAlls ty = snd (splitForAllTys ty)
715
716
\end{code}

717
-- (mkPiType now in CoreUtils)
718

719
720
applyTy, applyTys
~~~~~~~~~~~~~~~~~
721

722
\begin{code}
batterseapower's avatar
batterseapower committed
723
724
725
726
727
728
729
-- | Instantiate a forall type with one or more type arguments.
-- Used when we have a polymorphic function applied to type args:
--
-- > f t1 t2
--
-- We use @applyTys type-of-f [t1,t2]@ to compute the type of the expression.
-- Panics if no application is possible.
730
applyTy :: Type -> Type -> Type
731
732
applyTy ty arg | Just ty' <- coreView ty = applyTy ty' arg
applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
733
applyTy _                _   = panic "applyTy"
734

735
applyTys :: Type -> [Type] -> Type
batterseapower's avatar
batterseapower committed
736
737
738
739
740
741
742
743
744
745
-- ^ This function is interesting because:
--
--	1. The function may have more for-alls than there are args
--
--	2. Less obviously, it may have fewer for-alls
--
-- For case 2. think of:
--
-- > applyTys (forall a.a) [forall b.b, Int]
--
746
747
-- This really can happen, via dressing up polymorphic types with newtype
-- clothing.  Here's an example:
batterseapower's avatar
batterseapower committed
748
749
750
751
--
-- > newtype R = R (forall a. a->a)
-- > foo = case undefined :: R of
-- >            R f -> f ()
752

753
754
755
756
757
applyTys ty args = applyTysD empty ty args

applyTysD :: SDoc -> Type -> [Type] -> Type	-- Debug version
applyTysD _   orig_fun_ty []      = orig_fun_ty
applyTysD doc orig_fun_ty arg_tys 
758
759
760
761
762
763
  | n_tvs == n_args 	-- The vastly common case
  = substTyWith tvs arg_tys rho_ty
  | n_tvs > n_args 	-- Too many for-alls
  = substTyWith (take n_args tvs) arg_tys 
		(mkForAllTys (drop n_args tvs) rho_ty)
  | otherwise		-- Too many type args
764
  = ASSERT2( n_tvs > 0, doc $$ ppr orig_fun_ty )	-- Zero case gives infnite loop!
765
766
    applyTysD doc (substTyWith tvs (take n_tvs arg_tys) rho_ty)
	          (drop n_tvs arg_tys)
767
768
769
770
  where
    (tvs, rho_ty) = splitForAllTys orig_fun_ty 
    n_tvs = length tvs
    n_args = length arg_tys     
771
\end{code}
772

773

774
775
%************************************************************************
%*									*
776
\subsection{Source types}
777
778
%*									*
%************************************************************************
779

780
Source types are always lifted.
781

782
The key function is predTypeRep which gives the representation of a source type:
783
784

\begin{code}
785
mkPredTy :: PredType -> Type
786
mkPredTy pred = PredTy pred
787
788

mkPredTys :: ThetaType -> [Type]
789
790
mkPredTys preds = map PredTy preds

791
792
793
794
isEqPred :: PredType -> Bool
isEqPred (EqPred _ _) = True
isEqPred _            = False

795
predTypeRep :: PredType -> Type
batterseapower's avatar
batterseapower committed
796
797
-- ^ Convert a 'PredType' to its representation type. However, it unwraps 
-- only the outermost level; for example, the result might be a newtype application
798
799
predTypeRep (IParam _ ty)     = ty
predTypeRep (ClassP clas tys) = mkTyConApp (classTyCon clas) tys
800
	-- Result might be a newtype application, but the consumer will
801
	-- look through that too if necessary
802
predTypeRep (EqPred ty1 ty2) = pprPanic "predTypeRep" (ppr (EqPred ty1 ty2))
803

804
mkFamilyTyConApp :: TyCon -> [Type] -> Type
batterseapower's avatar
batterseapower committed
805
806
807
808
809
810
811
812
813
-- ^ Given a family instance TyCon and its arg types, return the
-- corresponding family type.  E.g:
--
-- > data family T a
-- > data instance T (Maybe b) = MkT b
--
-- Where the instance tycon is :RTL, so:
--
-- > mkFamilyTyConApp :RTL Int  =  T (Maybe Int)
814
815
816
817
818
819
820
mkFamilyTyConApp tc tys
  | Just (fam_tc, fam_tys) <- tyConFamInst_maybe tc
  , let fam_subst = zipTopTvSubst (tyConTyVars tc) tys
  = mkTyConApp fam_tc (substTys fam_subst fam_tys)
  | otherwise
  = mkTyConApp tc tys

batterseapower's avatar
batterseapower committed
821
822
823
824
825
826
-- | Pretty prints a 'TyCon', using the family instance in case of a
-- representation tycon.  For example:
--
-- > data T [a] = ...
--
-- In that case we want to print @T [a]@, where @T@ is the family 'TyCon'
827
pprSourceTyCon :: TyCon -> SDoc
828
pprSourceTyCon tycon 
829
830
  | Just (fam_tc, tys) <- tyConFamInst_maybe tycon
  = ppr $ fam_tc `TyConApp` tys	       -- can't be FunTyCon
831
832
  | otherwise
  = ppr tycon
833
834
835
836
837

isDictTy :: Type -> Bool
isDictTy ty = case splitTyConApp_maybe ty of
                Just (tc, _) -> isClassTyCon tc
		Nothing      -> False
838
\end{code}
839
840


841
842
%************************************************************************
%*									*
843
	     The free variables of a type
844
845
846
%*									*
%************************************************************************

847
\begin{code}
848
tyVarsOfType :: Type -> TyVarSet
batterseapower's avatar
batterseapower committed
849
-- ^ NB: for type synonyms tyVarsOfType does /not/ expand the synonym
850
tyVarsOfType (TyVarTy tv)		= unitVarSet tv
851
tyVarsOfType (TyConApp _ tys)           = tyVarsOfTypes tys
852
tyVarsOfType (PredTy sty)		= tyVarsOfPred sty
853
854
tyVarsOfType (FunTy arg res)		= tyVarsOfType arg `unionVarSet` tyVarsOfType res
tyVarsOfType (AppTy fun arg)		= tyVarsOfType fun `unionVarSet` tyVarsOfType arg
855
tyVarsOfType (ForAllTy tyvar ty)	= delVarSet (tyVarsOfType ty) tyvar
856

857
tyVarsOfTypes :: [Type] -> TyVarSet
858
859
tyVarsOfTypes tys = foldr (unionVarSet.tyVarsOfType) emptyVarSet tys

860
tyVarsOfPred :: PredType -> TyVarSet
861
862
863
tyVarsOfPred (IParam _ ty)    = tyVarsOfType ty
tyVarsOfPred (ClassP _ tys)   = tyVarsOfTypes tys
tyVarsOfPred (EqPred ty1 ty2) = tyVarsOfType ty1 `unionVarSet` tyVarsOfType ty2
864
865

tyVarsOfTheta :: ThetaType -> TyVarSet
866
tyVarsOfTheta = foldr (unionVarSet . tyVarsOfPred) emptyVarSet
867
\end{code}
868

869

870
871
872
873
874
875
876
%************************************************************************
%*									*
\subsection{Type families}
%*									*
%************************************************************************

\begin{code}
batterseapower's avatar
batterseapower committed
877
-- | Finds type family instances occuring in a type after expanding synonyms.
878
879
880
881
882
883
884
885
886
887
tyFamInsts :: Type -> [(TyCon, [Type])]
tyFamInsts ty 
  | Just exp_ty <- tcView ty    = tyFamInsts exp_ty
tyFamInsts (TyVarTy _)          = []
tyFamInsts (TyConApp tc tys) 
  | isOpenSynTyCon tc           = [(tc, tys)]
  | otherwise                   = concat (map tyFamInsts tys)
tyFamInsts (FunTy ty1 ty2)      = tyFamInsts ty1 ++ tyFamInsts ty2
tyFamInsts (AppTy ty1 ty2)      = tyFamInsts ty1 ++ tyFamInsts ty2
tyFamInsts (ForAllTy _ ty)      = tyFamInsts ty
888
889
890
891
892
893
894
895
tyFamInsts (PredTy pty)         = predFamInsts pty

-- | Finds type family instances occuring in a predicate type after expanding 
-- synonyms.
predFamInsts :: PredType -> [(TyCon, [Type])]
predFamInsts (ClassP _cla tys) = concat (map tyFamInsts tys)
predFamInsts (IParam _ ty)     = tyFamInsts ty
predFamInsts (EqPred ty1 ty2)  = tyFamInsts ty1 ++ tyFamInsts ty2
896
897
898
\end{code}


899
900
901
902
903
%************************************************************************
%*									*
\subsection{TidyType}
%*									*
%************************************************************************
904

905
\begin{code}
batterseapower's avatar
batterseapower committed
906
907
908
909
-- | This tidies up a type for printing in an error message, or in
-- an interface file.
-- 
-- It doesn't change the uniques at all, just the print names.
910
tidyTyVarBndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
911
tidyTyVarBndr env@(tidy_env, subst) tyvar
912
  = case tidyOccName tidy_env (getOccName name) of
913
914
915
916
917
918
919
920
921
      (tidy', occ') -> ((tidy', subst'), tyvar'')
	where
	  subst' = extendVarEnv subst tyvar tyvar''
	  tyvar' = setTyVarName tyvar name'
	  name'  = tidyNameOcc name occ'
		-- Don't forget to tidy the kind for coercions!
	  tyvar'' | isCoVar tyvar = setTyVarKind tyvar' kind'
		  | otherwise	  = tyvar'
	  kind'  = tidyType env (tyVarKind tyvar)
922
923
  where
    name = tyVarName tyvar
924

925
tidyFreeTyVars :: TidyEnv -> TyVarSet -> TidyEnv
batterseapower's avatar
batterseapower committed
926
-- ^ Add the free 'TyVar's to the env in tidy form,
927
-- so that we can tidy the type they are free in
928
929
930
931
932
933
tidyFreeTyVars env tyvars = fst (tidyOpenTyVars env (varSetElems tyvars))

tidyOpenTyVars :: TidyEnv -> [TyVar] -> (TidyEnv, [TyVar])
tidyOpenTyVars env tyvars = mapAccumL tidyOpenTyVar env tyvars

tidyOpenTyVar :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
batterseapower's avatar
batterseapower committed
934
935
936
-- ^ Treat a new 'TyVar' as a binder, and give it a fresh tidy name
-- using the environment if one has not already been allocated. See
-- also 'tidyTyVarBndr'
937
tidyOpenTyVar env@(_, subst) tyvar
938
939
940
  = case lookupVarEnv subst tyvar of
	Just tyvar' -> (env, tyvar')		-- Already substituted
	Nothing	    -> tidyTyVarBndr env tyvar	-- Treat it as a binder
941

942
tidyType :: TidyEnv -> Type -> Type
943
tidyType env@(_, subst) ty
944
  = go ty
945
  where
946
947
948
    go (TyVarTy tv)	    = case lookupVarEnv subst tv of
				Nothing  -> TyVarTy tv
				Just tv' -> TyVarTy tv'
949
950
    go (TyConApp tycon tys) = let args = map go tys
			      in args `seqList` TyConApp tycon args
951
    go (PredTy sty)	    = PredTy (tidyPred env sty)
sof's avatar
sof committed
952
953
954
    go (AppTy fun arg)	    = (AppTy $! (go fun)) $! (go arg)
    go (FunTy fun arg)	    = (FunTy $! (go fun)) $! (go arg)
    go (ForAllTy tv ty)	    = ForAllTy tvp $! (tidyType envp ty)
955
			      where
956
			        (envp, tvp) = tidyTyVarBndr env tv
957

958
tidyTypes :: TidyEnv -> [Type] -> [Type]
959
tidyTypes env tys = map (tidyType env) tys
960

961
962
963
tidyPred :: TidyEnv -> PredType -> PredType
tidyPred env (IParam n ty)     = IParam n (tidyType env ty)
tidyPred env (ClassP clas tys) = ClassP clas (tidyTypes env tys)
964
tidyPred env (EqPred ty1 ty2)  = EqPred (tidyType env ty1) (tidyType env ty2)
965
966
967
968
\end{code}


\begin{code}
batterseapower's avatar
batterseapower committed
969
970
-- | Grabs the free type variables, tidies them
-- and then uses 'tidyType' to work over the type itself
971
972
973
974
tidyOpenType :: TidyEnv -> Type -> (TidyEnv, Type)
tidyOpenType env ty
  = (env', tidyType env' ty)
  where
975
    env' = tidyFreeTyVars env (tyVarsOfType ty)
976
977
978
979

tidyOpenTypes :: TidyEnv -> [Type] -> (TidyEnv, [Type])
tidyOpenTypes env tys = mapAccumL tidyOpenType env tys

batterseapower's avatar
batterseapower committed
980
-- | Calls 'tidyType' on a top-level type (i.e. with an empty tidying environment)
981
982
tidyTopType :: Type -> Type
tidyTopType ty = tidyType emptyTidyEnv ty
983
984
\end{code}

985
\begin{code}
986

987
tidyKind :: TidyEnv -> Kind -> (TidyEnv, Kind)
988
tidyKind env k = tidyOpenType env k
989
990
991

\end{code}

992

993
994
%************************************************************************
%*									*
995
\subsection{Liftedness}
996
997
998
%*									*
%************************************************************************

999
\begin{code}
batterseapower's avatar
batterseapower committed
1000
-- | See "Type#type_classification" for what an unlifted type is
1001
isUnLiftedType :: Type -> Bool
1002
1003
1004
1005
1006
1007
	-- isUnLiftedType returns True for forall'd unlifted types:
	--	x :: forall a. Int#
	-- I found bindings like these were getting floated to the top level.
	-- They are pretty bogus types, mind you.  It would be better never to
	-- construct them

1008
isUnLiftedType ty | Just ty' <- coreView ty = isUnLiftedType ty'
1009
isUnLiftedType (ForAllTy _ ty)   = isUnLiftedType ty
1010
isUnLiftedType (TyConApp tc _)   = isUnLiftedTyCon tc
1011
isUnLiftedType _                 = False
1012

1013
isUnboxedTupleType :: Type -> Bool
1014
isUnboxedTupleType ty = case splitTyConApp_maybe ty of
1015
1016
                           Just (tc, _ty_args) -> isUnboxedTupleTyCon tc
                           _                   -> False
1017

batterseapower's avatar
batterseapower committed
1018
1019
1020
-- | See "Type#type_classification" for what an algebraic type is.
-- Should only be applied to /types/, as opposed to e.g. partially
-- saturated type constructors
1021
isAlgType :: Type -> Bool
1022
1023
1024
1025
1026
1027
isAlgType ty 
  = case splitTyConApp_maybe ty of
      Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
			    isAlgTyCon tc
      _other	         -> False

batterseapower's avatar
batterseapower committed
1028
1029
1030
1031
-- | See "Type#type_classification" for what an algebraic type is.
-- Should only be applied to /types/, as opposed to e.g. partially
-- saturated type constructors. Closed type constructors are those
-- with a fixed right hand side, as opposed to e.g. associated types
1032
1033
1034
1035
1036
1037
isClosedAlgType :: Type -> Bool
isClosedAlgType ty
  = case splitTyConApp_maybe ty of
      Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )
			    isAlgTyCon tc && not (isOpenTyCon tc)
      _other	         -> False
1038
1039
\end{code}

1040
\begin{code}
batterseapower's avatar
batterseapower committed
1041
1042
1043
1044
1045
1046
1047
1048
-- | Computes whether an argument (or let right hand side) should
-- be computed strictly or lazily, based only on its type.
-- Works just like 'isUnLiftedType', except that it has a special case 
-- for dictionaries (i.e. does not work purely on representation types)

-- Since it takes account of class 'PredType's, you might think
-- this function should be in 'TcType', but 'isStrictType' is used by 'DataCon',
-- which is below 'TcType' in the hierarchy, so it's convenient to put it here.
1049
isStrictType :: Type -> Bool
1050
1051
isStrictType (PredTy pred)     = isStrictPred pred
isStrictType ty | Just ty' <- coreView ty = isStrictType ty'
1052
isStrictType (ForAllTy _ ty)   = isStrictType ty
1053
isStrictType (TyConApp tc _)   = isUnLiftedTyCon tc
1054
isStrictType _                 = False
1055

batterseapower's avatar
batterseapower committed
1056
1057
1058
1059
1060
-- | We may be strict in dictionary types, but only if it 
-- has more than one component.
--
-- (Being strict in a single-component dictionary risks
--  poking the dictionary component, which is wrong.)
1061
isStrictPred :: PredType -> Bool
1062
isStrictPred (ClassP clas _) = opt_DictsStrict && not (isNewTyCon (classTyCon clas))
1063
isStrictPred _               = False
1064
1065
1066
1067
\end{code}

\begin{code}
isPrimitiveType :: Type -> Bool
batterseapower's avatar
batterseapower committed
1068
-- ^ Returns true of types that are opaque to Haskell.
1069
1070
1071
-- Most of these are unlifted, but now that we interact with .NET, we
-- may have primtive (foreign-imported) types that are lifted
isPrimitiveType ty = case splitTyConApp_maybe ty of
sof's avatar
sof committed
1072
			Just (tc, ty_args) -> ASSERT( ty_args `lengthIs` tyConArity tc )