Type.lhs 58.8 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
{-# OPTIONS_GHC -fno-warn-orphans #-}
Ian Lynagh's avatar
Ian Lynagh committed
10 11 12 13 14 15 16
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

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

batterseapower's avatar
batterseapower committed
21 22 23 24
        -- * Main data types representing Types
	-- $type_classification
	
        -- $representation_types
dreixel's avatar
dreixel committed
25
        TyThing(..), Type, KindOrType, PredType, ThetaType,
26
        Var, TyVar, isTyVar, 
27

batterseapower's avatar
batterseapower committed
28 29
        -- ** Constructing and deconstructing types
        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe,
30

31
	mkAppTy, mkAppTys, mkNakedAppTys, splitAppTy, splitAppTys, 
32
	splitAppTy_maybe, repSplitAppTy_maybe,
33

34 35
	mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe, 
	splitFunTys, splitFunTysN,
36
	funResultTy, funArgTy, zipFunTys, 
37

dreixel's avatar
dreixel committed
38
	mkTyConApp, mkTyConTy,
39
	tyConAppTyCon_maybe, tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs, 
40
	splitTyConApp_maybe, splitTyConApp, tyConAppArgN,
41

batterseapower's avatar
batterseapower committed
42
        mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys, 
43
        mkPiKinds, mkPiType, mkPiTypes,
44
	applyTy, applyTys, applyTysD, isForAllTy, dropForAlls,
45

46 47
        mkNumLitTy, isNumLitTy,
        mkStrLitTy, isStrLitTy,
48 49

        coAxNthLHS,
batterseapower's avatar
batterseapower committed
50 51
	
	-- (Newtypes)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
52
	newTyConInstRhs, carefullySplitNewType_maybe,
batterseapower's avatar
batterseapower committed
53
	
54
	-- Pred types
batterseapower's avatar
batterseapower committed
55 56
        mkFamilyTyConApp,
	isDictLikeTy,
57
        mkEqPred, mkPrimEqPred,
58
        mkClassPred,
59 60
        noParenPred, isClassPred, isEqPred, 
        isIPPred, isIPPred_maybe, isIPTyCon, isIPClass,
61
        
batterseapower's avatar
batterseapower committed
62
        -- Deconstructing predicate types
63
        PredTree(..), classifyPredType,
batterseapower's avatar
batterseapower committed
64 65
        getClassPredTys, getClassPredTys_maybe,
        getEqPredTys, getEqPredTys_maybe,
66

batterseapower's avatar
batterseapower committed
67 68
	-- ** Common type constructors
        funTyCon,
69

batterseapower's avatar
batterseapower committed
70
        -- ** Predicates on types
71
        isTypeVar, isKindVar,
dreixel's avatar
dreixel committed
72
        isTyVarTy, isFunTy, isDictTy, isPredTy, isKindTy,
batterseapower's avatar
batterseapower committed
73 74

	-- (Lifting and boxity)
75
	isUnLiftedType, isUnboxedTupleType, isAlgType, isClosedAlgType,
batterseapower's avatar
batterseapower committed
76
	isPrimitiveType, isStrictType,
77

batterseapower's avatar
batterseapower committed
78 79
	-- * Main data types representing Kinds
	-- $kind_subtyping
dreixel's avatar
dreixel committed
80
        Kind, SimpleKind, MetaKindVar,
batterseapower's avatar
batterseapower committed
81 82 83

        -- ** Finding the kind of a type
        typeKind,
batterseapower's avatar
batterseapower committed
84 85
        
        -- ** Common Kinds and SuperKinds
dreixel's avatar
dreixel committed
86
        anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind,
87
        constraintKind, superKind, 
batterseapower's avatar
batterseapower committed
88 89 90

        -- ** Common Kind type constructors
        liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
91
        constraintKindTyCon, anyKindTyCon,
batterseapower's avatar
batterseapower committed
92 93

	-- * Type free variables
batterseapower's avatar
batterseapower committed
94
	tyVarsOfType, tyVarsOfTypes,
95
	expandTypeSynonyms, 
96
	typeSize, varSetElemsKvsFirst, 
97

batterseapower's avatar
batterseapower committed
98
	-- * Type comparison
99
        eqType, eqTypeX, eqTypes, cmpType, cmpTypes, 
100
	eqPred, eqPredX, cmpPred, eqKind, eqTyVarBndrs,
101

batterseapower's avatar
batterseapower committed
102
	-- * Forcing evaluation of types
batterseapower's avatar
batterseapower committed
103
        seqType, seqTypes,
104

batterseapower's avatar
batterseapower committed
105
        -- * Other views onto Types
106
        coreView, tcView, 
batterseapower's avatar
batterseapower committed
107

108
        UnaryType, RepType(..), flattenRepType, repType,
batterseapower's avatar
batterseapower committed
109 110

	-- * Type representation for the code generator
111
	typePrimRep, typeRepArity,
batterseapower's avatar
batterseapower committed
112 113 114 115 116 117 118 119

	-- * Main type substitution data types
	TvSubstEnv,	-- Representation widely visible
	TvSubst(..), 	-- Representation visible to a few friends
	
	-- ** Manipulating type substitutions
	emptyTvSubstEnv, emptyTvSubst,
	
120
	mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
121 122
        getTvSubstEnv, setTvSubstEnv,
        zapTvSubstEnv, getTvInScope,
123
        extendTvInScope, extendTvInScopeList,
124 125
 	extendTvSubst, extendTvSubstList,
        isInScope, composeTvSubst, zipTyEnv,
126
        isEmptyTvSubst, unionTvSubst,
127

dreixel's avatar
dreixel committed
128
	-- ** Performing substitution on types and kinds
129
	substTy, substTys, substTyWith, substTysWith, substTheta, 
batterseapower's avatar
batterseapower committed
130
        substTyVar, substTyVars, substTyVarBndr,
dreixel's avatar
dreixel committed
131 132
        cloneTyVarBndr, deShadowTy, lookupTyVar,
        substKiWith, substKisWith,
133

batterseapower's avatar
batterseapower committed
134
	-- * Pretty-printing
135
	pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing, 
136
        pprTvBndr, pprTvBndrs, pprForAll, pprSigmaType,
batterseapower's avatar
batterseapower committed
137
	pprEqPred, pprTheta, pprThetaArrowTy, pprClassPred, 
dreixel's avatar
dreixel committed
138
        pprKind, pprParendKind, pprSourceTyCon,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
139 140 141 142 143 144 145 146 147 148

        -- * Tidying type related things up for printing
        tidyType,      tidyTypes,
        tidyOpenType,  tidyOpenTypes,
        tidyOpenKind,
        tidyTyVarBndr, tidyTyVarBndrs, tidyFreeTyVars,
        tidyOpenTyVar, tidyOpenTyVars,
        tidyTyVarOcc,
        tidyTopType,
        tidyKind, 
149
    ) where
150

151 152
#include "HsVersions.h"

153 154 155
-- We import the representation and primitive functions from TypeRep.
-- Many things are reexported, but not the representation!

dreixel's avatar
dreixel committed
156
import Kind
157 158
import TypeRep

159
-- friends:
160
import Var
161 162 163
import VarEnv
import VarSet

164 165
import Class
import TyCon
166
import TysPrim
167
import {-# SOURCE #-} TysWiredIn ( eqTyCon, typeNatKind, typeSymbolKind )
168 169
import PrelNames ( eqTyConKey, ipClassNameKey, 
                   constraintKindTyConKey, liftedTypeKindTyConKey )
170
import CoAxiom
171

172
-- others
173
import Unique		( Unique, hasKey )
174
import BasicTypes	( Arity, RepArity )
Simon Peyton Jones's avatar
Simon Peyton Jones committed
175
import NameSet
176 177
import StaticFlags
import Util
178
import Outputable
179
import FastString
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
180

181
import Data.List        ( partition )
182
import Maybes		( orElse )
183
import Data.Maybe	( isJust )
184
import Control.Monad    ( guard )
185 186

infixr 3 `mkFunTy`	-- Associates to the right
187 188
\end{code}

batterseapower's avatar
batterseapower committed
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 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237
\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
batterseapower's avatar
batterseapower committed
238
-- passes and the rest of the back end is concerned.
batterseapower's avatar
batterseapower committed
239 240 241 242 243 244
--
-- 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}
245

246 247 248 249 250 251 252 253 254
%************************************************************************
%*									*
		Type representation
%*									*
%************************************************************************

\begin{code}
{-# INLINE coreView #-}
coreView :: Type -> Maybe Type
batterseapower's avatar
batterseapower committed
255 256 257 258
-- ^ 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 
259 260 261
-- its underlying representation type. 
-- Returns Nothing if there is nothing to look through.
--
262 263 264
-- By being non-recursive and inlined, this case analysis gets efficiently
-- joined onto the case analysis that the caller is already doing
coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- coreExpandTyCon_maybe tc tys 
batterseapower's avatar
batterseapower committed
265 266 267 268
              = 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!
269
coreView _                 = Nothing
270 271 272 273

-----------------------------------------------
{-# INLINE tcView #-}
tcView :: Type -> Maybe Type
batterseapower's avatar
batterseapower committed
274
-- ^ Similar to 'coreView', but for the type checker, which just looks through synonyms
275 276
tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- tcExpandTyCon_maybe tc tys 
			 = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
277
tcView _                 = Nothing
278 279 280
  -- You might think that tcView belows in TcType rather than Type, but unfortunately
  -- it is needed by Unify, which is turn imported by Coercion (for MatchEnv and matchList).
  -- So we will leave it here to avoid module loops.
281

282 283 284 285 286 287 288 289 290 291 292 293 294
-----------------------------------------------
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)
295
    go (LitTy l)       = LitTy l
296
    go (TyVarTy tv)    = TyVarTy tv
297
    go (AppTy t1 t2)   = mkAppTy (go t1) (go t2)
298 299
    go (FunTy t1 t2)   = FunTy (go t1) (go t2)
    go (ForAllTy tv t) = ForAllTy tv (go t)
300 301 302
\end{code}


303 304 305 306 307
%************************************************************************
%*									*
\subsection{Constructor-specific functions}
%*									*
%************************************************************************
sof's avatar
sof committed
308 309


310 311 312
---------------------------------------------------------------------
				TyVarTy
				~~~~~~~
313
\begin{code}
batterseapower's avatar
batterseapower committed
314 315
-- | 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'
316
getTyVar :: String -> Type -> TyVar
317 318 319
getTyVar msg ty = case getTyVar_maybe ty of
		    Just tv -> tv
		    Nothing -> panic ("getTyVar: " ++ msg)
320

321
isTyVarTy :: Type -> Bool
322 323
isTyVarTy ty = isJust (getTyVar_maybe ty)

batterseapower's avatar
batterseapower committed
324
-- | Attempts to obtain the type variable underlying a 'Type'
325
getTyVar_maybe :: Type -> Maybe TyVar
326 327
getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
getTyVar_maybe (TyVarTy tv) 	 	    = Just tv  
328
getTyVar_maybe _                            = Nothing
329

330 331 332
\end{code}


333 334 335 336 337 338
---------------------------------------------------------------------
				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.
339

340
\begin{code}
batterseapower's avatar
batterseapower committed
341
-- | Applies a type to another, as in e.g. @k a@
342
mkAppTy :: Type -> Type -> Type
343 344
mkAppTy (TyConApp tc tys) ty2 = mkTyConApp tc (tys ++ [ty2])
mkAppTy ty1               ty2 = AppTy ty1 ty2
345
	-- Note that the TyConApp could be an 
346 347 348 349 350 351 352
	-- 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
353

354
mkAppTys :: Type -> [Type] -> Type
355 356 357 358 359 360 361 362
mkAppTys ty1                []	 = ty1
mkAppTys (TyConApp tc tys1) tys2 = mkTyConApp tc (tys1 ++ tys2)
mkAppTys ty1                tys2 = foldl AppTy ty1 tys2

mkNakedAppTys :: Type -> [Type] -> Type
mkNakedAppTys ty1           []	 = ty1
mkNakedAppTys (TyConApp tc tys1) tys2 = mkNakedTyConApp tc (tys1 ++ tys2)
mkNakedAppTys ty1                tys2 = foldl AppTy ty1 tys2
363

364
-------------
365
splitAppTy_maybe :: Type -> Maybe (Type, Type)
batterseapower's avatar
batterseapower committed
366 367 368
-- ^ 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!
369 370 371
splitAppTy_maybe ty | Just ty' <- coreView ty
		    = splitAppTy_maybe ty'
splitAppTy_maybe ty = repSplitAppTy_maybe ty
372

373 374
-------------
repSplitAppTy_maybe :: Type -> Maybe (Type,Type)
batterseapower's avatar
batterseapower committed
375 376
-- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that 
-- any Core view stuff is already done
377 378
repSplitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
repSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
379
repSplitAppTy_maybe (TyConApp tc tys) 
380 381 382
  | isDecomposableTyCon tc || tys `lengthExceeds` tyConArity tc 
  , Just (tys', ty') <- snocView tys
  = Just (TyConApp tc tys', ty')    -- Never create unsaturated type family apps!
383
repSplitAppTy_maybe _other = Nothing
384
-------------
385
splitAppTy :: Type -> (Type, Type)
batterseapower's avatar
batterseapower committed
386 387
-- ^ Attempts to take a type application apart, as in 'splitAppTy_maybe',
-- and panics if this is not possible
388 389 390
splitAppTy ty = case splitAppTy_maybe ty of
			Just pr -> pr
			Nothing -> panic "splitAppTy"
391

392
-------------
393
splitAppTys :: Type -> (Type, [Type])
batterseapower's avatar
batterseapower committed
394 395 396
-- ^ 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.
397
splitAppTys ty = split ty ty []
398
  where
399
    split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args
400 401
    split _       (AppTy ty arg)        args = split ty ty (arg:args)
    split _       (TyConApp tc tc_args) args
402
      = let -- keep type families saturated
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
403 404
            n | isDecomposableTyCon tc = 0
              | otherwise              = tyConArity tc
405
            (tc_args1, tc_args2) = splitAt n tc_args
406 407
        in
        (TyConApp tc tc_args1, tc_args2 ++ args)
408
    split _       (FunTy ty1 ty2)       args = ASSERT( null args )
409
					       (TyConApp funTyCon [], [ty1,ty2])
410
    split orig_ty _                     args = (orig_ty, args)
411

412 413
\end{code}

414

415
                      LitTy
416
                      ~~~~~
417 418

\begin{code}
419 420
mkNumLitTy :: Integer -> Type
mkNumLitTy n = LitTy (NumTyLit n)
421

422 423 424
isNumLitTy :: Type -> Maybe Integer
isNumLitTy (LitTy (NumTyLit n)) = Just n
isNumLitTy _                    = Nothing
425

426 427 428 429 430 431
mkStrLitTy :: FastString -> Type
mkStrLitTy s = LitTy (StrTyLit s)

isStrLitTy :: Type -> Maybe FastString
isStrLitTy (LitTy (StrTyLit s)) = Just s
isStrLitTy _                    = Nothing
432 433 434 435

\end{code}


436 437 438 439
---------------------------------------------------------------------
				FunTy
				~~~~~

440
\begin{code}
441
mkFunTy :: Type -> Type -> Type
batterseapower's avatar
batterseapower committed
442
-- ^ Creates a function type from the given argument and result type
443
mkFunTy arg res = FunTy arg res
444

445
mkFunTys :: [Type] -> Type -> Type
446
mkFunTys tys ty = foldr mkFunTy ty tys
447

448 449 450
isFunTy :: Type -> Bool 
isFunTy ty = isJust (splitFunTy_maybe ty)

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

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

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

471
splitFunTysN :: Int -> Type -> ([Type], Type)
batterseapower's avatar
batterseapower committed
472
-- ^ Split off exactly the given number argument types, and panics if that is not possible
473
splitFunTysN 0 ty = ([], ty)
simonpj@microsoft.com's avatar
Assert  
simonpj@microsoft.com committed
474 475
splitFunTysN n ty = ASSERT2( isFunTy ty, int n <+> ppr ty )
                    case splitFunTy ty of { (arg, res) ->
476 477 478
		    case splitFunTysN (n-1) res of { (args, res) ->
		    (arg:args, res) }}

batterseapower's avatar
batterseapower committed
479 480 481 482 483 484
-- | 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)
485 486
zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
  where
487
    split acc []     nty _                 = (reverse acc, nty)
488 489
    split acc xs     nty ty 
	  | Just ty' <- coreView ty 	   = split acc xs nty ty'
490 491
    split acc (x:xs) _   (FunTy arg res)   = split ((x,arg):acc) xs res res
    split _   _      _   _                 = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
492 493
    
funResultTy :: Type -> Type
batterseapower's avatar
batterseapower committed
494
-- ^ Extract the function result type and panic if that is not possible
495
funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
496 497
funResultTy (FunTy _arg res)  = res
funResultTy ty                = pprPanic "funResultTy" (ppr ty)
498 499

funArgTy :: Type -> Type
batterseapower's avatar
batterseapower committed
500
-- ^ Extract the function argument type and panic if that is not possible
501
funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
502 503
funArgTy (FunTy arg _res)  = arg
funArgTy ty                = pprPanic "funArgTy" (ppr ty)
504 505
\end{code}

506 507 508
---------------------------------------------------------------------
				TyConApp
				~~~~~~~~
509

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

  | otherwise
  = TyConApp tycon tys

521 522 523 524
-- 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
525
-- | The same as @fst . splitTyConApp@
526 527 528 529 530 531
tyConAppTyCon_maybe :: Type -> Maybe TyCon
tyConAppTyCon_maybe ty | Just ty' <- coreView ty = tyConAppTyCon_maybe ty'
tyConAppTyCon_maybe (TyConApp tc _) = Just tc
tyConAppTyCon_maybe (FunTy {})      = Just funTyCon
tyConAppTyCon_maybe _               = Nothing

532
tyConAppTyCon :: Type -> TyCon
533
tyConAppTyCon ty = tyConAppTyCon_maybe ty `orElse` pprPanic "tyConAppTyCon" (ppr ty)
534

batterseapower's avatar
batterseapower committed
535
-- | The same as @snd . splitTyConApp@
536 537 538 539 540 541 542
tyConAppArgs_maybe :: Type -> Maybe [Type]
tyConAppArgs_maybe ty | Just ty' <- coreView ty = tyConAppArgs_maybe ty'
tyConAppArgs_maybe (TyConApp _ tys) = Just tys
tyConAppArgs_maybe (FunTy arg res)  = Just [arg,res]
tyConAppArgs_maybe _                = Nothing


543
tyConAppArgs :: Type -> [Type]
544
tyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic "tyConAppArgs" (ppr ty)
545

546 547 548 549 550 551 552
tyConAppArgN :: Int -> Type -> Type
-- Executing Nth
tyConAppArgN n ty 
  = case tyConAppArgs_maybe ty of
      Just tys -> ASSERT2( n < length tys, ppr n <+> ppr tys ) tys !! n
      Nothing  -> pprPanic "tyConAppArgN" (ppr n <+> ppr ty)

batterseapower's avatar
batterseapower committed
553 554 555
-- | 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'
556 557 558
splitTyConApp :: Type -> (TyCon, [Type])
splitTyConApp ty = case splitTyConApp_maybe ty of
			Just stuff -> stuff
559
			Nothing	   -> pprPanic "splitTyConApp" (ppr ty)
560

batterseapower's avatar
batterseapower committed
561 562
-- | Attempts to tease a type apart into a type constructor and the application
-- of a number of arguments to that constructor
563
splitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
564
splitTyConApp_maybe ty | Just ty' <- coreView ty = splitTyConApp_maybe ty'
565
splitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
566
splitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
567
splitTyConApp_maybe _                 = Nothing
568

569
newTyConInstRhs :: TyCon -> [Type] -> Type
570
-- ^ Unwrap one 'layer' of newtype on a type constructor and its arguments, using an 
batterseapower's avatar
batterseapower committed
571
-- eta-reduced version of the @newtype@ if possible
572 573 574 575 576 577
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
578
\end{code}
579

580

581 582 583 584 585 586 587 588
---------------------------------------------------------------------
				SynTy
				~~~~~

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

590 591 592 593 594 595 596 597
	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.
598 599


600 601 602 603 604 605 606 607 608 609 610 611 612 613 614 615 616 617 618 619 620 621 622 623 624
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.


625 626
		Representation types
		~~~~~~~~~~~~~~~~~~~~
627

628 629
Note [Nullary unboxed tuple]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
630 631 632 633 634 635 636 637
We represent the nullary unboxed tuple as the unary (but void) type
State# RealWorld.  The reason for this is that the ReprArity is never
less than the Arity (as it would otherwise be for a function type like
(# #) -> Int).

As a result, ReprArity is always strictly positive if Arity is. This
is important because it allows us to distinguish at runtime between a
thunk and a function takes a nullary unboxed tuple as an argument!
638

639
\begin{code}
640 641 642 643 644 645 646 647 648
type UnaryType = Type

data RepType = UbxTupleRep [UnaryType] -- INVARIANT: never an empty list (see Note [Nullary unboxed tuple])
             | UnaryRep UnaryType

flattenRepType :: RepType -> [UnaryType]
flattenRepType (UbxTupleRep tys) = tys
flattenRepType (UnaryRep ty)     = [ty]

batterseapower's avatar
batterseapower committed
649 650 651 652 653
-- | Looks through:
--
--	1. For-alls
--	2. Synonyms
--	3. Predicates
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
654
--	4. All newtypes, including recursive ones, but not newtype families
batterseapower's avatar
batterseapower committed
655 656
--
-- It's useful in the back end of the compiler.
657
repType :: Type -> RepType
658
repType ty
Simon Peyton Jones's avatar
Simon Peyton Jones committed
659
  = go emptyNameSet ty
660
  where
661
    go :: NameSet -> Type -> RepType
Simon Peyton Jones's avatar
Simon Peyton Jones committed
662 663 664
    go rec_nts ty    	  		-- Expand predicates and synonyms
      | Just ty' <- coreView ty
      = go rec_nts ty'
665

Simon Peyton Jones's avatar
Simon Peyton Jones committed
666 667
    go rec_nts (ForAllTy _ ty)		-- Drop foralls
	= go rec_nts ty
668

Simon Peyton Jones's avatar
Simon Peyton Jones committed
669
    go rec_nts (TyConApp tc tys)	-- Expand newtypes
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
670 671
      | Just (rec_nts', ty') <- carefullySplitNewType_maybe rec_nts tc tys
      = go rec_nts' ty'
672

673 674 675 676
      | isUnboxedTupleTyCon tc
      = if null tys
         then UnaryRep realWorldStatePrimTy -- See Note [Nullary unboxed tuple]
         else UbxTupleRep (concatMap (flattenRepType . go rec_nts) tys)
677

678
    go _ ty = UnaryRep ty
679

Simon Peyton Jones's avatar
Simon Peyton Jones committed
680
carefullySplitNewType_maybe :: NameSet -> TyCon -> [Type] -> Maybe (NameSet,Type)
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
681 682
-- Return the representation of a newtype, unless 
-- we've seen it already: see Note [Expanding newtypes]
Simon Peyton Jones's avatar
Simon Peyton Jones committed
683
-- Assumes the newtype is saturated
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
684 685
carefullySplitNewType_maybe rec_nts tc tys
  | isNewTyCon tc
Simon Peyton Jones's avatar
Simon Peyton Jones committed
686 687 688
  , tys `lengthAtLeast` tyConArity tc
  , not (tc_name `elemNameSet` rec_nts) = Just (rec_nts', newTyConInstRhs tc tys)
  | otherwise	   	                = Nothing
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
689
  where
Simon Peyton Jones's avatar
Simon Peyton Jones committed
690 691
    tc_name = tyConName tc
    rec_nts' | isRecursiveTyCon tc = addOneToNameSet rec_nts tc_name
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
692 693 694
	     | otherwise	   = rec_nts


695 696
-- ToDo: this could be moved to the code generator, using splitTyConApp instead
-- of inspecting the type directly.
batterseapower's avatar
batterseapower committed
697

698 699 700 701 702 703 704 705 706 707 708 709 710 711 712 713 714
-- | Discovers the primitive representation of a more abstract 'UnaryType'
typePrimRep :: UnaryType -> PrimRep
typePrimRep ty
  = case repType ty of
      UbxTupleRep _ -> pprPanic "typePrimRep: UbxTupleRep" (ppr ty)
      UnaryRep rep -> case rep of
        TyConApp tc _ -> tyConPrimRep tc
        FunTy _ _     -> PtrRep
        AppTy _ _     -> PtrRep      -- See Note [AppTy rep] 
        TyVarTy _     -> PtrRep
        _             -> pprPanic "typePrimRep: UnaryRep" (ppr ty)

typeRepArity :: Arity -> Type -> RepArity
typeRepArity 0 _ = 0
typeRepArity n ty = case repType ty of
  UnaryRep (FunTy ty1 ty2) -> length (flattenRepType (repType ty1)) + typeRepArity (n - 1) ty2
  _                        -> pprPanic "typeRepArity: arity greater than type can handle" (ppr (n, ty))
715 716
\end{code}

717 718 719 720 721 722
Note [AppTy rep]
~~~~~~~~~~~~~~~~
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 (kk -> kk) and kk cannot be unlifted; see Note [The kind invariant] 
in TypeRep.
723

724 725 726
---------------------------------------------------------------------
				ForAllTy
				~~~~~~~~
727 728

\begin{code}
729
mkForAllTy :: TyVar -> Type -> Type
730
mkForAllTy tyvar ty
731
  = ForAllTy tyvar ty
732

batterseapower's avatar
batterseapower committed
733
-- | Wraps foralls over the type using the provided 'TyVar's from left to right
734
mkForAllTys :: [TyVar] -> Type -> Type
735
mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
736

737 738
mkPiKinds :: [TyVar] -> Kind -> Kind
-- mkPiKinds [k1, k2, (a:k1 -> *)] k2
dreixel's avatar
dreixel committed
739
-- returns forall k1 k2. (k1 -> *) -> k2
740 741
mkPiKinds [] res = res
mkPiKinds (tv:tvs) res 
742 743
  | isKindVar tv = ForAllTy tv          (mkPiKinds tvs res)
  | otherwise    = FunTy (tyVarKind tv) (mkPiKinds tvs res)
744 745 746 747 748 749 750 751 752 753 754 755

mkPiType  :: Var -> Type -> Type
-- ^ Makes a @(->)@ type or a forall type, depending
-- on whether it is given a type variable or a term variable.
mkPiTypes :: [Var] -> Type -> Type
-- ^ 'mkPiType' for multiple type or value arguments

mkPiType v ty
   | isId v    = mkFunTy (varType v) ty
   | otherwise = mkForAllTy v ty

mkPiTypes vs ty = foldr mkPiType ty vs
dreixel's avatar
dreixel committed
756

757 758
isForAllTy :: Type -> Bool
isForAllTy (ForAllTy _ _) = True
759
isForAllTy _              = False
760

batterseapower's avatar
batterseapower committed
761 762
-- | Attempts to take a forall type apart, returning the bound type variable
-- and the remainder of the type
763
splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
764
splitForAllTy_maybe ty = splitFAT_m ty
765
  where
766 767 768
    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
769

batterseapower's avatar
batterseapower committed
770 771 772
-- | 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
773
splitForAllTys :: Type -> ([TyVar], Type)
774
splitForAllTys ty = split ty ty []
775
   where
776
     split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
777 778
     split _       (ForAllTy tv ty)  tvs = split ty ty (tv:tvs)
     split orig_ty _                 tvs = (reverse tvs, orig_ty)
779

batterseapower's avatar
batterseapower committed
780
-- | Equivalent to @snd . splitForAllTys@
781 782
dropForAlls :: Type -> Type
dropForAlls ty = snd (splitForAllTys ty)
783 784
\end{code}

785
-- (mkPiType now in CoreUtils)
786

787 788
applyTy, applyTys
~~~~~~~~~~~~~~~~~
789

790
\begin{code}
batterseapower's avatar
batterseapower committed
791 792 793 794 795 796 797
-- | 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.
dreixel's avatar
dreixel committed
798
applyTy :: Type -> KindOrType -> Type
799 800
applyTy ty arg | Just ty' <- coreView ty = applyTy ty' arg
applyTy (ForAllTy tv ty) arg = substTyWith [tv] [arg] ty
801
applyTy _                _   = panic "applyTy"
802

dreixel's avatar
dreixel committed
803
applyTys :: Type -> [KindOrType] -> Type
batterseapower's avatar
batterseapower committed
804 805 806 807 808 809 810 811 812 813
-- ^ 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]
--
dreixel's avatar
dreixel committed
814 815 816 817 818 819
-- This really can happen, but only (I think) in situations involving
-- undefined.  For example:
--       undefined :: forall a. a
-- Term: undefined @(forall b. b->b) @Int 
-- This term should have type (Int -> Int), but notice that
-- there are more type args than foralls in 'undefined's type.
820

821 822
-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism] in coreSyn/CoreLint.lhs
823 824 825 826 827
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 
828 829 830 831 832 833
  | 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
834
  = ASSERT2( n_tvs > 0, doc $$ ppr orig_fun_ty )	-- Zero case gives infnite loop!
835 836
    applyTysD doc (substTyWith tvs (take n_tvs arg_tys) rho_ty)
	          (drop n_tvs arg_tys)
837 838 839 840
  where
    (tvs, rho_ty) = splitForAllTys orig_fun_ty 
    n_tvs = length tvs
    n_args = length arg_tys     
841
\end{code}
842

843

844 845
%************************************************************************
%*									*
846
                         Pred
847 848
%*									*
%************************************************************************
849

batterseapower's avatar
batterseapower committed
850
Predicates on PredType
851

852
\begin{code}
batterseapower's avatar
batterseapower committed
853 854 855 856 857
noParenPred :: PredType -> Bool
-- A predicate that can appear without parens before a "=>"
--       C a => a -> a
--       a~b => a -> b
-- But   (?x::Int) => Int -> Int
858
noParenPred p = not (isIPPred p) && isClassPred p || isEqPred p
batterseapower's avatar
batterseapower committed
859

860
isPredTy :: Type -> Bool
dreixel's avatar
dreixel committed
861 862
isPredTy ty
  | isSuperKind ty = False
863
  | otherwise = isConstraintKind (typeKind ty)
dreixel's avatar
dreixel committed
864 865 866

isKindTy :: Type -> Bool
isKindTy = isSuperKind . typeKind
867

batterseapower's avatar
batterseapower committed
868 869 870 871 872 873 874
isClassPred, isEqPred, isIPPred :: PredType -> Bool
isClassPred ty = case tyConAppTyCon_maybe ty of
    Just tyCon | isClassTyCon tyCon -> True
    _                               -> False
isEqPred ty = case tyConAppTyCon_maybe ty of
    Just tyCon -> tyCon `hasKey` eqTyConKey
    _          -> False
875

batterseapower's avatar
batterseapower committed
876
isIPPred ty = case tyConAppTyCon_maybe ty of
877 878 879 880 881 882 883 884 885
    Just tc -> isIPTyCon tc
    _       -> False

isIPTyCon :: TyCon -> Bool
isIPTyCon tc = tc `hasKey` ipClassNameKey

isIPClass :: Class -> Bool
isIPClass cls = cls `hasKey` ipClassNameKey
  -- Class and it corresponding TyCon have the same Unique
886 887 888 889

isIPPred_maybe :: Type -> Maybe (FastString, Type)
isIPPred_maybe ty =
  do (tc,[t1,t2]) <- splitTyConApp_maybe ty
890
     guard (isIPTyCon tc)
891 892
     x <- isStrLitTy t1
     return (x,t2)
893 894 895
\end{code}

Make PredTypes
896

897 898 899
--------------------- Equality types ---------------------------------
\begin{code}
-- | Creates a type equality predicate
900 901
mkEqPred :: Type -> Type -> PredType
mkEqPred ty1 ty2
902
  = WARN( not (k `eqKind` typeKind ty2), ppr ty1 $$ ppr ty2 $$ ppr k $$ ppr (typeKind ty2) )
dreixel's avatar
dreixel committed
903
    TyConApp eqTyCon [k, ty1, ty2]
904 905
  where 
    k = typeKind ty1
batterseapower's avatar
batterseapower committed
906

907 908 909
mkPrimEqPred :: Type -> Type -> Type
mkPrimEqPred ty1  ty2
  = WARN( not (k `eqKind` typeKind ty2), ppr ty1 $$ ppr ty2 )
dreixel's avatar
dreixel committed
910
    TyConApp eqPrimTyCon [k, ty1, ty2]
911 912
  where 
    k = typeKind ty1
913
\end{code}
914

915
--------------------- Dictionary types ---------------------------------
916
\begin{code}
917
mkClassPred :: Class -> [Type] -> PredType
batterseapower's avatar
batterseapower committed
918
mkClassPred clas tys = TyConApp (classTyCon clas) tys
919

920
isDictTy :: Type -> Bool
batterseapower's avatar
batterseapower committed
921
isDictTy = isClassPred
922

923 924
isDictLikeTy :: Type -> Bool
-- Note [Dictionary-like types]
925 926 927 928 929
isDictLikeTy ty | Just ty' <- coreView ty = isDictLikeTy ty'
isDictLikeTy ty = case splitTyConApp_maybe ty of
	Just (tc, tys) | isClassTyCon tc -> True
	 			   | isTupleTyCon tc -> all isDictLikeTy tys
	_other                           -> False
930
\end{code}
931

932 933 934 935 936 937 938 939 940 941 942 943 944 945 946 947 948 949 950 951 952 953 954 955 956 957 958 959 960
Note [Dictionary-like types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Being "dictionary-like" means either a dictionary type or a tuple thereof.
In GHC 6.10 we build implication constraints which construct such tuples,
and if we land up with a binding
    t :: (C [a], Eq [a])
    t = blah
then we want to treat t as cheap under "-fdicts-cheap" for example.
(Implication constraints are normally inlined, but sadly not if the
occurrence is itself inside an INLINE function!  Until we revise the 
handling of implication constraints, that is.)  This turned out to
be important in getting good arities in DPH code.  Example:

    class C a
    class D a where { foo :: a -> a }
    instance C a => D (Maybe a) where { foo x = x }

    bar :: (C a, C b) => a -> b -> (Maybe a, Maybe b)
    {-# INLINE bar #-}
    bar x y = (foo (Just x), foo (Just y))

Then 'bar' should jolly well have arity 4 (two dicts, two args), but
we ended up with something like
   bar = __inline_me__ (\d1,d2. let t :: (D (Maybe a), D (Maybe b)) = ...
                                in \x,y. <blah>)

This is all a bit ad-hoc; eg it relies on knowing that implication
constraints build tuples.

batterseapower's avatar
batterseapower committed
961 962 963 964 965 966

Decomposing PredType

\begin{code}
data PredTree = ClassPred Class [Type]
              | EqPred Type Type
967
              | TuplePred [PredType]
batterseapower's avatar
batterseapower committed
968 969
              | IrredPred PredType