Type.hs 64.2 KB
Newer Older
1 2 3 4
-- (c) The University of Glasgow 2006
-- (c) The GRASP/AQUA Project, Glasgow University, 1998
--
-- Type - public interface
5

6
{-# LANGUAGE CPP #-}
7
{-# OPTIONS_GHC -fno-warn-orphans #-}
Ian Lynagh's avatar
Ian Lynagh committed
8

batterseapower's avatar
batterseapower committed
9
-- | Main functions for manipulating types and type-related things
10
module Type (
ian@well-typed.com's avatar
ian@well-typed.com committed
11
        -- Note some of this is just re-exports from TyCon..
12

batterseapower's avatar
batterseapower committed
13
        -- * Main data types representing Types
ian@well-typed.com's avatar
ian@well-typed.com committed
14 15
        -- $type_classification

batterseapower's avatar
batterseapower committed
16
        -- $representation_types
dreixel's avatar
dreixel committed
17
        TyThing(..), Type, KindOrType, PredType, ThetaType,
ian@well-typed.com's avatar
ian@well-typed.com committed
18
        Var, TyVar, isTyVar,
19

batterseapower's avatar
batterseapower committed
20 21
        -- ** Constructing and deconstructing types
        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe,
22

23
        mkAppTy, mkAppTys, splitAppTy, splitAppTys,
ian@well-typed.com's avatar
ian@well-typed.com committed
24
        splitAppTy_maybe, repSplitAppTy_maybe,
25

ian@well-typed.com's avatar
ian@well-typed.com committed
26 27 28
        mkFunTy, mkFunTys, splitFunTy, splitFunTy_maybe,
        splitFunTys, splitFunTysN,
        funResultTy, funArgTy, zipFunTys,
29

ian@well-typed.com's avatar
ian@well-typed.com committed
30 31
        mkTyConApp, mkTyConTy,
        tyConAppTyCon_maybe, tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs,
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
32
        splitTyConApp_maybe, splitTyConApp, tyConAppArgN, nextRole,
33

ian@well-typed.com's avatar
ian@well-typed.com committed
34
        mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
35
        mkPiKinds, mkPiType, mkPiTypes,
36
        applyTy, applyTys, applyTysD, applyTysX, dropForAlls,
37

38 39
        mkNumLitTy, isNumLitTy,
        mkStrLitTy, isStrLitTy,
40 41

        coAxNthLHS,
ian@well-typed.com's avatar
ian@well-typed.com committed
42 43 44 45 46

        -- (Newtypes)
        newTyConInstRhs,

        -- Pred types
batterseapower's avatar
batterseapower committed
47
        mkFamilyTyConApp,
ian@well-typed.com's avatar
ian@well-typed.com committed
48
        isDictLikeTy,
Joachim Breitner's avatar
Joachim Breitner committed
49
        mkEqPred, mkCoerciblePred, mkPrimEqPred, mkReprPrimEqPred,
50
        mkClassPred,
51
        isClassPred, isEqPred,
52
        isIPPred, isIPPred_maybe, isIPTyCon, isIPClass,
ian@well-typed.com's avatar
ian@well-typed.com committed
53

batterseapower's avatar
batterseapower committed
54
        -- Deconstructing predicate types
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
55
        PredTree(..), EqRel(..), eqRelRole, classifyPredType,
batterseapower's avatar
batterseapower committed
56
        getClassPredTys, getClassPredTys_maybe,
Joachim Breitner's avatar
Joachim Breitner committed
57
        getEqPredTys, getEqPredTys_maybe, getEqPredRole,
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
58
        predTypeEqRel,
59

ian@well-typed.com's avatar
ian@well-typed.com committed
60
        -- ** Common type constructors
batterseapower's avatar
batterseapower committed
61
        funTyCon,
62

batterseapower's avatar
batterseapower committed
63
        -- ** Predicates on types
64
        isTypeVar, isKindVar, allDistinctTyVars, isForAllTy,
65
        isTyVarTy, isFunTy, isDictTy, isPredTy, isVoidTy,
batterseapower's avatar
batterseapower committed
66

ian@well-typed.com's avatar
ian@well-typed.com committed
67 68 69
        -- (Lifting and boxity)
        isUnLiftedType, isUnboxedTupleType, isAlgType, isClosedAlgType,
        isPrimitiveType, isStrictType,
70

ian@well-typed.com's avatar
ian@well-typed.com committed
71 72
        -- * Main data types representing Kinds
        -- $kind_subtyping
dreixel's avatar
dreixel committed
73
        Kind, SimpleKind, MetaKindVar,
batterseapower's avatar
batterseapower committed
74 75 76

        -- ** Finding the kind of a type
        typeKind,
ian@well-typed.com's avatar
ian@well-typed.com committed
77

batterseapower's avatar
batterseapower committed
78
        -- ** Common Kinds and SuperKinds
dreixel's avatar
dreixel committed
79
        anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind,
ian@well-typed.com's avatar
ian@well-typed.com committed
80
        constraintKind, superKind,
batterseapower's avatar
batterseapower committed
81 82 83

        -- ** Common Kind type constructors
        liftedTypeKindTyCon, openTypeKindTyCon, unliftedTypeKindTyCon,
84
        constraintKindTyCon, anyKindTyCon,
batterseapower's avatar
batterseapower committed
85

ian@well-typed.com's avatar
ian@well-typed.com committed
86
        -- * Type free variables
87
        tyVarsOfType, tyVarsOfTypes, closeOverKinds,
ian@well-typed.com's avatar
ian@well-typed.com committed
88 89
        expandTypeSynonyms,
        typeSize, varSetElemsKvsFirst,
90

ian@well-typed.com's avatar
ian@well-typed.com committed
91 92 93
        -- * Type comparison
        eqType, eqTypeX, eqTypes, cmpType, cmpTypes,
        eqPred, eqPredX, cmpPred, eqKind, eqTyVarBndrs,
94

ian@well-typed.com's avatar
ian@well-typed.com committed
95
        -- * Forcing evaluation of types
batterseapower's avatar
batterseapower committed
96
        seqType, seqTypes,
97

batterseapower's avatar
batterseapower committed
98
        -- * Other views onto Types
ian@well-typed.com's avatar
ian@well-typed.com committed
99
        coreView, tcView,
batterseapower's avatar
batterseapower committed
100

101
        UnaryType, RepType(..), flattenRepType, repType,
102
        tyConsOfType,
batterseapower's avatar
batterseapower committed
103

ian@well-typed.com's avatar
ian@well-typed.com committed
104 105 106 107 108 109 110 111 112 113 114
        -- * Type representation for the code generator
        typePrimRep, typeRepArity,

        -- * Main type substitution data types
        TvSubstEnv,     -- Representation widely visible
        TvSubst(..),    -- Representation visible to a few friends

        -- ** Manipulating type substitutions
        emptyTvSubstEnv, emptyTvSubst,

        mkTvSubst, mkOpenTvSubst, zipOpenTvSubst, zipTopTvSubst, mkTopTvSubst, notElemTvSubst,
115 116
        getTvSubstEnv, setTvSubstEnv,
        zapTvSubstEnv, getTvInScope,
117
        extendTvInScope, extendTvInScopeList,
ian@well-typed.com's avatar
ian@well-typed.com committed
118
        extendTvSubst, extendTvSubstList,
119
        isInScope, composeTvSubst, zipTyEnv,
120
        isEmptyTvSubst, unionTvSubst,
121

ian@well-typed.com's avatar
ian@well-typed.com committed
122 123
        -- ** Performing substitution on types and kinds
        substTy, substTys, substTyWith, substTysWith, substTheta,
batterseapower's avatar
batterseapower committed
124
        substTyVar, substTyVars, substTyVarBndr,
dreixel's avatar
dreixel committed
125 126
        cloneTyVarBndr, deShadowTy, lookupTyVar,
        substKiWith, substKisWith,
127

ian@well-typed.com's avatar
ian@well-typed.com committed
128 129
        -- * Pretty-printing
        pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing,
130
        pprTvBndr, pprTvBndrs, pprForAll, pprUserForAll, pprSigmaType,
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
131
        pprTheta, pprThetaArrowTy, pprClassPred,
dreixel's avatar
dreixel committed
132
        pprKind, pprParendKind, pprSourceTyCon,
thomasw's avatar
thomasw committed
133
        TyPrec(..), maybeParen, pprSigmaTypeExtraCts,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
134 135 136 137 138 139 140 141 142

        -- * Tidying type related things up for printing
        tidyType,      tidyTypes,
        tidyOpenType,  tidyOpenTypes,
        tidyOpenKind,
        tidyTyVarBndr, tidyTyVarBndrs, tidyFreeTyVars,
        tidyOpenTyVar, tidyOpenTyVars,
        tidyTyVarOcc,
        tidyTopType,
ian@well-typed.com's avatar
ian@well-typed.com committed
143
        tidyKind,
144
    ) where
145

146 147
#include "HsVersions.h"

148 149 150
-- We import the representation and primitive functions from TypeRep.
-- Many things are reexported, but not the representation!

dreixel's avatar
dreixel committed
151
import Kind
152 153
import TypeRep

154
-- friends:
155
import Var
156 157
import VarEnv
import VarSet
158
import NameEnv
159

160 161
import Class
import TyCon
162
import TysPrim
Joachim Breitner's avatar
Joachim Breitner committed
163
import {-# SOURCE #-} TysWiredIn ( eqTyCon, coercibleTyCon, typeNatKind, typeSymbolKind )
Joachim Breitner's avatar
Joachim Breitner committed
164 165
import PrelNames ( eqTyConKey, coercibleTyConKey,
                   ipClassNameKey, openTypeKindTyConKey,
166
                   constraintKindTyConKey, liftedTypeKindTyConKey )
167
import CoAxiom
168

169
-- others
ian@well-typed.com's avatar
ian@well-typed.com committed
170 171
import Unique           ( Unique, hasKey )
import BasicTypes       ( Arity, RepArity )
172
import Util
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
173
import ListSetOps       ( getNth )
174
import Outputable
175
import FastString
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
176

ian@well-typed.com's avatar
ian@well-typed.com committed
177 178
import Maybes           ( orElse )
import Data.Maybe       ( isJust )
179
import Control.Monad    ( guard )
180

ian@well-typed.com's avatar
ian@well-typed.com committed
181
infixr 3 `mkFunTy`      -- Associates to the right
182

batterseapower's avatar
batterseapower committed
183 184
-- $type_classification
-- #type_classification#
ian@well-typed.com's avatar
ian@well-typed.com committed
185
--
batterseapower's avatar
batterseapower committed
186
-- Types are one of:
ian@well-typed.com's avatar
ian@well-typed.com committed
187
--
batterseapower's avatar
batterseapower committed
188
-- [Unboxed]            Iff its representation is other than a pointer
ian@well-typed.com's avatar
ian@well-typed.com committed
189 190
--                      Unboxed types are also unlifted.
--
batterseapower's avatar
batterseapower committed
191
-- [Lifted]             Iff it has bottom as an element.
ian@well-typed.com's avatar
ian@well-typed.com committed
192 193 194 195 196 197
--                      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.
--
batterseapower's avatar
batterseapower committed
198
-- [Algebraic]          Iff it is a type with one or more constructors, whether
ian@well-typed.com's avatar
ian@well-typed.com committed
199 200 201 202 203 204
--                      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.
--
batterseapower's avatar
batterseapower committed
205
-- [Data]               Iff it is a type declared with @data@, or a boxed tuple.
ian@well-typed.com's avatar
ian@well-typed.com committed
206
--
batterseapower's avatar
batterseapower committed
207
-- [Primitive]          Iff it is a built-in type that can't be expressed in Haskell.
ian@well-typed.com's avatar
ian@well-typed.com committed
208
--
batterseapower's avatar
batterseapower committed
209 210
-- Currently, all primitive types are unlifted, but that's not necessarily
-- the case: for example, @Int@ could be primitive.
ian@well-typed.com's avatar
ian@well-typed.com committed
211
--
batterseapower's avatar
batterseapower committed
212 213 214
-- 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.
ian@well-typed.com's avatar
ian@well-typed.com committed
215
--
batterseapower's avatar
batterseapower committed
216
-- Some examples of type classifications that may make this a bit clearer are:
ian@well-typed.com's avatar
ian@well-typed.com committed
217
--
batterseapower's avatar
batterseapower committed
218 219 220 221 222 223 224 225 226 227 228 229 230
-- @
-- 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
231
-- passes and the rest of the back end is concerned.
batterseapower's avatar
batterseapower committed
232 233 234 235 236
--
-- 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.
237

238 239 240
{-
************************************************************************
*                                                                      *
ian@well-typed.com's avatar
ian@well-typed.com committed
241
                Type representation
242 243 244
*                                                                      *
************************************************************************
-}
245 246 247

{-# INLINE coreView #-}
coreView :: Type -> Maybe Type
248 249
-- ^ This function Strips off the /top layer only/ of a type synonym
-- application (if any) its underlying representation type.
250 251
-- Returns Nothing if there is nothing to look through.
--
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
coreView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
batterseapower's avatar
batterseapower committed
255 256
              = Just (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
               -- Its important to use mkAppTys, rather than (foldl AppTy),
ian@well-typed.com's avatar
ian@well-typed.com committed
257
               -- because the function part might well return a
batterseapower's avatar
batterseapower committed
258
               -- partially-applied type constructor; indeed, usually will!
259
coreView _ = Nothing
260 261 262 263

-----------------------------------------------
{-# INLINE tcView #-}
tcView :: Type -> Maybe Type
264 265 266
-- ^ Historical only; 'tcView' and 'coreView' used to differ, but don't any more
tcView = coreView
  -- ToDo: get rid of tcView altogether
267 268 269
  -- 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.
270

271 272 273 274 275
-----------------------------------------------
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.
ian@well-typed.com's avatar
ian@well-typed.com committed
276
expandTypeSynonyms ty
277 278 279
  = go ty
  where
    go (TyConApp tc tys)
280
      | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
281 282 283
      = go (mkAppTys (substTy (mkTopTvSubst tenv) rhs) tys')
      | otherwise
      = TyConApp tc (map go tys)
284
    go (LitTy l)       = LitTy l
285
    go (TyVarTy tv)    = TyVarTy tv
286
    go (AppTy t1 t2)   = mkAppTy (go t1) (go t2)
287 288
    go (FunTy t1 t2)   = FunTy (go t1) (go t2)
    go (ForAllTy tv t) = ForAllTy tv (go t)
289

290 291 292
{-
************************************************************************
*                                                                      *
293
\subsection{Constructor-specific functions}
294 295
*                                                                      *
************************************************************************
sof's avatar
sof committed
296 297


298
---------------------------------------------------------------------
ian@well-typed.com's avatar
ian@well-typed.com committed
299 300
                                TyVarTy
                                ~~~~~~~
301 302
-}

batterseapower's avatar
batterseapower committed
303 304
-- | 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'
305
getTyVar :: String -> Type -> TyVar
306
getTyVar msg ty = case getTyVar_maybe ty of
ian@well-typed.com's avatar
ian@well-typed.com committed
307 308
                    Just tv -> tv
                    Nothing -> panic ("getTyVar: " ++ msg)
309

310
isTyVarTy :: Type -> Bool
311 312
isTyVarTy ty = isJust (getTyVar_maybe ty)

batterseapower's avatar
batterseapower committed
313
-- | Attempts to obtain the type variable underlying a 'Type'
314
getTyVar_maybe :: Type -> Maybe TyVar
315
getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
ian@well-typed.com's avatar
ian@well-typed.com committed
316
getTyVar_maybe (TyVarTy tv)                 = Just tv
317
getTyVar_maybe _                            = Nothing
318

319 320 321 322 323 324 325 326 327
allDistinctTyVars :: [KindOrType] -> Bool
allDistinctTyVars tkvs = go emptyVarSet tkvs
  where
    go _      [] = True
    go so_far (ty : tys)
       = case getTyVar_maybe ty of
             Nothing -> False
             Just tv | tv `elemVarSet` so_far -> False
                     | otherwise -> go (so_far `extendVarSet` tv) tys
328

329
{-
330
---------------------------------------------------------------------
ian@well-typed.com's avatar
ian@well-typed.com committed
331 332 333
                                AppTy
                                ~~~~~
We need to be pretty careful with AppTy to make sure we obey the
334 335
invariant that a TyConApp is always visibly so.  mkAppTy maintains the
invariant: use it.
336
-}
337

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

351
mkAppTys :: Type -> [Type] -> Type
ian@well-typed.com's avatar
ian@well-typed.com committed
352
mkAppTys ty1                []   = ty1
353 354 355
mkAppTys (TyConApp tc tys1) tys2 = mkTyConApp tc (tys1 ++ tys2)
mkAppTys ty1                tys2 = foldl AppTy ty1 tys2

356
-------------
357
splitAppTy_maybe :: Type -> Maybe (Type, Type)
batterseapower's avatar
batterseapower committed
358 359 360
-- ^ 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!
361
splitAppTy_maybe ty | Just ty' <- coreView ty
ian@well-typed.com's avatar
ian@well-typed.com committed
362
                    = splitAppTy_maybe ty'
363
splitAppTy_maybe ty = repSplitAppTy_maybe ty
364

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

384
-------------
385
splitAppTys :: Type -> (Type, [Type])
batterseapower's avatar
batterseapower committed
386 387 388
-- ^ 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.
389
splitAppTys ty = split ty ty []
390
  where
391
    split orig_ty ty args | Just ty' <- coreView ty = split orig_ty ty' args
392 393
    split _       (AppTy ty arg)        args = split ty ty (arg:args)
    split _       (TyConApp tc tc_args) args
394
      = let -- keep type families saturated
rl@cse.unsw.edu.au's avatar
rl@cse.unsw.edu.au committed
395 396
            n | isDecomposableTyCon tc = 0
              | otherwise              = tyConArity tc
397
            (tc_args1, tc_args2) = splitAt n tc_args
398 399
        in
        (TyConApp tc tc_args1, tc_args2 ++ args)
400
    split _       (FunTy ty1 ty2)       args = ASSERT( null args )
ian@well-typed.com's avatar
ian@well-typed.com committed
401
                                               (TyConApp funTyCon [], [ty1,ty2])
402
    split orig_ty _                     args = (orig_ty, args)
403

404
{-
405
                      LitTy
406
                      ~~~~~
407
-}
408

409 410
mkNumLitTy :: Integer -> Type
mkNumLitTy n = LitTy (NumTyLit n)
411

412
-- | Is this a numeric literal. We also look through type synonyms.
413
isNumLitTy :: Type -> Maybe Integer
414
isNumLitTy ty | Just ty1 <- tcView ty = isNumLitTy ty1
415 416
isNumLitTy (LitTy (NumTyLit n)) = Just n
isNumLitTy _                    = Nothing
417

418 419 420
mkStrLitTy :: FastString -> Type
mkStrLitTy s = LitTy (StrTyLit s)

421
-- | Is this a symbol literal. We also look through type synonyms.
422
isStrLitTy :: Type -> Maybe FastString
423
isStrLitTy ty | Just ty1 <- tcView ty = isStrLitTy ty1
424 425
isStrLitTy (LitTy (StrTyLit s)) = Just s
isStrLitTy _                    = Nothing
426

427
{-
428
---------------------------------------------------------------------
ian@well-typed.com's avatar
ian@well-typed.com committed
429 430
                                FunTy
                                ~~~~~
431
-}
432

433
mkFunTy :: Type -> Type -> Type
batterseapower's avatar
batterseapower committed
434
-- ^ Creates a function type from the given argument and result type
435
mkFunTy arg res = FunTy arg res
436

437
mkFunTys :: [Type] -> Type -> Type
438
mkFunTys tys ty = foldr mkFunTy ty tys
439

ian@well-typed.com's avatar
ian@well-typed.com committed
440
isFunTy :: Type -> Bool
441 442
isFunTy ty = isJust (splitFunTy_maybe ty)

443
splitFunTy :: Type -> (Type, Type)
batterseapower's avatar
batterseapower committed
444 445
-- ^ Attempts to extract the argument and result types from a type, and
-- panics if that is not possible. See also 'splitFunTy_maybe'
446
splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
ian@well-typed.com's avatar
ian@well-typed.com committed
447 448
splitFunTy (FunTy arg res) = (arg, res)
splitFunTy other           = pprPanic "splitFunTy" (ppr other)
449

450
splitFunTy_maybe :: Type -> Maybe (Type, Type)
batterseapower's avatar
batterseapower committed
451
-- ^ Attempts to extract the argument and result types from a type
452
splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
453
splitFunTy_maybe (FunTy arg res)   = Just (arg, res)
454
splitFunTy_maybe _                 = Nothing
455

456
splitFunTys :: Type -> ([Type], Type)
457
splitFunTys ty = split [] ty ty
458
  where
459
    split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
460 461
    split args _       (FunTy arg res)   = split (arg:args) res res
    split args orig_ty _                 = (reverse args, orig_ty)
462

463
splitFunTysN :: Int -> Type -> ([Type], Type)
batterseapower's avatar
batterseapower committed
464
-- ^ Split off exactly the given number argument types, and panics if that is not possible
465
splitFunTysN 0 ty = ([], ty)
simonpj@microsoft.com's avatar
Assert  
simonpj@microsoft.com committed
466 467
splitFunTysN n ty = ASSERT2( isFunTy ty, int n <+> ppr ty )
                    case splitFunTy ty of { (arg, res) ->
ian@well-typed.com's avatar
ian@well-typed.com committed
468 469
                    case splitFunTysN (n-1) res of { (args, res) ->
                    (arg:args, res) }}
470

batterseapower's avatar
batterseapower committed
471 472 473 474 475 476
-- | 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)
477 478
zipFunTys orig_xs orig_ty = split [] orig_xs orig_ty orig_ty
  where
479
    split acc []     nty _                 = (reverse acc, nty)
ian@well-typed.com's avatar
ian@well-typed.com committed
480 481
    split acc xs     nty ty
          | Just ty' <- coreView ty        = split acc xs nty ty'
482 483
    split acc (x:xs) _   (FunTy arg res)   = split ((x,arg):acc) xs res res
    split _   _      _   _                 = pprPanic "zipFunTys" (ppr orig_xs <+> ppr orig_ty)
ian@well-typed.com's avatar
ian@well-typed.com committed
484

485
funResultTy :: Type -> Type
batterseapower's avatar
batterseapower committed
486
-- ^ Extract the function result type and panic if that is not possible
487
funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
488 489
funResultTy (FunTy _arg res)  = res
funResultTy ty                = pprPanic "funResultTy" (ppr ty)
490 491

funArgTy :: Type -> Type
batterseapower's avatar
batterseapower committed
492
-- ^ Extract the function argument type and panic if that is not possible
493
funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
494 495
funArgTy (FunTy arg _res)  = arg
funArgTy ty                = pprPanic "funArgTy" (ppr ty)
496

497
{-
498
---------------------------------------------------------------------
ian@well-typed.com's avatar
ian@well-typed.com committed
499 500
                                TyConApp
                                ~~~~~~~~
501
-}
502

Gabor Greif's avatar
Typo  
Gabor Greif committed
503
-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to
504 505 506 507 508 509 510 511 512
-- 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

513 514 515 516
-- 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
517
-- | The same as @fst . splitTyConApp@
518 519 520 521 522 523
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

524
tyConAppTyCon :: Type -> TyCon
525
tyConAppTyCon ty = tyConAppTyCon_maybe ty `orElse` pprPanic "tyConAppTyCon" (ppr ty)
526

batterseapower's avatar
batterseapower committed
527
-- | The same as @snd . splitTyConApp@
528 529 530 531 532 533 534
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


535
tyConAppArgs :: Type -> [Type]
536
tyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic "tyConAppArgs" (ppr ty)
537

538 539
tyConAppArgN :: Int -> Type -> Type
-- Executing Nth
ian@well-typed.com's avatar
ian@well-typed.com committed
540
tyConAppArgN n ty
541 542 543 544
  = 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
545 546 547
-- | 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'
548 549
splitTyConApp :: Type -> (TyCon, [Type])
splitTyConApp ty = case splitTyConApp_maybe ty of
ian@well-typed.com's avatar
ian@well-typed.com committed
550 551
                   Just stuff -> stuff
                   Nothing    -> pprPanic "splitTyConApp" (ppr ty)
552

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

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
561 562 563 564 565 566 567 568 569 570 571 572 573 574
-- | What is the role assigned to the next parameter of this type? Usually,
-- this will be 'Nominal', but if the type is a 'TyConApp', we may be able to
-- do better. The type does *not* have to be well-kinded when applied for this
-- to work!
nextRole :: Type -> Role
nextRole ty
  | Just (tc, tys) <- splitTyConApp_maybe ty
  , let num_tys = length tys
  , num_tys < tyConArity tc
  = tyConRoles tc `getNth` num_tys

  | otherwise
  = Nominal

575
newTyConInstRhs :: TyCon -> [Type] -> Type
ian@well-typed.com's avatar
ian@well-typed.com committed
576
-- ^ Unwrap one 'layer' of newtype on a type constructor and its
577 578
-- arguments, using an eta-reduced version of the @newtype@ if possible.
-- This requires tys to have at least @newTyConInstArity tycon@ elements.
ian@well-typed.com's avatar
ian@well-typed.com committed
579
newTyConInstRhs tycon tys
580 581
    = ASSERT2( tvs `leLength` tys, ppr tycon $$ ppr tys $$ ppr tvs )
      applyTysX tvs rhs tys
582
  where
583
    (tvs, rhs) = newTyConEtadRhs tycon
584

585
{-
586
---------------------------------------------------------------------
ian@well-typed.com's avatar
ian@well-typed.com committed
587 588
                                SynTy
                                ~~~~~
589 590 591 592

Notes on type synonyms
~~~~~~~~~~~~~~~~~~~~~~
The various "split" functions (splitFunTy, splitRhoTy, splitForAllTy) try
Krzysztof Gogolewski's avatar
Typos  
Krzysztof Gogolewski committed
593
to return type synonyms wherever possible. Thus
594

ian@well-typed.com's avatar
ian@well-typed.com committed
595
        type Foo a = a -> a
596

ian@well-typed.com's avatar
ian@well-typed.com committed
597 598 599
we want
        splitFunTys (a -> Foo a) = ([a], Foo a)
not                                ([a], a -> a)
600

ian@well-typed.com's avatar
ian@well-typed.com committed
601
The reason is that we then get better (shorter) type signatures in
602
interfaces.  Notably this plays a role in tcTySigs in TcBinds.hs.
603 604


ian@well-typed.com's avatar
ian@well-typed.com committed
605 606
                Representation types
                ~~~~~~~~~~~~~~~~~~~~
607

608 609
Note [Nullary unboxed tuple]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
610
We represent the nullary unboxed tuple as the unary (but void) type
611
Void#.  The reason for this is that the ReprArity is never
612 613 614 615 616 617
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!
618
-}
619 620 621 622 623 624 625 626 627 628

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
629 630
-- | Looks through:
--
ian@well-typed.com's avatar
ian@well-typed.com committed
631 632 633 634
--      1. For-alls
--      2. Synonyms
--      3. Predicates
--      4. All newtypes, including recursive ones, but not newtype families
batterseapower's avatar
batterseapower committed
635 636
--
-- It's useful in the back end of the compiler.
637
repType :: Type -> RepType
638
repType ty
639
  = go initRecTc ty
640
  where
641
    go :: RecTcChecker -> Type -> RepType
ian@well-typed.com's avatar
ian@well-typed.com committed
642
    go rec_nts ty                       -- Expand predicates and synonyms
Simon Peyton Jones's avatar
Simon Peyton Jones committed
643 644
      | Just ty' <- coreView ty
      = go rec_nts ty'
645

ian@well-typed.com's avatar
ian@well-typed.com committed
646 647
    go rec_nts (ForAllTy _ ty)          -- Drop foralls
        = go rec_nts ty
648

ian@well-typed.com's avatar
ian@well-typed.com committed
649
    go rec_nts (TyConApp tc tys)        -- Expand newtypes
650 651
      | isNewTyCon tc
      , tys `lengthAtLeast` tyConArity tc
652
      , Just rec_nts' <- checkRecTc rec_nts tc   -- See Note [Expanding newtypes] in TyCon
653
      = go rec_nts' (newTyConInstRhs tc tys)
654

655 656
      | isUnboxedTupleTyCon tc
      = if null tys
657
         then UnaryRep voidPrimTy -- See Note [Nullary unboxed tuple]
658
         else UbxTupleRep (concatMap (flattenRepType . go rec_nts) tys)
659

660
    go _ ty = UnaryRep ty
661

662 663 664 665

-- | All type constructors occurring in the type; looking through type
--   synonyms, but not newtypes.
--  When it finds a Class, it returns the class TyCon.
666
tyConsOfType :: Type -> NameEnv TyCon
667
tyConsOfType ty
668
  = go ty
669 670 671 672 673 674 675 676 677 678 679 680 681
  where
     go :: Type -> NameEnv TyCon  -- The NameEnv does duplicate elim
     go ty | Just ty' <- tcView ty = go ty'
     go (TyVarTy {})               = emptyNameEnv
     go (LitTy {})                 = emptyNameEnv
     go (TyConApp tc tys)          = go_tc tc tys
     go (AppTy a b)                = go a `plusNameEnv` go b
     go (FunTy a b)                = go a `plusNameEnv` go b
     go (ForAllTy _ ty)            = go ty

     go_tc tc tys = extendNameEnv (go_s tys) (tyConName tc) tc
     go_s tys = foldr (plusNameEnv . go) emptyNameEnv tys

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

685 686 687 688 689 690 691 692
-- | 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
ian@well-typed.com's avatar
ian@well-typed.com committed
693
        AppTy _ _     -> PtrRep      -- See Note [AppTy rep]
694 695 696 697 698 699 700 701
        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))
702 703 704 705 706 707

isVoidTy :: Type -> Bool
-- True if the type has zero width
isVoidTy ty = case repType ty of
                UnaryRep (TyConApp tc _) -> isVoidRep (tyConPrimRep tc)
                _                        -> False
708

709
{-
710 711 712 713
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
ian@well-typed.com's avatar
ian@well-typed.com committed
714
kind (kk -> kk) and kk cannot be unlifted; see Note [The kind invariant]
715
in TypeRep.
716

717
---------------------------------------------------------------------
ian@well-typed.com's avatar
ian@well-typed.com committed
718 719
                                ForAllTy
                                ~~~~~~~~
720
-}
721

722
mkForAllTy :: TyVar -> Type -> Type
723
mkForAllTy tyvar ty
724
  = ForAllTy tyvar ty
725

batterseapower's avatar
batterseapower committed
726
-- | Wraps foralls over the type using the provided 'TyVar's from left to right
727
mkForAllTys :: [TyVar] -> Type -> Type
728
mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
729

730 731
mkPiKinds :: [TyVar] -> Kind -> Kind
-- mkPiKinds [k1, k2, (a:k1 -> *)] k2
dreixel's avatar
dreixel committed
732
-- returns forall k1 k2. (k1 -> *) -> k2
733
mkPiKinds [] res = res
ian@well-typed.com's avatar
ian@well-typed.com committed
734
mkPiKinds (tv:tvs) res
735 736
  | isKindVar tv = ForAllTy tv          (mkPiKinds tvs res)
  | otherwise    = FunTy (tyVarKind tv) (mkPiKinds tvs res)
737 738 739 740 741 742 743 744 745 746 747 748

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
749

750 751
isForAllTy :: Type -> Bool
isForAllTy (ForAllTy _ _) = True
752
isForAllTy _              = False
753

batterseapower's avatar
batterseapower committed
754 755
-- | Attempts to take a forall type apart, returning the bound type variable
-- and the remainder of the type
756
splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
757
splitForAllTy_maybe ty = splitFAT_m ty
758
  where
759
    splitFAT_m ty | Just ty' <- coreView ty = splitFAT_m ty'
ian@well-typed.com's avatar
ian@well-typed.com committed
760 761
    splitFAT_m (ForAllTy tyvar ty)          = Just(tyvar, ty)
    splitFAT_m _                            = Nothing
sof's avatar
sof committed
762