Type.hs 129 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, FlexibleContexts, PatternSynonyms, ViewPatterns #-}
7
{-# OPTIONS_GHC -fno-warn-orphans #-}
8
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
Ian Lynagh's avatar
Ian Lynagh committed
9

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

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

batterseapower's avatar
batterseapower committed
17
        -- $representation_types
18
        TyThing(..), Type, ArgFlag(..), AnonArgFlag(..),
Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
19
        Specificity(..),
Simon Peyton Jones's avatar
Simon Peyton Jones committed
20
        KindOrType, PredType, ThetaType,
Ningning Xie's avatar
Ningning Xie committed
21
        Var, TyVar, isTyVar, TyCoVar, TyCoBinder, TyCoVarBinder, TyVarBinder,
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
22
        Mult, Scaled,
23
        KnotTied,
24

batterseapower's avatar
batterseapower committed
25
        -- ** Constructing and deconstructing types
26
        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe,
Ningning Xie's avatar
Ningning Xie committed
27
        getCastedTyVar_maybe, tyVarKind, varType,
28

eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
29
        mkAppTy, mkAppTys, splitAppTy, splitAppTys, repSplitAppTys,
30
        splitAppTy_maybe, repSplitAppTy_maybe, tcRepSplitAppTy_maybe,
31

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
32 33 34 35
        mkVisFunTy, mkInvisFunTy,
        mkVisFunTys,
        mkVisFunTyMany, mkInvisFunTyMany,
        mkVisFunTysMany, mkInvisFunTysMany,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
36
        splitFunTy, splitFunTy_maybe,
37
        splitFunTys, funResultTy, funArgTy,
38

ian@well-typed.com's avatar
ian@well-typed.com committed
39
        mkTyConApp, mkTyConTy,
40 41
        tyConAppTyCon_maybe, tyConAppTyConPicky_maybe,
        tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs,
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
42
        splitTyConApp_maybe, splitTyConApp, tyConAppArgN,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
43
        tcSplitTyConApp_maybe,
44 45 46
        splitListTyConApp_maybe,
        repSplitTyConApp_maybe,

Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
47
        mkForAllTy, mkForAllTys, mkInvisForAllTys, mkTyCoInvForAllTys,
48
        mkSpecForAllTy, mkSpecForAllTys,
Ningning Xie's avatar
Ningning Xie committed
49
        mkVisForAllTys, mkTyCoInvForAllTy,
Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
50
        mkInfForAllTy, mkInfForAllTys,
51 52
        splitForAllTys, splitSomeForAllTys,
        splitForAllTysReq, splitForAllTysInvis,
53
        splitForAllVarBndrs,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
54
        splitForAllTy_maybe, splitForAllTy,
Ningning Xie's avatar
Ningning Xie committed
55
        splitForAllTy_ty_maybe, splitForAllTy_co_maybe,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
56
        splitPiTy_maybe, splitPiTy, splitPiTys,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
57 58
        mkTyConBindersPreferAnon,
        mkPiTy, mkPiTys,
59
        piResultTy, piResultTys,
60
        applyTysX, dropForAlls,
61
        mkFamilyTyConApp,
62
        buildSynTyCon,
63

64 65
        mkNumLitTy, isNumLitTy,
        mkStrLitTy, isStrLitTy,
66
        isLitTy,
67

68 69
        isPredTy,

70
        getRuntimeRep_maybe, kindRep_maybe, kindRep,
Ben Gamari's avatar
Ben Gamari committed
71

Simon Peyton Jones's avatar
Simon Peyton Jones committed
72
        mkCastTy, mkCoercionTy, splitCastTy_maybe,
73
        discardCast,
74

75
        userTypeError_maybe, pprUserTypeErrorTy,
76

77
        coAxNthLHS,
78
        stripCoercionTy,
79

80 81 82
        splitPiTysInvisible, splitPiTysInvisibleN,
        invisibleTyBndrCount,
        filterOutInvisibleTypes, filterOutInferredTypes,
83 84
        partitionInvisibleTypes, partitionInvisibles,
        tyConArgFlags, appTyArgFlags,
85 86
        synTyConResKind,

lukemaurer's avatar
lukemaurer committed
87 88
        modifyJoinResTy, setJoinResTy,

89
        -- ** Analyzing types
90
        TyCoMapper(..), mapTyCo, mapTyCoX,
91
        TyCoFolder(..), foldTyCo,
ian@well-typed.com's avatar
ian@well-typed.com committed
92 93 94 95

        -- (Newtypes)
        newTyConInstRhs,

96
        -- ** Binders
97
        sameVis,
Ningning Xie's avatar
Ningning Xie committed
98
        mkTyCoVarBinder, mkTyCoVarBinders,
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
99
        mkTyVarBinder, mkTyVarBinders,
Gert-Jan Bottu's avatar
Gert-Jan Bottu committed
100
        tyVarSpecToBinders,
101
        mkAnonBinder,
102
        isAnonTyCoBinder,
Ningning Xie's avatar
Ningning Xie committed
103 104 105
        binderVar, binderVars, binderType, binderArgFlag,
        tyCoBinderType, tyCoBinderVar_maybe,
        tyBinderType,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
106
        binderRelevantType_maybe,
107 108
        isVisibleArgFlag, isInvisibleArgFlag, isVisibleBinder,
        isInvisibleBinder, isNamedBinder,
Ningning Xie's avatar
Ningning Xie committed
109
        tyConBindersTyCoBinders,
110

ian@well-typed.com's avatar
ian@well-typed.com committed
111
        -- ** Common type constructors
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
112
        funTyCon, unrestrictedFunTyCon,
113

batterseapower's avatar
batterseapower committed
114
        -- ** Predicates on types
115
        isTyVarTy, isFunTy, isCoercionTy,
116
        isCoercionTy_maybe, isForAllTy,
Ningning Xie's avatar
Ningning Xie committed
117
        isForAllTy_ty, isForAllTy_co,
118
        isPiTy, isTauTy, isFamFreeTy,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
119
        isCoVarType, isAtomicTy,
batterseapower's avatar
batterseapower committed
120

lukemaurer's avatar
lukemaurer committed
121
        isValidJoinPointType,
Ben Gamari's avatar
Ben Gamari committed
122
        tyConAppNeedsKindSig,
lukemaurer's avatar
lukemaurer committed
123

124 125 126 127 128
        -- *** Levity and boxity
        isLiftedType_maybe,
        isLiftedTypeKind, isUnliftedTypeKind,
        isLiftedRuntimeRep, isUnliftedRuntimeRep,
        isUnliftedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
129
        isAlgType, isDataFamilyAppType,
ian@well-typed.com's avatar
ian@well-typed.com committed
130
        isPrimitiveType, isStrictType,
131 132
        isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,
        dropRuntimeRepArgs,
133
        getRuntimeRep,
134

135
        -- * Multiplicity
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
136 137

        isMultiplicityTy, isMultiplicityVar,
138 139 140 141
        unrestricted, linear, tymult,
        mkScaled, irrelevantMult, scaledSet,
        pattern One, pattern Many,
        isOneDataConTy, isManyDataConTy,
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
142 143
        isLinearType,

ian@well-typed.com's avatar
ian@well-typed.com committed
144
        -- * Main data types representing Kinds
145
        Kind,
batterseapower's avatar
batterseapower committed
146 147

        -- ** Finding the kind of a type
148
        typeKind, tcTypeKind, isTypeLevPoly, resultIsLevPoly,
149
        tcIsLiftedTypeKind, tcIsConstraintKind, tcReturnsConstraintKind,
150
        tcIsRuntimeTypeKind,
ian@well-typed.com's avatar
ian@well-typed.com committed
151

152
        -- ** Common Kind
153
        liftedTypeKind,
batterseapower's avatar
batterseapower committed
154

ian@well-typed.com's avatar
ian@well-typed.com committed
155
        -- * Type free variables
156
        tyCoFVsOfType, tyCoFVsBndr, tyCoFVsVarBndr, tyCoFVsVarBndrs,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
157
        tyCoVarsOfType, tyCoVarsOfTypes,
158 159
        tyCoVarsOfTypeDSet,
        coVarsOfType,
Tobias Dammers's avatar
Tobias Dammers committed
160 161
        coVarsOfTypes,

Richard Eisenberg's avatar
Richard Eisenberg committed
162
        noFreeVarsOfType,
163
        splitVisVarsOfType, splitVisVarsOfTypes,
ian@well-typed.com's avatar
ian@well-typed.com committed
164
        expandTypeSynonyms,
165
        typeSize, occCheckExpand,
166

167
        -- ** Closing over kinds
Simon Peyton Jones's avatar
Simon Peyton Jones committed
168
        closeOverKindsDSet, closeOverKindsList,
169 170
        closeOverKinds,

171
        -- * Well-scoped lists of variables
172 173
        scopedSort, tyCoVarsOfTypeWellScoped,
        tyCoVarsOfTypesWellScoped,
174

ian@well-typed.com's avatar
ian@well-typed.com committed
175
        -- * Type comparison
niteria's avatar
niteria committed
176 177
        eqType, eqTypeX, eqTypes, nonDetCmpType, nonDetCmpTypes, nonDetCmpTypeX,
        nonDetCmpTypesX, nonDetCmpTc,
178
        eqVarBndrs,
179

ian@well-typed.com's avatar
ian@well-typed.com committed
180
        -- * Forcing evaluation of types
batterseapower's avatar
batterseapower committed
181
        seqType, seqTypes,
182

batterseapower's avatar
batterseapower committed
183
        -- * Other views onto Types
Ben Gamari's avatar
Ben Gamari committed
184
        coreView, tcView,
batterseapower's avatar
batterseapower committed
185

186
        tyConsOfType,
batterseapower's avatar
batterseapower committed
187

ian@well-typed.com's avatar
ian@well-typed.com committed
188 189
        -- * Main type substitution data types
        TvSubstEnv,     -- Representation widely visible
190
        TCvSubst(..),    -- Representation visible to a few friends
ian@well-typed.com's avatar
ian@well-typed.com committed
191 192

        -- ** Manipulating type substitutions
193
        emptyTvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst,
ian@well-typed.com's avatar
ian@well-typed.com committed
194

niteria's avatar
niteria committed
195
        mkTCvSubst, zipTvSubst, mkTvSubstPrs,
Ningning Xie's avatar
Ningning Xie committed
196
        zipTCvSubst,
197
        notElemTCvSubst,
198
        getTvSubstEnv, setTvSubstEnv,
199
        zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs,
200
        extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
201
        extendTCvSubst, extendCvSubst,
Richard Eisenberg's avatar
Richard Eisenberg committed
202
        extendTvSubst, extendTvSubstBinderAndInScope,
203
        extendTvSubstList, extendTvSubstAndInScope,
Ningning Xie's avatar
Ningning Xie committed
204
        extendTCvSubstList,
205
        extendTvSubstWithClone,
Ningning Xie's avatar
Ningning Xie committed
206
        extendTCvSubstWithClone,
207 208
        isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,
        isEmptyTCvSubst, unionTCvSubst,
209

ian@well-typed.com's avatar
ian@well-typed.com committed
210
        -- ** Performing substitution on types and kinds
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
211
        substTy, substTys, substScaledTy, substScaledTys, substTyWith, substTysWith, substTheta,
212
        substTyAddInScope,
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
213 214
        substTyUnchecked, substTysUnchecked, substScaledTyUnchecked, substScaledTysUnchecked,
        substThetaUnchecked, substTyWithUnchecked,
215
        substCoUnchecked, substCoWithUnchecked,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
216
        substTyVarBndr, substTyVarBndrs, substTyVar, substTyVars,
Ningning Xie's avatar
Ningning Xie committed
217
        substVarBndr, substVarBndrs,
218
        cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar,
219

Simon Peyton Jones's avatar
Simon Peyton Jones committed
220 221 222 223
        -- * Tidying type related things up for printing
        tidyType,      tidyTypes,
        tidyOpenType,  tidyOpenTypes,
        tidyOpenKind,
Ningning Xie's avatar
Ningning Xie committed
224
        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars,
225
        tidyOpenTyCoVar, tidyOpenTyCoVars,
Ningning Xie's avatar
Ningning Xie committed
226
        tidyTyCoVarOcc,
Simon Peyton Jones's avatar
Simon Peyton Jones committed
227
        tidyTopType,
228
        tidyKind,
229 230 231 232 233 234
        tidyTyCoVarBinder, tidyTyCoVarBinders,

        -- * Kinds
        isConstraintKindCon,
        classifiesTypeWithValues,
        isKindLevPoly
235
    ) where
236

237 238
#include "HsVersions.h"

239
import GHC.Prelude
240

Sylvain Henry's avatar
Sylvain Henry committed
241
import GHC.Types.Basic
lukemaurer's avatar
lukemaurer committed
242

Sylvain Henry's avatar
Sylvain Henry committed
243
-- We import the representation and primitive functions from GHC.Core.TyCo.Rep.
244 245
-- Many things are reexported, but not the representation!

Sylvain Henry's avatar
Sylvain Henry committed
246 247 248 249
import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Subst
import GHC.Core.TyCo.Tidy
import GHC.Core.TyCo.FVs
250

251
-- friends:
Sylvain Henry's avatar
Sylvain Henry committed
252 253 254 255
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
import GHC.Types.Unique.Set
256

Sylvain Henry's avatar
Sylvain Henry committed
257
import GHC.Core.TyCon
Sylvain Henry's avatar
Sylvain Henry committed
258 259 260
import GHC.Builtin.Types.Prim
import {-# SOURCE #-} GHC.Builtin.Types
                                 ( listTyCon, typeNatKind
261
                                 , typeSymbolKind, liftedTypeKind
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
262
                                 , constraintKind
263 264
                                 , unrestrictedFunTyCon
                                 , manyDataConTy, oneDataConTy )
Sylvain Henry's avatar
Sylvain Henry committed
265
import GHC.Types.Name( Name )
Sylvain Henry's avatar
Sylvain Henry committed
266
import GHC.Builtin.Names
Sylvain Henry's avatar
Sylvain Henry committed
267 268 269 270 271 272
import GHC.Core.Coercion.Axiom
import {-# SOURCE #-} GHC.Core.Coercion
   ( mkNomReflCo, mkGReflCo, mkReflCo
   , mkTyConAppCo, mkAppCo, mkCoVarCo, mkAxiomRuleCo
   , mkForAllCo, mkFunCo, mkAxiomInstCo, mkUnivCo
   , mkSymCo, mkTransCo, mkNthCo, mkLRCo, mkInstCo
273
   , mkKindCo, mkSubCo
Sylvain Henry's avatar
Sylvain Henry committed
274 275 276
   , decomposePiCos, coercionKind, coercionLKind
   , coercionRKind, coercionType
   , isReflexiveCo, seqCo )
277

278
-- others
279 280 281 282 283 284
import GHC.Utils.Misc
import GHC.Utils.FV
import GHC.Utils.Outputable
import GHC.Data.FastString
import GHC.Data.Pair
import GHC.Data.List.SetOps
Sylvain Henry's avatar
Sylvain Henry committed
285
import GHC.Types.Unique ( nonDetCmpUnique )
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
286

287
import GHC.Data.Maybe   ( orElse, expectJust )
288
import Data.Maybe       ( isJust, mapMaybe )
289
import Control.Monad    ( guard )
290

batterseapower's avatar
batterseapower committed
291 292
-- $type_classification
-- #type_classification#
ian@well-typed.com's avatar
ian@well-typed.com committed
293
--
batterseapower's avatar
batterseapower committed
294
-- Types are one of:
ian@well-typed.com's avatar
ian@well-typed.com committed
295
--
batterseapower's avatar
batterseapower committed
296
-- [Unboxed]            Iff its representation is other than a pointer
ian@well-typed.com's avatar
ian@well-typed.com committed
297 298
--                      Unboxed types are also unlifted.
--
batterseapower's avatar
batterseapower committed
299
-- [Lifted]             Iff it has bottom as an element.
ian@well-typed.com's avatar
ian@well-typed.com committed
300 301 302 303 304 305
--                      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
306
-- [Algebraic]          Iff it is a type with one or more constructors, whether
ian@well-typed.com's avatar
ian@well-typed.com committed
307 308 309 310 311 312
--                      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
313
-- [Data]               Iff it is a type declared with @data@, or a boxed tuple.
ian@well-typed.com's avatar
ian@well-typed.com committed
314
--
batterseapower's avatar
batterseapower committed
315
-- [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
316
--
batterseapower's avatar
batterseapower committed
317 318
-- 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
319
--
batterseapower's avatar
batterseapower committed
320 321 322
-- 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
323
--
batterseapower's avatar
batterseapower committed
324
-- Some examples of type classifications that may make this a bit clearer are:
ian@well-typed.com's avatar
ian@well-typed.com committed
325
--
batterseapower's avatar
batterseapower committed
326
-- @
327
-- Type          primitive       boxed           lifted          algebraic
batterseapower's avatar
batterseapower committed
328
-- -----------------------------------------------------------------------------
329 330 331 332 333 334
-- Int#          Yes             No              No              No
-- ByteArray#    Yes             Yes             No              No
-- (\# a, b \#)  Yes             No              No              Yes
-- (\# a | b \#) Yes             No              No              Yes
-- (  a, b  )    No              Yes             Yes             Yes
-- [a]           No              Yes             Yes             Yes
batterseapower's avatar
batterseapower committed
335 336 337 338 339
-- @

-- $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
340
-- passes and the rest of the back end is concerned.
batterseapower's avatar
batterseapower committed
341 342 343
--
-- 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
Ningning Xie's avatar
Ningning Xie committed
344
-- if they are spotted, to the best of its abilities. If you don't want this
batterseapower's avatar
batterseapower committed
345
-- to happen, use the equivalent functions from the "TcType" module.
346

347 348 349
{-
************************************************************************
*                                                                      *
ian@well-typed.com's avatar
ian@well-typed.com committed
350
                Type representation
351 352
*                                                                      *
************************************************************************
Ben Gamari's avatar
Ben Gamari committed
353 354 355

Note [coreView vs tcView]
~~~~~~~~~~~~~~~~~~~~~~~~~
356 357
So far as the typechecker is concerned, 'Constraint' and 'TYPE
LiftedRep' are distinct kinds.
Ben Gamari's avatar
Ben Gamari committed
358 359 360

But in Core these two are treated as identical.

361 362 363
We implement this by making 'coreView' convert 'Constraint' to 'TYPE
LiftedRep' on the fly.  The function tcView (used in the type checker)
does not do this.
Ben Gamari's avatar
Ben Gamari committed
364

365
See also #11715, which tracks removing this inconsistency.
Ben Gamari's avatar
Ben Gamari committed
366

367
-}
368

Ben Gamari's avatar
Ben Gamari committed
369 370 371
-- | Gives the typechecker view of a type. This unwraps synonyms but
-- leaves 'Constraint' alone. c.f. coreView, which turns Constraint into
-- TYPE LiftedRep. Returns Nothing if no unwrapping happens.
372
-- See also Note [coreView vs tcView]
Ben Gamari's avatar
Ben Gamari committed
373 374 375 376 377 378
{-# INLINE tcView #-}
tcView :: Type -> Maybe Type
tcView (TyConApp tc tys) | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
  = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys')
               -- The free vars of 'rhs' should all be bound by 'tenv', so it's
               -- ok to use 'substTy' here.
Sylvain Henry's avatar
Sylvain Henry committed
379
               -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst.
Ben Gamari's avatar
Ben Gamari committed
380 381 382 383
               -- Its important to use mkAppTys, rather than (foldl AppTy),
               -- because the function part might well return a
               -- partially-applied type constructor; indeed, usually will!
tcView _ = Nothing
384

385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406
{-# INLINE coreView #-}
coreView :: Type -> Maybe Type
-- ^ This function Strips off the /top layer only/ of a type synonym
-- application (if any) its underlying representation type.
-- Returns Nothing if there is nothing to look through.
-- This function considers 'Constraint' to be a synonym of @TYPE LiftedRep@.
--
-- By being non-recursive and inlined, this case analysis gets efficiently
-- joined onto the case analysis that the caller is already doing
coreView ty@(TyConApp tc tys)
  | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc tys
  = Just (mkAppTys (substTy (mkTvSubstPrs tenv) rhs) tys')
    -- This equation is exactly like tcView

  -- At the Core level, Constraint = Type
  -- See Note [coreView vs tcView]
  | isConstraintKindCon tc
  = ASSERT2( null tys, ppr ty )
    Just liftedTypeKind

coreView _ = Nothing

407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437
{-# INLINE coreFullView #-}
coreFullView :: Type -> Type
-- ^ Iterates 'coreView' until there is no more to synonym to expand.
-- See Note [Inlining coreView].
coreFullView ty@(TyConApp tc _)
  | isTypeSynonymTyCon tc || isConstraintKindCon tc = go ty
  where
    go ty
      | Just ty' <- coreView ty = go ty'
      | otherwise = ty

coreFullView ty = ty

{- Note [Inlining coreView] in GHC.Core.Type
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It is very common to have a function

  f :: Type -> ...
  f ty | Just ty' <- coreView ty = f ty'
  f (TyVarTy ...) = ...
  f ...           = ...

If f is not otherwise recursive, the initial call to coreView
causes f to become recursive, which kills the possibility of
inlining. Instead, for non-recursive functions, we prefer to
use coreFullView, which guarantees to unwrap top-level type
synonyms. It can be inlined and is efficient and non-allocating
in its fast path. For this to really be fast, all calls made
on its fast path must also be inlined, linked back to this Note.
-}

438 439 440 441 442
-----------------------------------------------
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.
443 444 445
--
-- 'expandTypeSynonyms' only expands out type synonyms mentioned in the type,
-- not in the kinds of any TyCon or TyVar mentioned in the type.
446 447
--
-- Keep this synchronized with 'synonymTyConsOfType'
ian@well-typed.com's avatar
ian@well-typed.com committed
448
expandTypeSynonyms ty
449
  = go (mkEmptyTCvSubst in_scope) ty
450
  where
451 452
    in_scope = mkInScopeSet (tyCoVarsOfType ty)

453
    go subst (TyConApp tc tys)
454 455 456 457 458 459 460 461
      | Just (tenv, rhs, tys') <- expandSynTyCon_maybe tc expanded_tys
      = let subst' = mkTvSubst in_scope (mkVarEnv tenv)
            -- Make a fresh substitution; rhs has nothing to
            -- do with anything that has happened so far
            -- NB: if you make changes here, be sure to build an
            --     /idempotent/ substitution, even in the nested case
            --        type T a b = a -> b
            --        type S x y = T y x
462
            -- (#11665)
463
        in  mkAppTys (go subst' rhs) tys'
464
      | otherwise
465 466 467 468
      = TyConApp tc expanded_tys
      where
        expanded_tys = (map (go subst) tys)

469 470 471
    go _     (LitTy l)     = LitTy l
    go subst (TyVarTy tv)  = substTyVar subst tv
    go subst (AppTy t1 t2) = mkAppTy (go subst t1) (go subst t2)
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
472 473
    go subst ty@(FunTy _ mult arg res)
      = ty { ft_mult = go subst mult, ft_arg = go subst arg, ft_res = go subst res }
Ningning Xie's avatar
Ningning Xie committed
474 475 476
    go subst (ForAllTy (Bndr tv vis) t)
      = let (subst', tv') = substVarBndrUsing go subst tv in
        ForAllTy (Bndr tv' vis) (go subst' t)
477 478 479
    go subst (CastTy ty co)  = mkCastTy (go subst ty) (go_co subst co)
    go subst (CoercionTy co) = mkCoercionTy (go_co subst co)

Ningning Xie's avatar
Ningning Xie committed
480 481 482 483 484 485 486
    go_mco _     MRefl    = MRefl
    go_mco subst (MCo co) = MCo (go_co subst co)

    go_co subst (Refl ty)
      = mkNomReflCo (go subst ty)
    go_co subst (GRefl r ty mco)
      = mkGReflCo r (go subst ty) (go_mco subst mco)
487 488 489 490 491 492 493 494
       -- NB: coercions are always expanded upon creation
    go_co subst (TyConAppCo r tc args)
      = mkTyConAppCo r tc (map (go_co subst) args)
    go_co subst (AppCo co arg)
      = mkAppCo (go_co subst co) (go_co subst arg)
    go_co subst (ForAllCo tv kind_co co)
      = let (subst', tv', kind_co') = go_cobndr subst tv kind_co in
        mkForAllCo tv' kind_co' (go_co subst' co)
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
495 496
    go_co subst (FunCo r w co1 co2)
      = mkFunCo r (go_co subst w) (go_co subst co1) (go_co subst co2)
497 498 499 500 501 502 503 504 505 506
    go_co subst (CoVarCo cv)
      = substCoVar subst cv
    go_co subst (AxiomInstCo ax ind args)
      = mkAxiomInstCo ax ind (map (go_co subst) args)
    go_co subst (UnivCo p r t1 t2)
      = mkUnivCo (go_prov subst p) r (go subst t1) (go subst t2)
    go_co subst (SymCo co)
      = mkSymCo (go_co subst co)
    go_co subst (TransCo co1 co2)
      = mkTransCo (go_co subst co1) (go_co subst co2)
507 508
    go_co subst (NthCo r n co)
      = mkNthCo r n (go_co subst co)
509 510 511 512 513 514 515 516
    go_co subst (LRCo lr co)
      = mkLRCo lr (go_co subst co)
    go_co subst (InstCo co arg)
      = mkInstCo (go_co subst co) (go_co subst arg)
    go_co subst (KindCo co)
      = mkKindCo (go_co subst co)
    go_co subst (SubCo co)
      = mkSubCo (go_co subst co)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
517 518 519 520
    go_co subst (AxiomRuleCo ax cs)
      = AxiomRuleCo ax (map (go_co subst) cs)
    go_co _ (HoleCo h)
      = pprPanic "expandTypeSynonyms hit a hole" (ppr h)
521 522 523 524 525 526

    go_prov subst (PhantomProv co)    = PhantomProv (go_co subst co)
    go_prov subst (ProofIrrelProv co) = ProofIrrelProv (go_co subst co)
    go_prov _     p@(PluginProv _)    = p

      -- the "False" and "const" are to accommodate the type of
Simon Peyton Jones's avatar
Simon Peyton Jones committed
527
      -- substForAllCoBndrUsing, which is general enough to
528 529
      -- handle coercion optimization (which sometimes swaps the
      -- order of a coercion)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
530
    go_cobndr subst = substForAllCoBndrUsing False (go_co subst) subst
531

532 533 534 535 536 537 538 539 540 541 542 543 544 545 546

-- | Extract the RuntimeRep classifier of a type from its kind. For example,
-- @kindRep * = LiftedRep@; Panics if this is not possible.
-- Treats * and Constraint as the same
kindRep :: HasDebugCallStack => Kind -> Type
kindRep k = case kindRep_maybe k of
              Just r  -> r
              Nothing -> pprPanic "kindRep" (ppr k)

-- | Given a kind (TYPE rr), extract its RuntimeRep classifier rr.
-- For example, @kindRep_maybe * = Just LiftedRep@
-- Returns 'Nothing' if the kind is not of form (TYPE rr)
-- Treats * and Constraint as the same
kindRep_maybe :: HasDebugCallStack => Kind -> Maybe Type
kindRep_maybe kind
547
  | TyConApp tc [arg] <- coreFullView kind
548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564
  , tc `hasKey` tYPETyConKey    = Just arg
  | otherwise                   = Nothing

-- | This version considers Constraint to be the same as *. Returns True
-- if the argument is equivalent to Type/Constraint and False otherwise.
-- See Note [Kind Constraint and kind Type]
isLiftedTypeKind :: Kind -> Bool
isLiftedTypeKind kind
  = case kindRep_maybe kind of
      Just rep -> isLiftedRuntimeRep rep
      Nothing  -> False

isLiftedRuntimeRep :: Type -> Bool
-- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep
-- False of type variables (a :: RuntimeRep)
--   and of other reps e.g. (IntRep :: RuntimeRep)
isLiftedRuntimeRep rep
565
  | TyConApp rr_tc args <- coreFullView rep
566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582
  , rr_tc `hasKey` liftedRepDataConKey = ASSERT( null args ) True
  | otherwise                          = False

-- | Returns True if the kind classifies unlifted types and False otherwise.
-- Note that this returns False for levity-polymorphic kinds, which may
-- be specialized to a kind that classifies unlifted types.
isUnliftedTypeKind :: Kind -> Bool
isUnliftedTypeKind kind
  = case kindRep_maybe kind of
      Just rep -> isUnliftedRuntimeRep rep
      Nothing  -> False

isUnliftedRuntimeRep :: Type -> Bool
-- True of definitely-unlifted RuntimeReps
-- False of           (LiftedRep :: RuntimeRep)
--   and of variables (a :: RuntimeRep)
isUnliftedRuntimeRep rep
583 584
  | TyConApp rr_tc _ <- coreFullView rep   -- NB: args might be non-empty
                                           --     e.g. TupleRep [r1, .., rn]
585 586 587 588 589 590 591 592 593
  = isPromotedDataCon rr_tc && not (rr_tc `hasKey` liftedRepDataConKey)
        -- Avoid searching all the unlifted RuntimeRep type cons
        -- In the RuntimeRep data type, only LiftedRep is lifted
        -- But be careful of type families (F tys) :: RuntimeRep
  | otherwise {- Variables, applications -}
  = False

-- | Is this the type 'RuntimeRep'?
isRuntimeRepTy :: Type -> Bool
594 595 596 597 598
isRuntimeRepTy ty
  | TyConApp tc args <- coreFullView ty
  , tc `hasKey` runtimeRepTyConKey = ASSERT( null args ) True

  | otherwise = False
599 600 601 602 603

-- | Is a tyvar of type 'RuntimeRep'?
isRuntimeRepVar :: TyVar -> Bool
isRuntimeRepVar = isRuntimeRepTy . tyVarKind

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
604 605
-- | Is this the type 'Multiplicity'?
isMultiplicityTy :: Type -> Bool
606 607 608
isMultiplicityTy ty
  | TyConApp tc [] <- coreFullView ty = tc `hasKey` multiplicityTyConKey
  | otherwise                         = False
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
609 610 611 612 613

-- | Is a tyvar of type 'Multiplicity'?
isMultiplicityVar :: TyVar -> Bool
isMultiplicityVar = isMultiplicityTy . tyVarKind

614
{- *********************************************************************
615
*                                                                      *
616
               mapType
617 618 619 620 621 622
*                                                                      *
************************************************************************

These functions do a map-like operation over types, performing some operation
on all variables and binding sites. Primarily used for zonking.

623
Note [Efficiency for ForAllCo case of mapTyCoX]
624
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Sylvain Henry's avatar
Sylvain Henry committed
625
As noted in Note [Forall coercions] in GHC.Core.TyCo.Rep, a ForAllCo is a bit redundant.
Ningning Xie's avatar
Ningning Xie committed
626
It stores a TyCoVar and a Coercion, where the kind of the TyCoVar always matches
627 628 629
the left-hand kind of the coercion. This is convenient lots of the time, but
not when mapping a function over a coercion.

Ningning Xie's avatar
Ningning Xie committed
630
The problem is that tcm_tybinder will affect the TyCoVar's kind and
631 632 633 634 635 636 637 638 639 640 641 642 643 644
mapCoercion will affect the Coercion, and we hope that the results will be
the same. Even if they are the same (which should generally happen with
correct algorithms), then there is an efficiency issue. In particular,
this problem seems to make what should be a linear algorithm into a potentially
exponential one. But it's only going to be bad in the case where there's
lots of foralls in the kinds of other foralls. Like this:

  forall a : (forall b : (forall c : ...). ...). ...

This construction seems unlikely. So we'll do the inefficient, easy way
for now.

Note [Specialising mappers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
645
These INLINE pragmas are indispensable. mapTyCo and mapTyCoX are used
646
to implement zonking, and it's vital that they get specialised to the TcM
647
monad and the particular mapper in use.
648

649 650 651
Even specialising to the monad alone made a 20% allocation difference
in perf/compiler/T5030.

652
See Note [Specialising foldType] in "GHC.Core.TyCo.Rep" for more details of this
653
idiom.
654 655 656 657 658
-}

-- | This describes how a "map" operation over a type/coercion should behave
data TyCoMapper env m
  = TyCoMapper
659
      { tcm_tyvar :: env -> TyVar -> m Type
660
      , tcm_covar :: env -> CoVar -> m Coercion
Simon Peyton Jones's avatar
Simon Peyton Jones committed
661 662
      , tcm_hole  :: env -> CoercionHole -> m Coercion
          -- ^ What to do with coercion holes.
Sylvain Henry's avatar
Sylvain Henry committed
663
          -- See Note [Coercion holes] in GHC.Core.TyCo.Rep.
664

Ningning Xie's avatar
Ningning Xie committed
665
      , tcm_tycobinder :: env -> TyCoVar -> ArgFlag -> m (env, TyCoVar)
666
          -- ^ The returned env is used in the extended scope
667 668

      , tcm_tycon :: TyCon -> m TyCon
Simon Peyton Jones's avatar
Simon Peyton Jones committed
669 670 671 672
          -- ^ This is used only for TcTyCons
          -- a) To zonk TcTyCons
          -- b) To turn TcTyCons into TyCons.
          --    See Note [Type checking recursive type and class declarations]
Sylvain Henry's avatar
Sylvain Henry committed
673
          --    in GHC.Tc.TyCl
674 675
      }

676 677 678 679 680 681 682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698
{-# INLINE mapTyCo #-}  -- See Note [Specialising mappers]
mapTyCo :: Monad m => TyCoMapper () m
         -> ( Type       -> m Type
            , [Type]     -> m [Type]
            , Coercion   -> m Coercion
            , [Coercion] -> m[Coercion])
mapTyCo mapper
  = case mapTyCoX mapper of
     (go_ty, go_tys, go_co, go_cos)
        -> (go_ty (), go_tys (), go_co (), go_cos ())

{-# INLINE mapTyCoX #-}  -- See Note [Specialising mappers]
mapTyCoX :: Monad m => TyCoMapper env m
         -> ( env -> Type       -> m Type
            , env -> [Type]     -> m [Type]
            , env -> Coercion   -> m Coercion
            , env -> [Coercion] -> m[Coercion])
mapTyCoX (TyCoMapper { tcm_tyvar = tyvar
                     , tcm_tycobinder = tycobinder
                     , tcm_tycon = tycon
                     , tcm_covar = covar
                     , tcm_hole = cohole })
  = (go_ty, go_tys, go_co, go_cos)
699
  where
700 701 702 703 704 705 706 707 708
    go_tys _   []       = return []
    go_tys env (ty:tys) = (:) <$> go_ty env ty <*> go_tys env tys

    go_ty env (TyVarTy tv)    = tyvar env tv
    go_ty env (AppTy t1 t2)   = mkAppTy <$> go_ty env t1 <*> go_ty env t2
    go_ty _   ty@(LitTy {})   = return ty
    go_ty env (CastTy ty co)  = mkCastTy <$> go_ty env ty <*> go_co env co
    go_ty env (CoercionTy co) = CoercionTy <$> go_co env co

Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
709 710 711
    go_ty env ty@(FunTy _ w arg res)
      = do { w' <- go_ty env w; arg' <- go_ty env arg; res' <- go_ty env res
           ; return (ty { ft_mult = w', ft_arg = arg', ft_res = res' }) }
Simon Peyton Jones's avatar
Simon Peyton Jones committed
712

713
    go_ty env ty@(TyConApp tc tys)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
714
      | isTcTyCon tc
715
      = do { tc' <- tycon tc
716
           ; mkTyConApp tc' <$> go_tys env tys }
Simon Peyton Jones's avatar
Simon Peyton Jones committed
717 718 719 720 721 722

      -- Not a TcTyCon
      | null tys    -- Avoid allocation in this very
      = return ty   -- common case (E.g. Int, LiftedRep etc)

      | otherwise
723
      = mkTyConApp tc <$> go_tys env tys
Simon Peyton Jones's avatar
Simon Peyton Jones committed
724

725
    go_ty env (ForAllTy (Bndr tv vis) inner)
Ningning Xie's avatar
Ningning Xie committed
726
      = do { (env', tv') <- tycobinder env tv vis
727
           ; inner' <- go_ty env' inner
Ningning Xie's avatar
Ningning Xie committed
728
           ; return $ ForAllTy (Bndr tv' vis) inner' }
729

730 731 732 733 734 735 736 737 738
    go_cos _   []       = return []
    go_cos env (co:cos) = (:) <$> go_co env co <*> go_cos env cos

    go_mco _   MRefl    = return MRefl
    go_mco env (MCo co) = MCo <$> (go_co env co)

    go_co env (Refl ty)           = Refl <$> go_ty env ty
    go_co env (GRefl r ty mco)    = mkGReflCo r <$> go_ty env ty <*> go_mco env mco
    go_co env (AppCo c1 c2)       = mkAppCo <$> go_co env c1 <*> go_co env c2
Krzysztof Gogolewski's avatar
Krzysztof Gogolewski committed
739
    go_co env (FunCo r cw c1 c2)   = mkFunCo r <$> go_co env cw <*> go_co env c1 <*> go_co env c2
740 741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765
    go_co env (CoVarCo cv)        = covar env cv
    go_co env (HoleCo hole)       = cohole env hole
    go_co env (UnivCo p r t1 t2)  = mkUnivCo <$> go_prov env p <*> pure r
                                    <*> go_ty env t1 <*> go_ty env t2
    go_co env (SymCo co)          = mkSymCo <$> go_co env co
    go_co env (TransCo c1 c2)     = mkTransCo <$> go_co env c1 <*> go_co env c2
    go_co env (AxiomRuleCo r cos) = AxiomRuleCo r <$> go_cos env cos
    go_co env (NthCo r i co)      = mkNthCo r i <$> go_co env co
    go_co env (LRCo lr co)        = mkLRCo lr <$> go_co env co
    go_co env (InstCo co arg)     = mkInstCo <$> go_co env co <*> go_co env arg
    go_co env (KindCo co)         = mkKindCo <$> go_co env co
    go_co env (SubCo co)          = mkSubCo <$> go_co env co
    go_co env (AxiomInstCo ax i cos) = mkAxiomInstCo ax i <$> go_cos env cos
    go_co env co@(TyConAppCo r tc cos)
      | isTcTyCon tc
      = do { tc' <- tycon tc
           ; mkTyConAppCo r tc' <$> go_cos env cos }

      -- Not a TcTyCon
      | null cos    -- Avoid allocation in this very
      = return co   -- common case (E.g. Int, LiftedRep etc)

      | otherwise
      = mkTyConAppCo r tc <$> go_cos env cos
    go_co env (ForAllCo tv kind_co co)
      = do { kind_co' <- go_co env kind_co
Ningning Xie's avatar
Ningning Xie committed
766
           ; (env', tv') <- tycobinder env tv Inferred
767
           ; co' <- go_co env' co
768
           ; return $ mkForAllCo tv' kind_co' co' }
769 770 771 772 773
        -- See Note [Efficiency for ForAllCo case of mapTyCoX]

    go_prov env (PhantomProv co)    = PhantomProv <$> go_co env co
    go_prov env (ProofIrrelProv co) = ProofIrrelProv <$> go_co env co
    go_prov _   p@(PluginProv _)    = return p
774

775

776 777 778
{-
************************************************************************
*                                                                      *
779
\subsection{Constructor-specific functions}
780 781
*                                                                      *
************************************************************************
sof's avatar
sof committed
782 783


784
---------------------------------------------------------------------
ian@well-typed.com's avatar
ian@well-typed.com committed
785 786
                                TyVarTy
                                ~~~~~~~
787 788
-}

batterseapower's avatar
batterseapower committed
789 790
-- | 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'
791
getTyVar :: String -> Type -> TyVar
792
getTyVar msg ty = case getTyVar_maybe ty of
ian@well-typed.com's avatar
ian@well-typed.com committed
793 794
                    Just tv -> tv
                    Nothing -> panic ("getTyVar: " ++ msg)
795

796
isTyVarTy :: Type -> Bool
797 798
isTyVarTy ty = isJust (getTyVar_maybe ty)

batterseapower's avatar
batterseapower committed
799
-- | Attempts to obtain the type variable underlying a 'Type'
800
getTyVar_maybe :: Type -> Maybe TyVar
801
getTyVar_maybe = repGetTyVar_maybe . coreFullView
802 803

-- | If the type is a tyvar, possibly under a cast, returns it, along
Ningning Xie's avatar
Ningning Xie committed
804
-- with the coercion. Thus, the co is :: kind tv ~N kind ty
805
getCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)
806 807 808 809
getCastedTyVar_maybe ty = case coreFullView ty of
  CastTy (TyVarTy tv) co -> Just (tv, co)
  TyVarTy tv             -> Just (tv, mkReflCo Nominal (tyVarKind tv))
  _                      -> Nothing
810 811 812 813 814 815

-- | Attempts to obtain the type variable underlying a 'Type', without
-- any expansion
repGetTyVar_maybe :: Type -> Maybe TyVar
repGetTyVar_maybe (TyVarTy tv) = Just tv
repGetTyVar_maybe _            = Nothing
816

817
{-
818
---------------------------------------------------------------------
ian@well-typed.com's avatar
ian@well-typed.com committed
819 820 821
                                AppTy
                                ~~~~~
We need to be pretty careful with AppTy to make sure we obey the
822 823
invariant that a TyConApp is always visibly so.  mkAppTy maintains the
invariant: use it.
824 825 826 827 828

Note [Decomposing fat arrow c=>t]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Can we unify (a b) with (Eq a => ty)?   If we do so, we end up with
a partial application like ((=>) Eq a) which doesn't make sense in
Gabor Greif's avatar
Gabor Greif committed
829
source Haskell.  In contrast, we *can* unify (a b) with (t1 -> t2).
830
Here's an example (#9858) of how you might do it:
831 832 833 834 835 836 837 838 839 840 841
   i :: (Typeable a, Typeable b) => Proxy (a b) -> TypeRep
   i p = typeRep p

   j = i (Proxy :: Proxy (Eq Int => Int))
The type (Proxy (Eq Int => Int)) is only accepted with -XImpredicativeTypes,
but suppose we want that.  But then in the call to 'i', we end
up decomposing (Eq Int => Int), and we definitely don't want that.

This really only applies to the type checker; in Core, '=>' and '->'
are the same, as are 'Constraint' and '*'.  But for now I've put
the test in repSplitAppTy_maybe, which applies throughout, because
Sylvain Henry's avatar
Sylvain Henry committed
842
the other calls to splitAppTy are in GHC.Core.Unify, which is also used by
843
the type checker (e.g. when matching type-function equations).
844

845
-}
846

batterseapower's avatar
batterseapower committed
847
-- | Applies a type to another, as in e.g. @k a@
848
mkAppTy :: Type -> Type -> Type
849