-- (c) The University of Glasgow 2006
-- (c) The GRASP/AQUA Project, Glasgow University, 1998
--
-- Type - public interface

{-# LANGUAGE CPP, FlexibleContexts, PatternSynonyms, ViewPatterns, MultiWayIf #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

-- | Main functions for manipulating types and type-related things
module GHC.Core.Type (
        -- Note some of this is just re-exports from TyCon..

        -- * Main data types representing Types
        -- $type_classification

        -- $representation_types
        Type, ArgFlag(..), AnonArgFlag(..),
        Specificity(..),
        KindOrType, PredType, ThetaType,
        Var, TyVar, isTyVar, TyCoVar, TyCoBinder, TyCoVarBinder, TyVarBinder,
        Mult, Scaled,
        KnotTied,

        -- ** Constructing and deconstructing types
        mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe,
        getCastedTyVar_maybe, tyVarKind, varType,

        mkAppTy, mkAppTys, splitAppTy, splitAppTys, repSplitAppTys,
        splitAppTy_maybe, repSplitAppTy_maybe, tcRepSplitAppTy_maybe,

        mkFunTy, mkVisFunTy, mkInvisFunTy,
        mkVisFunTys,
        mkVisFunTyMany, mkInvisFunTyMany,
        mkVisFunTysMany, mkInvisFunTysMany,
        splitFunTy, splitFunTy_maybe,
        splitFunTys, funResultTy, funArgTy,

        mkTyConApp, mkTyConTy, tYPE,
        tyConAppTyCon_maybe, tyConAppTyConPicky_maybe,
        tyConAppArgs_maybe, tyConAppTyCon, tyConAppArgs,
        splitTyConApp_maybe, splitTyConApp, tyConAppArgN,
        tcSplitTyConApp_maybe,
        splitListTyConApp_maybe,
        repSplitTyConApp_maybe,
        tcRepSplitTyConApp_maybe,

        mkForAllTy, mkForAllTys, mkInvisForAllTys, mkTyCoInvForAllTys,
        mkSpecForAllTy, mkSpecForAllTys,
        mkVisForAllTys, mkTyCoInvForAllTy,
        mkInfForAllTy, mkInfForAllTys,
        splitForAllTyCoVars,
        splitForAllReqTVBinders, splitForAllInvisTVBinders,
        splitForAllTyCoVarBinders,
        splitForAllTyCoVar_maybe, splitForAllTyCoVar,
        splitForAllTyVar_maybe, splitForAllCoVar_maybe,
        splitPiTy_maybe, splitPiTy, splitPiTys,
        mkTyConBindersPreferAnon,
        mkPiTy, mkPiTys,
        piResultTy, piResultTys,
        applyTysX, dropForAlls,
        mkFamilyTyConApp,
        buildSynTyCon,

        mkNumLitTy, isNumLitTy,
        mkStrLitTy, isStrLitTy,
        mkCharLitTy, isCharLitTy,
        isLitTy,

        isPredTy,

        getRuntimeRep_maybe, kindRep_maybe, kindRep,

        mkCastTy, mkCoercionTy, splitCastTy_maybe,

        userTypeError_maybe, pprUserTypeErrorTy,

        coAxNthLHS,
        stripCoercionTy,

        splitInvisPiTys, splitInvisPiTysN,
        invisibleTyBndrCount,
        filterOutInvisibleTypes, filterOutInferredTypes,
        partitionInvisibleTypes, partitionInvisibles,
        tyConArgFlags, appTyArgFlags,

        -- ** Analyzing types
        TyCoMapper(..), mapTyCo, mapTyCoX,
        TyCoFolder(..), foldTyCo,

        -- (Newtypes)
        newTyConInstRhs,

        -- ** Binders
        sameVis,
        mkTyCoVarBinder, mkTyCoVarBinders,
        mkTyVarBinder, mkTyVarBinders,
        tyVarSpecToBinders,
        mkAnonBinder,
        isAnonTyCoBinder,
        binderVar, binderVars, binderType, binderArgFlag,
        tyCoBinderType, tyCoBinderVar_maybe,
        tyBinderType,
        binderRelevantType_maybe,
        isVisibleArgFlag, isInvisibleArgFlag, isVisibleBinder,
        isInvisibleBinder, isNamedBinder,
        tyConBindersTyCoBinders,

        -- ** Common type constructors
        funTyCon, unrestrictedFunTyCon,

        -- ** Predicates on types
        isTyVarTy, isFunTy, isCoercionTy,
        isCoercionTy_maybe, isForAllTy,
        isForAllTy_ty, isForAllTy_co,
        isPiTy, isTauTy, isFamFreeTy,
        isCoVarType, isAtomicTy,

        isValidJoinPointType,
        tyConAppNeedsKindSig,

        -- *** Levity and boxity
        isLiftedType_maybe,
        isLiftedTypeKind, isUnliftedTypeKind, isBoxedTypeKind, pickyIsLiftedTypeKind,
        isLiftedRuntimeRep, isUnliftedRuntimeRep, isBoxedRuntimeRep,
        isLiftedLevity, isUnliftedLevity,
        isUnliftedType, isBoxedType, mightBeUnliftedType, isUnboxedTupleType, isUnboxedSumType,
        isAlgType, isDataFamilyAppType,
        isPrimitiveType, isStrictType,
        isLevityTy, isLevityVar,
        isRuntimeRepTy, isRuntimeRepVar, isRuntimeRepKindedTy,
        dropRuntimeRepArgs,
        getRuntimeRep,

        -- * Multiplicity

        isMultiplicityTy, isMultiplicityVar,
        unrestricted, linear, tymult,
        mkScaled, irrelevantMult, scaledSet,
        pattern One, pattern Many,
        isOneDataConTy, isManyDataConTy,
        isLinearType,

        -- * Main data types representing Kinds
        Kind,

        -- ** Finding the kind of a type
        typeKind, tcTypeKind, isTypeLevPoly, resultIsLevPoly,
        tcIsLiftedTypeKind, tcIsConstraintKind, tcReturnsConstraintKind,
        tcIsBoxedTypeKind, tcIsRuntimeTypeKind,

        -- ** Common Kind
        liftedTypeKind, unliftedTypeKind,

        -- * Type free variables
        tyCoFVsOfType, tyCoFVsBndr, tyCoFVsVarBndr, tyCoFVsVarBndrs,
        tyCoVarsOfType, tyCoVarsOfTypes,
        tyCoVarsOfTypeDSet,
        coVarsOfType,
        coVarsOfTypes,

        anyFreeVarsOfType, anyFreeVarsOfTypes,
        noFreeVarsOfType,
        splitVisVarsOfType, splitVisVarsOfTypes,
        expandTypeSynonyms,
        typeSize, occCheckExpand,

        -- ** Closing over kinds
        closeOverKindsDSet, closeOverKindsList,
        closeOverKinds,

        -- * Well-scoped lists of variables
        scopedSort, tyCoVarsOfTypeWellScoped,
        tyCoVarsOfTypesWellScoped,

        -- * Type comparison
        eqType, eqTypeX, eqTypes, nonDetCmpType, nonDetCmpTypes, nonDetCmpTypeX,
        nonDetCmpTypesX, nonDetCmpTc,
        eqVarBndrs,

        -- * Forcing evaluation of types
        seqType, seqTypes,

        -- * Other views onto Types
        coreView, tcView,

        tyConsOfType,

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

        -- ** Manipulating type substitutions
        emptyTvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst,

        mkTCvSubst, zipTvSubst, mkTvSubstPrs,
        zipTCvSubst,
        notElemTCvSubst,
        getTvSubstEnv, setTvSubstEnv,
        zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs,
        extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
        extendTCvSubst, extendCvSubst,
        extendTvSubst, extendTvSubstBinderAndInScope,
        extendTvSubstList, extendTvSubstAndInScope,
        extendTCvSubstList,
        extendTvSubstWithClone,
        extendTCvSubstWithClone,
        isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,
        isEmptyTCvSubst, unionTCvSubst,

        -- ** Performing substitution on types and kinds
        substTy, substTys, substScaledTy, substScaledTys, substTyWith, substTysWith, substTheta,
        substTyAddInScope,
        substTyUnchecked, substTysUnchecked, substScaledTyUnchecked, substScaledTysUnchecked,
        substThetaUnchecked, substTyWithUnchecked,
        substCoUnchecked, substCoWithUnchecked,
        substTyVarBndr, substTyVarBndrs, substTyVar, substTyVars,
        substVarBndr, substVarBndrs,
        substTyCoBndr,
        cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar,

        -- * Tidying type related things up for printing
        tidyType,      tidyTypes,
        tidyOpenType,  tidyOpenTypes,
        tidyOpenKind,
        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars,
        tidyOpenTyCoVar, tidyOpenTyCoVars,
        tidyTyCoVarOcc,
        tidyTopType,
        tidyKind,
        tidyTyCoVarBinder, tidyTyCoVarBinders,

        -- * Kinds
        isConstraintKindCon,
        classifiesTypeWithValues,
        isKindLevPoly
    ) where

#include "HsVersions.h"

import GHC.Prelude

import GHC.Types.Basic

-- We import the representation and primitive functions from GHC.Core.TyCo.Rep.
-- Many things are reexported, but not the representation!

import GHC.Core.TyCo.Rep
import GHC.Core.TyCo.Subst
import GHC.Core.TyCo.Tidy
import GHC.Core.TyCo.FVs

-- friends:
import GHC.Types.Var
import GHC.Types.Var.Env
import GHC.Types.Var.Set
import GHC.Types.Unique.Set

import GHC.Core.TyCon
import GHC.Builtin.Types.Prim
import {-# SOURCE #-} GHC.Builtin.Types
                                 ( charTy, naturalTy, listTyCon
                                 , typeSymbolKind, liftedTypeKind, unliftedTypeKind
                                 , liftedRepTyCon, unliftedRepTyCon
                                 , constraintKind
                                 , unrestrictedFunTyCon
                                 , manyDataConTy, oneDataConTy )
import GHC.Types.Name( Name )
import GHC.Builtin.Names
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
   , mkKindCo, mkSubCo
   , decomposePiCos, coercionKind, coercionLKind
   , coercionRKind, coercionType
   , isReflexiveCo, seqCo )

-- others
import GHC.Utils.Misc
import GHC.Utils.FV
import GHC.Utils.Outputable
import GHC.Utils.Panic
import GHC.Data.FastString
import GHC.Data.Pair
import GHC.Data.List.SetOps
import GHC.Types.Unique ( nonDetCmpUnique )

import GHC.Data.Maybe   ( orElse, expectJust )
import Data.Maybe       ( isJust )
import Control.Monad    ( guard )

-- $type_classification
-- #type_classification#
--
-- Types are any, but at least one, of:
--
-- [Boxed]              Iff its representation is a pointer to an object on the
--                      GC'd heap. Operationally, heap objects can be entered as
--                      a means of evaluation.
--
-- [Lifted]             Iff it has bottom as an element: An instance of a
--                      lifted type might diverge when evaluated.
--                      GHC Haskell's unboxed types are unlifted.
--                      An unboxed, but lifted type is not very useful.
--                      (Example: A byte-represented type, where evaluating 0xff
--                      computes the 12345678th collatz number modulo 0xff.)
--                      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. There are algebraic types that
--                      are not lifted types, like unlifted data types or
--                      unboxed tuples.
--
-- [Data]               Iff it is a type declared with @data@, or a boxed tuple.
--                      There are also /unlifted/ data types.
--
-- [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 \#) Yes             No              No              Yes
-- (  a, b  )    No              Yes             Yes             Yes
-- [a]           No              Yes             Yes             Yes
-- @

-- $representation_types
-- A /source type/ is a type that is a separate type as far as the type checker is
-- concerned, but which has a more low-level representation as far as Core-to-Core
-- passes and the rest of the back end is concerned.
--
-- 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 its abilities. If you don't want this
-- to happen, use the equivalent functions from the "TcType" module.

{-
************************************************************************
*                                                                      *
                Type representation
*                                                                      *
************************************************************************

Note [coreView vs tcView]
~~~~~~~~~~~~~~~~~~~~~~~~~
So far as the typechecker is concerned, 'Constraint' and 'TYPE
LiftedRep' are distinct kinds.

But in Core these two are treated as identical.

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. Accordingly, tcView is used in type-checker-oriented
functions (including the pure unifier, used in instance resolution),
while coreView is used during e.g. optimisation passes.

See also #11715, which tracks removing this inconsistency.

The inconsistency actually leads to a potential soundness bug, in that
Constraint and Type are considered *apart* by the type family engine.
To wit, we can write

  type family F a
  type instance F Type = Bool
  type instance F Constraint = Int

and (because Type ~# Constraint in Core), thus build a coercion between
Int and Bool. I (Richard E) conjecture that this never happens in practice,
but it's very uncomfortable. This, essentially, is the root problem
underneath #11715, which is quite resistant to an easy fix. The best
idea is to have roles in kind coercions, but that has yet to be implemented.
See also "A Role for Dependent Types in Haskell", ICFP 2019, which describes
how roles in kinds might work out.

-}

-- | Gives the typechecker view of a type. This unwraps synonyms but
-- leaves 'Constraint' alone. c.f. 'coreView', which turns 'Constraint' into
-- 'Type'. Returns 'Nothing' if no unwrapping happens.
-- See also Note [coreView vs tcView]
tcView :: Type -> Maybe Type
tcView :: Type -> Maybe Type
tcView (TyConApp TyCon
tc [Type]
tys)
  | res :: Maybe Type
res@(Just Type
_) <- TyCon -> [Type] -> Maybe Type
expandSynTyConApp_maybe TyCon
tc [Type]
tys
  = Maybe Type
res
tcView Type
_ = forall a. Maybe a
Nothing
-- See Note [Inlining coreView].
{-# INLINE tcView #-}

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@.
--
-- By being non-recursive and inlined, this case analysis gets efficiently
-- joined onto the case analysis that the caller is already doing
coreView :: Type -> Maybe Type
coreView ty :: Type
ty@(TyConApp TyCon
tc [Type]
tys)
  | res :: Maybe Type
res@(Just Type
_) <- TyCon -> [Type] -> Maybe Type
expandSynTyConApp_maybe TyCon
tc [Type]
tys
  = Maybe Type
res

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

coreView Type
_ = forall a. Maybe a
Nothing
-- See Note [Inlining coreView].
{-# INLINE coreView #-}

-----------------------------------------------

-- | @expandSynTyConApp_maybe tc tys@ expands the RHS of type synonym @tc@
-- instantiated at arguments @tys@, or returns 'Nothing' if @tc@ is not a
-- synonym.
expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type
expandSynTyConApp_maybe :: TyCon -> [Type] -> Maybe Type
expandSynTyConApp_maybe TyCon
tc [Type]
tys
  | Just ([TyVar]
tvs, Type
rhs) <- TyCon -> Maybe ([TyVar], Type)
synTyConDefn_maybe TyCon
tc
  , [Type]
tys forall a. [a] -> Int -> Bool
`lengthAtLeast` Int
arity
  = forall a. a -> Maybe a
Just (Int -> [TyVar] -> Type -> [Type] -> Type
expand_syn Int
arity [TyVar]
tvs Type
rhs [Type]
tys)
  | Bool
otherwise
  = forall a. Maybe a
Nothing
  where
    arity :: Int
arity = TyCon -> Int
tyConArity TyCon
tc
-- Without this INLINE the call to expandSynTyConApp_maybe in coreView
-- will result in an avoidable allocation.
{-# INLINE expandSynTyConApp_maybe #-}

-- | A helper for 'expandSynTyConApp_maybe' to avoid inlining this cold path
-- into call-sites.
expand_syn :: Int      -- ^ the arity of the synonym
           -> [TyVar]  -- ^ the variables bound by the synonym
           -> Type     -- ^ the RHS of the synonym
           -> [Type]   -- ^ the type arguments the synonym is instantiated at.
           -> Type
expand_syn :: Int -> [TyVar] -> Type -> [Type] -> Type
expand_syn Int
arity [TyVar]
tvs Type
rhs [Type]
tys
  | [Type]
tys forall a. [a] -> Int -> Bool
`lengthExceeds` Int
arity = Type -> [Type] -> Type
mkAppTys Type
rhs' (forall a. Int -> [a] -> [a]
drop Int
arity [Type]
tys)
  | Bool
otherwise                 = Type
rhs'
  where
    rhs' :: Type
rhs' = HasCallStack => TCvSubst -> Type -> Type
substTy ([(TyVar, Type)] -> TCvSubst
mkTvSubstPrs ([TyVar]
tvs forall a b. [a] -> [b] -> [(a, b)]
`zip` [Type]
tys)) Type
rhs
               -- The free vars of 'rhs' should all be bound by 'tenv', so it's
               -- ok to use 'substTy' here (which is what expandSynTyConApp_maybe does).
               -- See also Note [The substitution invariant] in GHC.Core.TyCo.Subst.
               -- Its important to use mkAppTys, rather than (foldl AppTy),
               -- because the function part might well return a
               -- partially-applied type constructor; indeed, usually will!
-- We never want to inline this cold-path.
{-# INLINE expand_syn #-}

coreFullView :: Type -> Type
-- ^ Iterates 'coreView' until there is no more to synonym to expand.
-- See Note [Inlining coreView].
coreFullView :: Type -> Type
coreFullView ty :: Type
ty@(TyConApp TyCon
tc [Type]
_)
  | TyCon -> Bool
isTypeSynonymTyCon TyCon
tc Bool -> Bool -> Bool
|| TyCon -> Bool
isConstraintKindCon TyCon
tc = Type -> Type
go Type
ty
  where
    go :: Type -> Type
go Type
ty
      | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Type
go Type
ty'
      | Bool
otherwise = Type
ty

coreFullView Type
ty = Type
ty
{-# INLINE coreFullView #-}

{- Note [Inlining coreView]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
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.
-}

-----------------------------------------------
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' only expands out type synonyms mentioned in the type,
-- not in the kinds of any TyCon or TyVar mentioned in the type.
--
-- Keep this synchronized with 'synonymTyConsOfType'
expandTypeSynonyms :: Type -> Type
expandTypeSynonyms Type
ty
  = TCvSubst -> Type -> Type
go (InScopeSet -> TCvSubst
mkEmptyTCvSubst InScopeSet
in_scope) Type
ty
  where
    in_scope :: InScopeSet
in_scope = TyCoVarSet -> InScopeSet
mkInScopeSet (Type -> TyCoVarSet
tyCoVarsOfType Type
ty)

    go :: TCvSubst -> Type -> Type
go TCvSubst
subst (TyConApp TyCon
tc [Type]
tys)
      | Just ([(TyVar, Type)]
tenv, Type
rhs, [Type]
tys') <- forall tyco.
TyCon -> [tyco] -> Maybe ([(TyVar, tyco)], Type, [tyco])
expandSynTyCon_maybe TyCon
tc [Type]
expanded_tys
      = let subst' :: TCvSubst
subst' = InScopeSet -> TvSubstEnv -> TCvSubst
mkTvSubst InScopeSet
in_scope (forall a. [(TyVar, a)] -> VarEnv a
mkVarEnv [(TyVar, Type)]
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
            -- (#11665)
        in  Type -> [Type] -> Type
mkAppTys (TCvSubst -> Type -> Type
go TCvSubst
subst' Type
rhs) [Type]
tys'
      | Bool
otherwise
      = TyCon -> [Type] -> Type
TyConApp TyCon
tc [Type]
expanded_tys
      where
        expanded_tys :: [Type]
expanded_tys = (forall a b. (a -> b) -> [a] -> [b]
map (TCvSubst -> Type -> Type
go TCvSubst
subst) [Type]
tys)

    go TCvSubst
_     (LitTy TyLit
l)     = TyLit -> Type
LitTy TyLit
l
    go TCvSubst
subst (TyVarTy TyVar
tv)  = TCvSubst -> TyVar -> Type
substTyVar TCvSubst
subst TyVar
tv
    go TCvSubst
subst (AppTy Type
t1 Type
t2) = Type -> Type -> Type
mkAppTy (TCvSubst -> Type -> Type
go TCvSubst
subst Type
t1) (TCvSubst -> Type -> Type
go TCvSubst
subst Type
t2)
    go TCvSubst
subst ty :: Type
ty@(FunTy AnonArgFlag
_ Type
mult Type
arg Type
res)
      = Type
ty { ft_mult :: Type
ft_mult = TCvSubst -> Type -> Type
go TCvSubst
subst Type
mult, ft_arg :: Type
ft_arg = TCvSubst -> Type -> Type
go TCvSubst
subst Type
arg, ft_res :: Type
ft_res = TCvSubst -> Type -> Type
go TCvSubst
subst Type
res }
    go TCvSubst
subst (ForAllTy (Bndr TyVar
tv ArgFlag
vis) Type
t)
      = let (TCvSubst
subst', TyVar
tv') = (TCvSubst -> Type -> Type)
-> TCvSubst -> TyVar -> (TCvSubst, TyVar)
substVarBndrUsing TCvSubst -> Type -> Type
go TCvSubst
subst TyVar
tv in
        VarBndr TyVar ArgFlag -> Type -> Type
ForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv' ArgFlag
vis) (TCvSubst -> Type -> Type
go TCvSubst
subst' Type
t)
    go TCvSubst
subst (CastTy Type
ty KindCoercion
co)  = Type -> KindCoercion -> Type
mkCastTy (TCvSubst -> Type -> Type
go TCvSubst
subst Type
ty) (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)
    go TCvSubst
subst (CoercionTy KindCoercion
co) = KindCoercion -> Type
mkCoercionTy (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)

    go_mco :: TCvSubst -> MCoercionN -> MCoercionN
go_mco TCvSubst
_     MCoercionN
MRefl    = MCoercionN
MRefl
    go_mco TCvSubst
subst (MCo KindCoercion
co) = KindCoercion -> MCoercionN
MCo (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)

    go_co :: TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst (Refl Type
ty)
      = Type -> KindCoercion
mkNomReflCo (TCvSubst -> Type -> Type
go TCvSubst
subst Type
ty)
    go_co TCvSubst
subst (GRefl Role
r Type
ty MCoercionN
mco)
      = Role -> Type -> MCoercionN -> KindCoercion
mkGReflCo Role
r (TCvSubst -> Type -> Type
go TCvSubst
subst Type
ty) (TCvSubst -> MCoercionN -> MCoercionN
go_mco TCvSubst
subst MCoercionN
mco)
       -- NB: coercions are always expanded upon creation
    go_co TCvSubst
subst (TyConAppCo Role
r TyCon
tc [KindCoercion]
args)
      = HasDebugCallStack =>
Role -> TyCon -> [KindCoercion] -> KindCoercion
mkTyConAppCo Role
r TyCon
tc (forall a b. (a -> b) -> [a] -> [b]
map (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst) [KindCoercion]
args)
    go_co TCvSubst
subst (AppCo KindCoercion
co KindCoercion
arg)
      = KindCoercion -> KindCoercion -> KindCoercion
mkAppCo (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co) (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
arg)
    go_co TCvSubst
subst (ForAllCo TyVar
tv KindCoercion
kind_co KindCoercion
co)
      = let (TCvSubst
subst', TyVar
tv', KindCoercion
kind_co') = TCvSubst
-> TyVar -> KindCoercion -> (TCvSubst, TyVar, KindCoercion)
go_cobndr TCvSubst
subst TyVar
tv KindCoercion
kind_co in
        TyVar -> KindCoercion -> KindCoercion -> KindCoercion
mkForAllCo TyVar
tv' KindCoercion
kind_co' (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst' KindCoercion
co)
    go_co TCvSubst
subst (FunCo Role
r KindCoercion
w KindCoercion
co1 KindCoercion
co2)
      = Role
-> KindCoercion -> KindCoercion -> KindCoercion -> KindCoercion
mkFunCo Role
r (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
w) (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co1) (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co2)
    go_co TCvSubst
subst (CoVarCo TyVar
cv)
      = TCvSubst -> TyVar -> KindCoercion
substCoVar TCvSubst
subst TyVar
cv
    go_co TCvSubst
subst (AxiomInstCo CoAxiom Branched
ax Int
ind [KindCoercion]
args)
      = CoAxiom Branched -> Int -> [KindCoercion] -> KindCoercion
mkAxiomInstCo CoAxiom Branched
ax Int
ind (forall a b. (a -> b) -> [a] -> [b]
map (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst) [KindCoercion]
args)
    go_co TCvSubst
subst (UnivCo UnivCoProvenance
p Role
r Type
t1 Type
t2)
      = UnivCoProvenance -> Role -> Type -> Type -> KindCoercion
mkUnivCo (TCvSubst -> UnivCoProvenance -> UnivCoProvenance
go_prov TCvSubst
subst UnivCoProvenance
p) Role
r (TCvSubst -> Type -> Type
go TCvSubst
subst Type
t1) (TCvSubst -> Type -> Type
go TCvSubst
subst Type
t2)
    go_co TCvSubst
subst (SymCo KindCoercion
co)
      = KindCoercion -> KindCoercion
mkSymCo (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)
    go_co TCvSubst
subst (TransCo KindCoercion
co1 KindCoercion
co2)
      = KindCoercion -> KindCoercion -> KindCoercion
mkTransCo (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co1) (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co2)
    go_co TCvSubst
subst (NthCo Role
r Int
n KindCoercion
co)
      = HasDebugCallStack => Role -> Int -> KindCoercion -> KindCoercion
mkNthCo Role
r Int
n (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)
    go_co TCvSubst
subst (LRCo LeftOrRight
lr KindCoercion
co)
      = LeftOrRight -> KindCoercion -> KindCoercion
mkLRCo LeftOrRight
lr (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)
    go_co TCvSubst
subst (InstCo KindCoercion
co KindCoercion
arg)
      = KindCoercion -> KindCoercion -> KindCoercion
mkInstCo (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co) (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
arg)
    go_co TCvSubst
subst (KindCo KindCoercion
co)
      = KindCoercion -> KindCoercion
mkKindCo (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)
    go_co TCvSubst
subst (SubCo KindCoercion
co)
      = HasDebugCallStack => KindCoercion -> KindCoercion
mkSubCo (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)
    go_co TCvSubst
subst (AxiomRuleCo CoAxiomRule
ax [KindCoercion]
cs)
      = CoAxiomRule -> [KindCoercion] -> KindCoercion
AxiomRuleCo CoAxiomRule
ax (forall a b. (a -> b) -> [a] -> [b]
map (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst) [KindCoercion]
cs)
    go_co TCvSubst
_ (HoleCo CoercionHole
h)
      = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"expandTypeSynonyms hit a hole" (forall a. Outputable a => a -> SDoc
ppr CoercionHole
h)

    go_prov :: TCvSubst -> UnivCoProvenance -> UnivCoProvenance
go_prov TCvSubst
subst (PhantomProv KindCoercion
co)    = KindCoercion -> UnivCoProvenance
PhantomProv (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)
    go_prov TCvSubst
subst (ProofIrrelProv KindCoercion
co) = KindCoercion -> UnivCoProvenance
ProofIrrelProv (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst KindCoercion
co)
    go_prov TCvSubst
_     p :: UnivCoProvenance
p@(PluginProv String
_)    = UnivCoProvenance
p
    go_prov TCvSubst
_     p :: UnivCoProvenance
p@(CorePrepProv Bool
_)  = UnivCoProvenance
p

      -- the "False" and "const" are to accommodate the type of
      -- substForAllCoBndrUsing, which is general enough to
      -- handle coercion optimization (which sometimes swaps the
      -- order of a coercion)
    go_cobndr :: TCvSubst
-> TyVar -> KindCoercion -> (TCvSubst, TyVar, KindCoercion)
go_cobndr TCvSubst
subst = Bool
-> (KindCoercion -> KindCoercion)
-> TCvSubst
-> TyVar
-> KindCoercion
-> (TCvSubst, TyVar, KindCoercion)
substForAllCoBndrUsing Bool
False (TCvSubst -> KindCoercion -> KindCoercion
go_co TCvSubst
subst) TCvSubst
subst

-- | An INLINE helper for function such as 'kindRep_maybe' below.
--
-- @isTyConKeyApp_maybe key ty@ returns @Just tys@ iff
-- the type @ty = T tys@, where T's unique = key
isTyConKeyApp_maybe :: Unique -> Type -> Maybe [Type]
isTyConKeyApp_maybe :: Unique -> Type -> Maybe [Type]
isTyConKeyApp_maybe Unique
key Type
ty
  | TyConApp TyCon
tc [Type]
args <- Type -> Type
coreFullView Type
ty
  , TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
key
  = forall a. a -> Maybe a
Just [Type]
args
  | Bool
otherwise
  = forall a. Maybe a
Nothing
{-# INLINE isTyConKeyApp_maybe #-}

-- | 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 :: HasDebugCallStack => Type -> Type
kindRep Type
k = case HasDebugCallStack => Type -> Maybe Type
kindRep_maybe Type
k of
              Just Type
r  -> Type
r
              Maybe Type
Nothing -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"kindRep" (forall a. Outputable a => a -> SDoc
ppr Type
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 :: HasDebugCallStack => Type -> Maybe Type
kindRep_maybe Type
kind
  | Just [Type
arg] <- Unique -> Type -> Maybe [Type]
isTyConKeyApp_maybe Unique
tYPETyConKey Type
kind = forall a. a -> Maybe a
Just Type
arg
  | Bool
otherwise                                           = forall a. Maybe a
Nothing

-- | Returns True if the kind classifies types which are allocated on
-- the GC'd heap and False otherwise. Note that this returns False for
-- levity-polymorphic kinds, which may be specialized to a kind that
-- classifies AddrRep or even unboxed kinds.
isBoxedTypeKind :: Kind -> Bool
isBoxedTypeKind :: Type -> Bool
isBoxedTypeKind Type
kind
  = case HasDebugCallStack => Type -> Maybe Type
kindRep_maybe Type
kind of
      Just Type
rep -> Type -> Bool
isBoxedRuntimeRep Type
rep
      Maybe Type
Nothing  -> Bool
False

-- | 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 :: Type -> Bool
isLiftedTypeKind Type
kind
  = case HasDebugCallStack => Type -> Maybe Type
kindRep_maybe Type
kind of
      Just Type
rep -> Type -> Bool
isLiftedRuntimeRep Type
rep
      Maybe Type
Nothing  -> Bool
False

pickyIsLiftedTypeKind :: Kind -> Bool
-- Checks whether the kind is literally
--      TYPE LiftedRep
-- or   TYPE ('BoxedRep 'Lifted)
-- or   Type
-- without expanding type synonyms or anything
-- Used only when deciding whether to suppress the ":: *" in
-- (a :: *) when printing kinded type variables
-- See Note [Suppressing * kinds] in GHC.Core.TyCo.Ppr
pickyIsLiftedTypeKind :: Type -> Bool
pickyIsLiftedTypeKind Type
kind
  | TyConApp TyCon
tc [Type
arg] <- Type
kind
  , TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
tYPETyConKey
  , TyConApp TyCon
rr_tc [Type]
rr_args <- Type
arg = case [Type]
rr_args of
      [] -> TyCon
rr_tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
liftedRepTyConKey
      [Type
rr_arg]
        | TyCon
rr_tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
boxedRepDataConKey
        , TyConApp TyCon
lev [] <- Type
rr_arg
        , TyCon
lev forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
liftedDataConKey -> Bool
True
      [Type]
_ -> Bool
False
  | TyConApp TyCon
tc [] <- Type
kind
  , TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
liftedTypeKindTyConKey = Bool
True
  | Bool
otherwise                          = Bool
False

-- | Returns True if the kind classifies unlifted types (like 'Int#') 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 :: Type -> Bool
isUnliftedTypeKind Type
kind
  = case HasDebugCallStack => Type -> Maybe Type
kindRep_maybe Type
kind of
      Just Type
rep -> Type -> Bool
isUnliftedRuntimeRep Type
rep
      Maybe Type
Nothing  -> Bool
False

-- | See 'isBoxedRuntimeRep_maybe'.
isBoxedRuntimeRep :: Type -> Bool
isBoxedRuntimeRep :: Type -> Bool
isBoxedRuntimeRep Type
rep = forall a. Maybe a -> Bool
isJust (Type -> Maybe Type
isBoxedRuntimeRep_maybe Type
rep)

-- | `isBoxedRuntimeRep_maybe (rep :: RuntimeRep)` returns `Just lev` if `rep`
-- expands to `Boxed lev` and returns `Nothing` otherwise.
--
-- Types with this runtime rep are represented by pointers on the GC'd heap.
isBoxedRuntimeRep_maybe :: Type -> Maybe Type
isBoxedRuntimeRep_maybe :: Type -> Maybe Type
isBoxedRuntimeRep_maybe Type
rep
  | Just [Type
lev] <- Unique -> Type -> Maybe [Type]
isTyConKeyApp_maybe Unique
boxedRepDataConKey Type
rep
  = forall a. a -> Maybe a
Just Type
lev
  | Bool
otherwise
  = forall a. Maybe a
Nothing

isLiftedRuntimeRep :: Type -> Bool
-- isLiftedRuntimeRep is true of LiftedRep :: RuntimeRep
-- False of type variables (a :: RuntimeRep)
--   and of other reps e.g. (IntRep :: RuntimeRep)
isLiftedRuntimeRep :: Type -> Bool
isLiftedRuntimeRep Type
rep
  | Just [Type
lev] <- Unique -> Type -> Maybe [Type]
isTyConKeyApp_maybe Unique
boxedRepDataConKey Type
rep
  = Type -> Bool
isLiftedLevity Type
lev
  | Bool
otherwise
  = Bool
False

isUnliftedRuntimeRep :: Type -> Bool
-- PRECONDITION: The type has kind RuntimeRep
-- True of definitely-unlifted RuntimeReps
-- False of           (LiftedRep :: RuntimeRep)
--   and of variables (a :: RuntimeRep)
isUnliftedRuntimeRep :: Type -> Bool
isUnliftedRuntimeRep Type
rep
  | TyConApp TyCon
rr_tc [Type]
args <- Type -> Type
coreFullView Type
rep -- NB: args might be non-empty
                                            --     e.g. TupleRep [r1, .., rn]
  , TyCon -> Bool
isPromotedDataCon TyCon
rr_tc =
      -- NB: args might be non-empty e.g. TupleRep [r1, .., rn]
      if (TyCon
rr_tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
boxedRepDataConKey)
        then case [Type]
args of
          [Type
lev] -> Type -> Bool
isUnliftedLevity Type
lev
          [Type]
_     -> Bool
False
        else Bool
True
        -- 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,
        -- hence the isPromotedDataCon rr_tc
isUnliftedRuntimeRep Type
_ = Bool
False

-- | An INLINE helper for function such as 'isLiftedRuntimeRep' below.
isNullaryTyConKeyApp :: Unique -> Type -> Bool
isNullaryTyConKeyApp :: Unique -> Type -> Bool
isNullaryTyConKeyApp Unique
key Type
ty
  | Just [Type]
args <- Unique -> Type -> Maybe [Type]
isTyConKeyApp_maybe Unique
key Type
ty
  = ASSERT( null args ) True
  | Bool
otherwise
  = Bool
False
{-# INLINE isNullaryTyConKeyApp #-}

isLiftedLevity :: Type -> Bool
isLiftedLevity :: Type -> Bool
isLiftedLevity = Unique -> Type -> Bool
isNullaryTyConKeyApp Unique
liftedDataConKey

isUnliftedLevity :: Type -> Bool
isUnliftedLevity :: Type -> Bool
isUnliftedLevity = Unique -> Type -> Bool
isNullaryTyConKeyApp Unique
unliftedDataConKey

-- | Is this the type 'Levity'?
isLevityTy :: Type -> Bool
isLevityTy :: Type -> Bool
isLevityTy = Unique -> Type -> Bool
isNullaryTyConKeyApp Unique
levityTyConKey

-- | Is this the type 'RuntimeRep'?
isRuntimeRepTy :: Type -> Bool
isRuntimeRepTy :: Type -> Bool
isRuntimeRepTy = Unique -> Type -> Bool
isNullaryTyConKeyApp Unique
runtimeRepTyConKey

-- | Is a tyvar of type 'RuntimeRep'?
isRuntimeRepVar :: TyVar -> Bool
isRuntimeRepVar :: TyVar -> Bool
isRuntimeRepVar = Type -> Bool
isRuntimeRepTy forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> Type
tyVarKind

-- | Is a tyvar of type 'Levity'?
isLevityVar :: TyVar -> Bool
isLevityVar :: TyVar -> Bool
isLevityVar = Type -> Bool
isLevityTy forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> Type
tyVarKind

-- | Is this the type 'Multiplicity'?
isMultiplicityTy :: Type -> Bool
isMultiplicityTy :: Type -> Bool
isMultiplicityTy  = Unique -> Type -> Bool
isNullaryTyConKeyApp Unique
multiplicityTyConKey

-- | Is a tyvar of type 'Multiplicity'?
isMultiplicityVar :: TyVar -> Bool
isMultiplicityVar :: TyVar -> Bool
isMultiplicityVar = Type -> Bool
isMultiplicityTy forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> Type
tyVarKind

{- *********************************************************************
*                                                                      *
               mapType
*                                                                      *
************************************************************************

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

Note [Efficiency for ForAllCo case of mapTyCoX]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
As noted in Note [Forall coercions] in GHC.Core.TyCo.Rep, a ForAllCo is a bit redundant.
It stores a TyCoVar and a Coercion, where the kind of the TyCoVar always matches
the left-hand kind of the coercion. This is convenient lots of the time, but
not when mapping a function over a coercion.

The problem is that tcm_tybinder will affect the TyCoVar's kind and
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]
~~~~~~~~~~~~~~~~~~~~~~~~~~~
These INLINE pragmas are indispensable. mapTyCo and mapTyCoX are used
to implement zonking, and it's vital that they get specialised to the TcM
monad and the particular mapper in use.

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

See Note [Specialising foldType] in "GHC.Core.TyCo.Rep" for more details of this
idiom.
-}

-- | This describes how a "map" operation over a type/coercion should behave
data TyCoMapper env m
  = TyCoMapper
      { forall env (m :: * -> *).
TyCoMapper env m -> env -> TyVar -> m Type
tcm_tyvar :: env -> TyVar -> m Type
      , forall env (m :: * -> *).
TyCoMapper env m -> env -> TyVar -> m KindCoercion
tcm_covar :: env -> CoVar -> m Coercion
      , forall env (m :: * -> *).
TyCoMapper env m -> env -> CoercionHole -> m KindCoercion
tcm_hole  :: env -> CoercionHole -> m Coercion
          -- ^ What to do with coercion holes.
          -- See Note [Coercion holes] in "GHC.Core.TyCo.Rep".

      , forall env (m :: * -> *).
TyCoMapper env m -> env -> TyVar -> ArgFlag -> m (env, TyVar)
tcm_tycobinder :: env -> TyCoVar -> ArgFlag -> m (env, TyCoVar)
          -- ^ The returned env is used in the extended scope

      , forall env (m :: * -> *). TyCoMapper env m -> TyCon -> m TyCon
tcm_tycon :: TyCon -> m TyCon
          -- ^ 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]
          --    in "GHC.Tc.TyCl"
      }

{-# INLINE mapTyCo #-}  -- See Note [Specialising mappers]
mapTyCo :: Monad m => TyCoMapper () m
         -> ( Type       -> m Type
            , [Type]     -> m [Type]
            , Coercion   -> m Coercion
            , [Coercion] -> m[Coercion])
mapTyCo :: forall (m :: * -> *).
Monad m =>
TyCoMapper () m
-> (Type -> m Type, [Type] -> m [Type],
    KindCoercion -> m KindCoercion, [KindCoercion] -> m [KindCoercion])
mapTyCo TyCoMapper () m
mapper
  = case forall (m :: * -> *) env.
Monad m =>
TyCoMapper env m
-> (env -> Type -> m Type, env -> [Type] -> m [Type],
    env -> KindCoercion -> m KindCoercion,
    env -> [KindCoercion] -> m [KindCoercion])
mapTyCoX TyCoMapper () m
mapper of
     (() -> Type -> m Type
go_ty, () -> [Type] -> m [Type]
go_tys, () -> KindCoercion -> m KindCoercion
go_co, () -> [KindCoercion] -> m [KindCoercion]
go_cos)
        -> (() -> Type -> m Type
go_ty (), () -> [Type] -> m [Type]
go_tys (), () -> KindCoercion -> m KindCoercion
go_co (), () -> [KindCoercion] -> m [KindCoercion]
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 :: forall (m :: * -> *) env.
Monad m =>
TyCoMapper env m
-> (env -> Type -> m Type, env -> [Type] -> m [Type],
    env -> KindCoercion -> m KindCoercion,
    env -> [KindCoercion] -> m [KindCoercion])
mapTyCoX (TyCoMapper { tcm_tyvar :: forall env (m :: * -> *).
TyCoMapper env m -> env -> TyVar -> m Type
tcm_tyvar = env -> TyVar -> m Type
tyvar
                     , tcm_tycobinder :: forall env (m :: * -> *).
TyCoMapper env m -> env -> TyVar -> ArgFlag -> m (env, TyVar)
tcm_tycobinder = env -> TyVar -> ArgFlag -> m (env, TyVar)
tycobinder
                     , tcm_tycon :: forall env (m :: * -> *). TyCoMapper env m -> TyCon -> m TyCon
tcm_tycon = TyCon -> m TyCon
tycon
                     , tcm_covar :: forall env (m :: * -> *).
TyCoMapper env m -> env -> TyVar -> m KindCoercion
tcm_covar = env -> TyVar -> m KindCoercion
covar
                     , tcm_hole :: forall env (m :: * -> *).
TyCoMapper env m -> env -> CoercionHole -> m KindCoercion
tcm_hole = env -> CoercionHole -> m KindCoercion
cohole })
  = (env -> Type -> m Type
go_ty, env -> [Type] -> m [Type]
go_tys, env -> KindCoercion -> m KindCoercion
go_co, env -> [KindCoercion] -> m [KindCoercion]
go_cos)
  where
    go_tys :: env -> [Type] -> m [Type]
go_tys env
_   []       = forall (m :: * -> *) a. Monad m => a -> m a
return []
    go_tys env
env (Type
ty:[Type]
tys) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> Type -> m Type
go_ty env
env Type
ty forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> [Type] -> m [Type]
go_tys env
env [Type]
tys

    go_ty :: env -> Type -> m Type
go_ty env
env (TyVarTy TyVar
tv)    = env -> TyVar -> m Type
tyvar env
env TyVar
tv
    go_ty env
env (AppTy Type
t1 Type
t2)   = Type -> Type -> Type
mkAppTy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> Type -> m Type
go_ty env
env Type
t1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> Type -> m Type
go_ty env
env Type
t2
    go_ty env
_   ty :: Type
ty@(LitTy {})   = forall (m :: * -> *) a. Monad m => a -> m a
return Type
ty
    go_ty env
env (CastTy Type
ty KindCoercion
co)  = Type -> KindCoercion -> Type
mkCastTy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> Type -> m Type
go_ty env
env Type
ty forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co
    go_ty env
env (CoercionTy KindCoercion
co) = KindCoercion -> Type
CoercionTy forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co

    go_ty env
env ty :: Type
ty@(FunTy AnonArgFlag
_ Type
w Type
arg Type
res)
      = do { Type
w' <- env -> Type -> m Type
go_ty env
env Type
w; Type
arg' <- env -> Type -> m Type
go_ty env
env Type
arg; Type
res' <- env -> Type -> m Type
go_ty env
env Type
res
           ; forall (m :: * -> *) a. Monad m => a -> m a
return (Type
ty { ft_mult :: Type
ft_mult = Type
w', ft_arg :: Type
ft_arg = Type
arg', ft_res :: Type
ft_res = Type
res' }) }

    go_ty env
env ty :: Type
ty@(TyConApp TyCon
tc [Type]
tys)
      | TyCon -> Bool
isTcTyCon TyCon
tc
      = do { TyCon
tc' <- TyCon -> m TyCon
tycon TyCon
tc
           ; TyCon -> [Type] -> Type
mkTyConApp TyCon
tc' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> [Type] -> m [Type]
go_tys env
env [Type]
tys }

      -- Not a TcTyCon
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys    -- Avoid allocation in this very
      = forall (m :: * -> *) a. Monad m => a -> m a
return Type
ty   -- common case (E.g. Int, LiftedRep etc)

      | Bool
otherwise
      = TyCon -> [Type] -> Type
mkTyConApp TyCon
tc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> [Type] -> m [Type]
go_tys env
env [Type]
tys

    go_ty env
env (ForAllTy (Bndr TyVar
tv ArgFlag
vis) Type
inner)
      = do { (env
env', TyVar
tv') <- env -> TyVar -> ArgFlag -> m (env, TyVar)
tycobinder env
env TyVar
tv ArgFlag
vis
           ; Type
inner' <- env -> Type -> m Type
go_ty env
env' Type
inner
           ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ VarBndr TyVar ArgFlag -> Type -> Type
ForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv' ArgFlag
vis) Type
inner' }

    go_cos :: env -> [KindCoercion] -> m [KindCoercion]
go_cos env
_   []       = forall (m :: * -> *) a. Monad m => a -> m a
return []
    go_cos env
env (KindCoercion
co:[KindCoercion]
cos) = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> [KindCoercion] -> m [KindCoercion]
go_cos env
env [KindCoercion]
cos

    go_mco :: env -> MCoercionN -> m MCoercionN
go_mco env
_   MCoercionN
MRefl    = forall (m :: * -> *) a. Monad m => a -> m a
return MCoercionN
MRefl
    go_mco env
env (MCo KindCoercion
co) = KindCoercion -> MCoercionN
MCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co)

    go_co :: env -> KindCoercion -> m KindCoercion
go_co env
env (Refl Type
ty)           = Type -> KindCoercion
Refl forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> Type -> m Type
go_ty env
env Type
ty
    go_co env
env (GRefl Role
r Type
ty MCoercionN
mco)    = Role -> Type -> MCoercionN -> KindCoercion
mkGReflCo Role
r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> Type -> m Type
go_ty env
env Type
ty forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> MCoercionN -> m MCoercionN
go_mco env
env MCoercionN
mco
    go_co env
env (AppCo KindCoercion
c1 KindCoercion
c2)       = KindCoercion -> KindCoercion -> KindCoercion
mkAppCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
c1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
c2
    go_co env
env (FunCo Role
r KindCoercion
cw KindCoercion
c1 KindCoercion
c2)   = Role
-> KindCoercion -> KindCoercion -> KindCoercion -> KindCoercion
mkFunCo Role
r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
cw forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
c1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
c2
    go_co env
env (CoVarCo TyVar
cv)        = env -> TyVar -> m KindCoercion
covar env
env TyVar
cv
    go_co env
env (HoleCo CoercionHole
hole)       = env -> CoercionHole -> m KindCoercion
cohole env
env CoercionHole
hole
    go_co env
env (UnivCo UnivCoProvenance
p Role
r Type
t1 Type
t2)  = UnivCoProvenance -> Role -> Type -> Type -> KindCoercion
mkUnivCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> UnivCoProvenance -> m UnivCoProvenance
go_prov env
env UnivCoProvenance
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Role
r
                                    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> Type -> m Type
go_ty env
env Type
t1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> Type -> m Type
go_ty env
env Type
t2
    go_co env
env (SymCo KindCoercion
co)          = KindCoercion -> KindCoercion
mkSymCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co
    go_co env
env (TransCo KindCoercion
c1 KindCoercion
c2)     = KindCoercion -> KindCoercion -> KindCoercion
mkTransCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
c1 forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
c2
    go_co env
env (AxiomRuleCo CoAxiomRule
r [KindCoercion]
cos) = CoAxiomRule -> [KindCoercion] -> KindCoercion
AxiomRuleCo CoAxiomRule
r forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> [KindCoercion] -> m [KindCoercion]
go_cos env
env [KindCoercion]
cos
    go_co env
env (NthCo Role
r Int
i KindCoercion
co)      = HasDebugCallStack => Role -> Int -> KindCoercion -> KindCoercion
mkNthCo Role
r Int
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co
    go_co env
env (LRCo LeftOrRight
lr KindCoercion
co)        = LeftOrRight -> KindCoercion -> KindCoercion
mkLRCo LeftOrRight
lr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co
    go_co env
env (InstCo KindCoercion
co KindCoercion
arg)     = KindCoercion -> KindCoercion -> KindCoercion
mkInstCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
arg
    go_co env
env (KindCo KindCoercion
co)         = KindCoercion -> KindCoercion
mkKindCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co
    go_co env
env (SubCo KindCoercion
co)          = HasDebugCallStack => KindCoercion -> KindCoercion
mkSubCo forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co
    go_co env
env (AxiomInstCo CoAxiom Branched
ax Int
i [KindCoercion]
cos) = CoAxiom Branched -> Int -> [KindCoercion] -> KindCoercion
mkAxiomInstCo CoAxiom Branched
ax Int
i forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> [KindCoercion] -> m [KindCoercion]
go_cos env
env [KindCoercion]
cos
    go_co env
env co :: KindCoercion
co@(TyConAppCo Role
r TyCon
tc [KindCoercion]
cos)
      | TyCon -> Bool
isTcTyCon TyCon
tc
      = do { TyCon
tc' <- TyCon -> m TyCon
tycon TyCon
tc
           ; HasDebugCallStack =>
Role -> TyCon -> [KindCoercion] -> KindCoercion
mkTyConAppCo Role
r TyCon
tc' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> [KindCoercion] -> m [KindCoercion]
go_cos env
env [KindCoercion]
cos }

      -- Not a TcTyCon
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [KindCoercion]
cos    -- Avoid allocation in this very
      = forall (m :: * -> *) a. Monad m => a -> m a
return KindCoercion
co   -- common case (E.g. Int, LiftedRep etc)

      | Bool
otherwise
      = HasDebugCallStack =>
Role -> TyCon -> [KindCoercion] -> KindCoercion
mkTyConAppCo Role
r TyCon
tc forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> [KindCoercion] -> m [KindCoercion]
go_cos env
env [KindCoercion]
cos
    go_co env
env (ForAllCo TyVar
tv KindCoercion
kind_co KindCoercion
co)
      = do { KindCoercion
kind_co' <- env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
kind_co
           ; (env
env', TyVar
tv') <- env -> TyVar -> ArgFlag -> m (env, TyVar)
tycobinder env
env TyVar
tv ArgFlag
Inferred
           ; KindCoercion
co' <- env -> KindCoercion -> m KindCoercion
go_co env
env' KindCoercion
co
           ; forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ TyVar -> KindCoercion -> KindCoercion -> KindCoercion
mkForAllCo TyVar
tv' KindCoercion
kind_co' KindCoercion
co' }
        -- See Note [Efficiency for ForAllCo case of mapTyCoX]

    go_prov :: env -> UnivCoProvenance -> m UnivCoProvenance
go_prov env
env (PhantomProv KindCoercion
co)    = KindCoercion -> UnivCoProvenance
PhantomProv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co
    go_prov env
env (ProofIrrelProv KindCoercion
co) = KindCoercion -> UnivCoProvenance
ProofIrrelProv forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> env -> KindCoercion -> m KindCoercion
go_co env
env KindCoercion
co
    go_prov env
_   p :: UnivCoProvenance
p@(PluginProv String
_)    = forall (m :: * -> *) a. Monad m => a -> m a
return UnivCoProvenance
p
    go_prov env
_   p :: UnivCoProvenance
p@(CorePrepProv Bool
_)  = forall (m :: * -> *) a. Monad m => a -> m a
return UnivCoProvenance
p


{-
************************************************************************
*                                                                      *
\subsection{Constructor-specific functions}
*                                                                      *
************************************************************************


---------------------------------------------------------------------
                                TyVarTy
                                ~~~~~~~
-}

-- | 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'
getTyVar :: String -> Type -> TyVar
getTyVar :: String -> Type -> TyVar
getTyVar String
msg Type
ty = case Type -> Maybe TyVar
getTyVar_maybe Type
ty of
                    Just TyVar
tv -> TyVar
tv
                    Maybe TyVar
Nothing -> forall a. String -> a
panic (String
"getTyVar: " forall a. [a] -> [a] -> [a]
++ String
msg)

isTyVarTy :: Type -> Bool
isTyVarTy :: Type -> Bool
isTyVarTy Type
ty = forall a. Maybe a -> Bool
isJust (Type -> Maybe TyVar
getTyVar_maybe Type
ty)

-- | Attempts to obtain the type variable underlying a 'Type'
getTyVar_maybe :: Type -> Maybe TyVar
getTyVar_maybe :: Type -> Maybe TyVar
getTyVar_maybe = Type -> Maybe TyVar
repGetTyVar_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
coreFullView

-- | If the type is a tyvar, possibly under a cast, returns it, along
-- with the coercion. Thus, the co is :: kind tv ~N kind ty
getCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)
getCastedTyVar_maybe :: Type -> Maybe (TyVar, KindCoercion)
getCastedTyVar_maybe Type
ty = case Type -> Type
coreFullView Type
ty of
  CastTy (TyVarTy TyVar
tv) KindCoercion
co -> forall a. a -> Maybe a
Just (TyVar
tv, KindCoercion
co)
  TyVarTy TyVar
tv             -> forall a. a -> Maybe a
Just (TyVar
tv, Role -> Type -> KindCoercion
mkReflCo Role
Nominal (TyVar -> Type
tyVarKind TyVar
tv))
  Type
_                      -> forall a. Maybe a
Nothing

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

{-
---------------------------------------------------------------------
                                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.

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
source Haskell.  In contrast, we *can* unify (a b) with (t1 -> t2).
Here's an example (#9858) of how you might do it:
   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
the other calls to splitAppTy are in GHC.Core.Unify, which is also used by
the type checker (e.g. when matching type-function equations).

-}

-- | Applies a type to another, as in e.g. @k a@
mkAppTy :: Type -> Type -> Type
  -- See Note [Respecting definitional equality], invariant (EQ1).
mkAppTy :: Type -> Type -> Type
mkAppTy (CastTy Type
fun_ty KindCoercion
co) Type
arg_ty
  | ([KindCoercion
arg_co], KindCoercion
res_co) <- HasDebugCallStack =>
KindCoercion
-> Pair Type -> [Type] -> ([KindCoercion], KindCoercion)
decomposePiCos KindCoercion
co (KindCoercion -> Pair Type
coercionKind KindCoercion
co) [Type
arg_ty]
  = (Type
fun_ty Type -> Type -> Type
`mkAppTy` (Type
arg_ty Type -> KindCoercion -> Type
`mkCastTy` KindCoercion
arg_co)) Type -> KindCoercion -> Type
`mkCastTy` KindCoercion
res_co

mkAppTy (TyConApp TyCon
tc [Type]
tys) Type
ty2 = TyCon -> [Type] -> Type
mkTyConApp TyCon
tc ([Type]
tys forall a. [a] -> [a] -> [a]
++ [Type
ty2])
mkAppTy Type
ty1               Type
ty2 = Type -> Type -> Type
AppTy Type
ty1 Type
ty2
        -- 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
        --
        -- Moreover in GHC.Tc.Types.tcInferTyApps we build up a type
        --   (T t1 t2 t3) one argument at a type, thus forming
        --   (T t1), (T t1 t2), etc

mkAppTys :: Type -> [Type] -> Type
mkAppTys :: Type -> [Type] -> Type
mkAppTys Type
ty1                []   = Type
ty1
mkAppTys (CastTy Type
fun_ty KindCoercion
co) [Type]
arg_tys  -- much more efficient then nested mkAppTy
                                     -- Why do this? See (EQ1) of
                                     -- Note [Respecting definitional equality]
                                     -- in GHC.Core.TyCo.Rep
  = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppTy ((Type -> [Type] -> Type
mkAppTys Type
fun_ty [Type]
casted_arg_tys) Type -> KindCoercion -> Type
`mkCastTy` KindCoercion
res_co) [Type]
leftovers
  where
    ([KindCoercion]
arg_cos, KindCoercion
res_co) = HasDebugCallStack =>
KindCoercion
-> Pair Type -> [Type] -> ([KindCoercion], KindCoercion)
decomposePiCos KindCoercion
co (KindCoercion -> Pair Type
coercionKind KindCoercion
co) [Type]
arg_tys
    ([Type]
args_to_cast, [Type]
leftovers) = forall b a. [b] -> [a] -> ([a], [a])
splitAtList [KindCoercion]
arg_cos [Type]
arg_tys
    casted_arg_tys :: [Type]
casted_arg_tys = forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Type -> KindCoercion -> Type
mkCastTy [Type]
args_to_cast [KindCoercion]
arg_cos
mkAppTys (TyConApp TyCon
tc [Type]
tys1) [Type]
tys2 = TyCon -> [Type] -> Type
mkTyConApp TyCon
tc ([Type]
tys1 forall a. [a] -> [a] -> [a]
++ [Type]
tys2)
mkAppTys Type
ty1                [Type]
tys2 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Type -> Type -> Type
AppTy Type
ty1 [Type]
tys2

-------------
splitAppTy_maybe :: Type -> Maybe (Type, Type)
-- ^ 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!
splitAppTy_maybe :: Type -> Maybe (Type, Type)
splitAppTy_maybe = HasDebugCallStack => Type -> Maybe (Type, Type)
repSplitAppTy_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
coreFullView

-------------
repSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type,Type)
-- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that
-- any Core view stuff is already done
repSplitAppTy_maybe :: HasDebugCallStack => Type -> Maybe (Type, Type)
repSplitAppTy_maybe (FunTy AnonArgFlag
_ Type
w Type
ty1 Type
ty2)
  = forall a. a -> Maybe a
Just (TyCon -> [Type] -> Type
TyConApp TyCon
funTyCon [Type
w, Type
rep1, Type
rep2, Type
ty1], Type
ty2)
  where
    rep1 :: Type
rep1 = HasDebugCallStack => Type -> Type
getRuntimeRep Type
ty1
    rep2 :: Type
rep2 = HasDebugCallStack => Type -> Type
getRuntimeRep Type
ty2

repSplitAppTy_maybe (AppTy Type
ty1 Type
ty2)
  = forall a. a -> Maybe a
Just (Type
ty1, Type
ty2)

repSplitAppTy_maybe (TyConApp TyCon
tc [Type]
tys)
  | Bool -> Bool
not (TyCon -> Bool
mustBeSaturated TyCon
tc) Bool -> Bool -> Bool
|| [Type]
tys forall a. [a] -> Int -> Bool
`lengthExceeds` TyCon -> Int
tyConArity TyCon
tc
  , Just ([Type]
tys', Type
ty') <- forall a. [a] -> Maybe ([a], a)
snocView [Type]
tys
  = forall a. a -> Maybe a
Just (TyCon -> [Type] -> Type
TyConApp TyCon
tc [Type]
tys', Type
ty')    -- Never create unsaturated type family apps!

repSplitAppTy_maybe Type
_other = forall a. Maybe a
Nothing

-- This one doesn't break apart (c => t).
-- See Note [Decomposing fat arrow c=>t]
-- Defined here to avoid module loops between Unify and TcType.
tcRepSplitAppTy_maybe :: Type -> Maybe (Type,Type)
-- ^ Does the AppTy split as in 'tcSplitAppTy_maybe', but assumes that
-- any coreView stuff is already done. Refuses to look through (c => t)
tcRepSplitAppTy_maybe :: Type -> Maybe (Type, Type)
tcRepSplitAppTy_maybe (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_mult :: Type -> Type
ft_mult = Type
w, ft_arg :: Type -> Type
ft_arg = Type
ty1, ft_res :: Type -> Type
ft_res = Type
ty2 })
  | AnonArgFlag
VisArg <- AnonArgFlag
af   -- See Note [Decomposing fat arrow c=>t]

  -- See Note [The Purely Kinded Type Invariant (PKTI)] in GHC.Tc.Gen.HsType,
  -- Wrinkle around FunTy
  , Just Type
rep1 <- HasDebugCallStack => Type -> Maybe Type
getRuntimeRep_maybe Type
ty1
  , Just Type
rep2 <- HasDebugCallStack => Type -> Maybe Type
getRuntimeRep_maybe Type
ty2
  = forall a. a -> Maybe a
Just (TyCon -> [Type] -> Type
TyConApp TyCon
funTyCon [Type
w, Type
rep1, Type
rep2, Type
ty1], Type
ty2)

  | Bool
otherwise
  = forall a. Maybe a
Nothing

tcRepSplitAppTy_maybe (AppTy Type
ty1 Type
ty2)    = forall a. a -> Maybe a
Just (Type
ty1, Type
ty2)
tcRepSplitAppTy_maybe (TyConApp TyCon
tc [Type]
tys)
  | Bool -> Bool
not (TyCon -> Bool
mustBeSaturated TyCon
tc) Bool -> Bool -> Bool
|| [Type]
tys forall a. [a] -> Int -> Bool
`lengthExceeds` TyCon -> Int
tyConArity TyCon
tc
  , Just ([Type]
tys', Type
ty') <- forall a. [a] -> Maybe ([a], a)
snocView [Type]
tys
  = forall a. a -> Maybe a
Just (TyCon -> [Type] -> Type
TyConApp TyCon
tc [Type]
tys', Type
ty')    -- Never create unsaturated type family apps!
tcRepSplitAppTy_maybe Type
_other = forall a. Maybe a
Nothing

-------------
splitAppTy :: Type -> (Type, Type)
-- ^ Attempts to take a type application apart, as in 'splitAppTy_maybe',
-- and panics if this is not possible
splitAppTy :: Type -> (Type, Type)
splitAppTy Type
ty = case Type -> Maybe (Type, Type)
splitAppTy_maybe Type
ty of
                Just (Type, Type)
pr -> (Type, Type)
pr
                Maybe (Type, Type)
Nothing -> forall a. String -> a
panic String
"splitAppTy"

-------------
splitAppTys :: Type -> (Type, [Type])
-- ^ 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.
splitAppTys :: Type -> (Type, [Type])
splitAppTys Type
ty = Type -> Type -> [Type] -> (Type, [Type])
split Type
ty Type
ty []
  where
    split :: Type -> Type -> [Type] -> (Type, [Type])
split Type
orig_ty Type
ty [Type]
args | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Type -> [Type] -> (Type, [Type])
split Type
orig_ty Type
ty' [Type]
args
    split Type
_       (AppTy Type
ty Type
arg)        [Type]
args = Type -> Type -> [Type] -> (Type, [Type])
split Type
ty Type
ty (Type
argforall a. a -> [a] -> [a]
:[Type]
args)
    split Type
_       (TyConApp TyCon
tc [Type]
tc_args) [Type]
args
      = let -- keep type families saturated
            n :: Int
n | TyCon -> Bool
mustBeSaturated TyCon
tc = TyCon -> Int
tyConArity TyCon
tc
              | Bool
otherwise          = Int
0
            ([Type]
tc_args1, [Type]
tc_args2) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [Type]
tc_args
        in
        (TyCon -> [Type] -> Type
TyConApp TyCon
tc [Type]
tc_args1, [Type]
tc_args2 forall a. [a] -> [a] -> [a]
++ [Type]
args)
    split Type
_   (FunTy AnonArgFlag
_ Type
w Type
ty1 Type
ty2) [Type]
args
      = ASSERT( null args )
        (TyCon -> [Type] -> Type
TyConApp TyCon
funTyCon [], [Type
w, Type
rep1, Type
rep2, Type
ty1, Type
ty2])
      where
        rep1 :: Type
rep1 = HasDebugCallStack => Type -> Type
getRuntimeRep Type
ty1
        rep2 :: Type
rep2 = HasDebugCallStack => Type -> Type
getRuntimeRep Type
ty2

    split Type
orig_ty Type
_                     [Type]
args  = (Type
orig_ty, [Type]
args)

-- | Like 'splitAppTys', but doesn't look through type synonyms
repSplitAppTys :: HasDebugCallStack => Type -> (Type, [Type])
repSplitAppTys :: HasDebugCallStack => Type -> (Type, [Type])
repSplitAppTys Type
ty = Type -> [Type] -> (Type, [Type])
split Type
ty []
  where
    split :: Type -> [Type] -> (Type, [Type])
split (AppTy Type
ty Type
arg) [Type]
args = Type -> [Type] -> (Type, [Type])
split Type
ty (Type
argforall a. a -> [a] -> [a]
:[Type]
args)
    split (TyConApp TyCon
tc [Type]
tc_args) [Type]
args
      = let n :: Int
n | TyCon -> Bool
mustBeSaturated TyCon
tc = TyCon -> Int
tyConArity TyCon
tc
              | Bool
otherwise          = Int
0
            ([Type]
tc_args1, [Type]
tc_args2) = forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [Type]
tc_args
        in
        (TyCon -> [Type] -> Type
TyConApp TyCon
tc [Type]
tc_args1, [Type]
tc_args2 forall a. [a] -> [a] -> [a]
++ [Type]
args)
    split (FunTy AnonArgFlag
_ Type
w Type
ty1 Type
ty2) [Type]
args
      = ASSERT( null args )
        (TyCon -> [Type] -> Type
TyConApp TyCon
funTyCon [], [Type
w, Type
rep1, Type
rep2, Type
ty1, Type
ty2])
      where
        rep1 :: Type
rep1 = HasDebugCallStack => Type -> Type
getRuntimeRep Type
ty1
        rep2 :: Type
rep2 = HasDebugCallStack => Type -> Type
getRuntimeRep Type
ty2

    split Type
ty [Type]
args = (Type
ty, [Type]
args)

{-
                      LitTy
                      ~~~~~
-}

mkNumLitTy :: Integer -> Type
mkNumLitTy :: Integer -> Type
mkNumLitTy Integer
n = TyLit -> Type
LitTy (Integer -> TyLit
NumTyLit Integer
n)

-- | Is this a numeric literal. We also look through type synonyms.
isNumLitTy :: Type -> Maybe Integer
isNumLitTy :: Type -> Maybe Integer
isNumLitTy Type
ty
  | LitTy (NumTyLit Integer
n) <- Type -> Type
coreFullView Type
ty = forall a. a -> Maybe a
Just Integer
n
  | Bool
otherwise                             = forall a. Maybe a
Nothing

mkStrLitTy :: FastString -> Type
mkStrLitTy :: FastString -> Type
mkStrLitTy FastString
s = TyLit -> Type
LitTy (FastString -> TyLit
StrTyLit FastString
s)

-- | Is this a symbol literal. We also look through type synonyms.
isStrLitTy :: Type -> Maybe FastString
isStrLitTy :: Type -> Maybe FastString
isStrLitTy Type
ty
  | LitTy (StrTyLit FastString
s) <- Type -> Type
coreFullView Type
ty = forall a. a -> Maybe a
Just FastString
s
  | Bool
otherwise                             = forall a. Maybe a
Nothing

mkCharLitTy :: Char -> Type
mkCharLitTy :: Char -> Type
mkCharLitTy Char
c = TyLit -> Type
LitTy (Char -> TyLit
CharTyLit Char
c)

-- | Is this a char literal? We also look through type synonyms.
isCharLitTy :: Type -> Maybe Char
isCharLitTy :: Type -> Maybe Char
isCharLitTy Type
ty
  | LitTy (CharTyLit Char
s) <- Type -> Type
coreFullView Type
ty = forall a. a -> Maybe a
Just Char
s
  | Bool
otherwise                              = forall a. Maybe a
Nothing


-- | Is this a type literal (symbol, numeric, or char)?
isLitTy :: Type -> Maybe TyLit
isLitTy :: Type -> Maybe TyLit
isLitTy Type
ty
  | LitTy TyLit
l <- Type -> Type
coreFullView Type
ty = forall a. a -> Maybe a
Just TyLit
l
  | Bool
otherwise                  = forall a. Maybe a
Nothing

-- | Is this type a custom user error?
-- If so, give us the kind and the error message.
userTypeError_maybe :: Type -> Maybe Type
userTypeError_maybe :: Type -> Maybe Type
userTypeError_maybe Type
t
  = do { (TyCon
tc, Type
_kind : Type
msg : [Type]
_) <- HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
t
          -- There may be more than 2 arguments, if the type error is
          -- used as a type constructor (e.g. at kind `Type -> Type`).

       ; forall (f :: * -> *). Alternative f => Bool -> f ()
guard (TyCon -> Name
tyConName TyCon
tc forall a. Eq a => a -> a -> Bool
== Name
errorMessageTypeErrorFamName)
       ; forall (m :: * -> *) a. Monad m => a -> m a
return Type
msg }

-- | Render a type corresponding to a user type error into a SDoc.
pprUserTypeErrorTy :: Type -> SDoc
pprUserTypeErrorTy :: Type -> SDoc
pprUserTypeErrorTy Type
ty =
  case HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty of

    -- Text "Something"
    Just (TyCon
tc,[Type
txt])
      | TyCon -> Name
tyConName TyCon
tc forall a. Eq a => a -> a -> Bool
== Name
typeErrorTextDataConName
      , Just FastString
str <- Type -> Maybe FastString
isStrLitTy Type
txt -> FastString -> SDoc
ftext FastString
str

    -- ShowType t
    Just (TyCon
tc,[Type
_k,Type
t])
      | TyCon -> Name
tyConName TyCon
tc forall a. Eq a => a -> a -> Bool
== Name
typeErrorShowTypeDataConName -> forall a. Outputable a => a -> SDoc
ppr Type
t

    -- t1 :<>: t2
    Just (TyCon
tc,[Type
t1,Type
t2])
      | TyCon -> Name
tyConName TyCon
tc forall a. Eq a => a -> a -> Bool
== Name
typeErrorAppendDataConName ->
        Type -> SDoc
pprUserTypeErrorTy Type
t1 SDoc -> SDoc -> SDoc
<> Type -> SDoc
pprUserTypeErrorTy Type
t2

    -- t1 :$$: t2
    Just (TyCon
tc,[Type
t1,Type
t2])
      | TyCon -> Name
tyConName TyCon
tc forall a. Eq a => a -> a -> Bool
== Name
typeErrorVAppendDataConName ->
        Type -> SDoc
pprUserTypeErrorTy Type
t1 SDoc -> SDoc -> SDoc
$$ Type -> SDoc
pprUserTypeErrorTy Type
t2

    -- An unevaluated type function
    Maybe (TyCon, [Type])
_ -> forall a. Outputable a => a -> SDoc
ppr Type
ty




{-
---------------------------------------------------------------------
                                FunTy
                                ~~~~~

Note [Representation of function types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Functions (e.g. Int -> Char) can be thought of as being applications
of funTyCon (known in Haskell surface syntax as (->)), (note that
`RuntimeRep' quantifiers are left inferred)

    (->) :: forall {r1 :: RuntimeRep} {r2 :: RuntimeRep}
                   (a :: TYPE r1) (b :: TYPE r2).
            a -> b -> Type

However, for efficiency's sake we represent saturated applications of (->)
with FunTy. For instance, the type,

    (->) r1 r2 a b

is equivalent to,

    FunTy (Anon a) b

Note how the RuntimeReps are implied in the FunTy representation. For this
reason we must be careful when reconstructing the TyConApp representation (see,
for instance, splitTyConApp_maybe).

In the compiler we maintain the invariant that all saturated applications of
(->) are represented with FunTy.

See #11714.
-}

splitFunTy :: Type -> (Mult, Type, Type)
-- ^ Attempts to extract the multiplicity, argument and result types from a type,
-- and panics if that is not possible. See also 'splitFunTy_maybe'
splitFunTy :: Type -> (Type, Type, Type)
splitFunTy = forall a. HasCallStack => String -> Maybe a -> a
expectJust String
"splitFunTy" forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Maybe (Type, Type, Type)
splitFunTy_maybe

{-# INLINE splitFunTy_maybe #-}
splitFunTy_maybe :: Type -> Maybe (Mult, Type, Type)
-- ^ Attempts to extract the multiplicity, argument and result types from a type
splitFunTy_maybe :: Type -> Maybe (Type, Type, Type)
splitFunTy_maybe Type
ty
  | FunTy AnonArgFlag
_ Type
w Type
arg Type
res <- Type -> Type
coreFullView Type
ty = forall a. a -> Maybe a
Just (Type
w, Type
arg, Type
res)
  | Bool
otherwise                            = forall a. Maybe a
Nothing

splitFunTys :: Type -> ([Scaled Type], Type)
splitFunTys :: Type -> ([Scaled Type], Type)
splitFunTys Type
ty = [Scaled Type] -> Type -> Type -> ([Scaled Type], Type)
split [] Type
ty Type
ty
  where
      -- common case first
    split :: [Scaled Type] -> Type -> Type -> ([Scaled Type], Type)
split [Scaled Type]
args Type
_       (FunTy AnonArgFlag
_ Type
w Type
arg Type
res) = [Scaled Type] -> Type -> Type -> ([Scaled Type], Type)
split ((forall a. Type -> a -> Scaled a
Scaled Type
w Type
arg)forall a. a -> [a] -> [a]
:[Scaled Type]
args) Type
res Type
res
    split [Scaled Type]
args Type
orig_ty Type
ty | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = [Scaled Type] -> Type -> Type -> ([Scaled Type], Type)
split [Scaled Type]
args Type
orig_ty Type
ty'
    split [Scaled Type]
args Type
orig_ty Type
_                   = (forall a. [a] -> [a]
reverse [Scaled Type]
args, Type
orig_ty)

funResultTy :: Type -> Type
-- ^ Extract the function result type and panic if that is not possible
funResultTy :: Type -> Type
funResultTy Type
ty
  | FunTy { ft_res :: Type -> Type
ft_res = Type
res } <- Type -> Type
coreFullView Type
ty = Type
res
  | Bool
otherwise                                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"funResultTy" (forall a. Outputable a => a -> SDoc
ppr Type
ty)

funArgTy :: Type -> Type
-- ^ Extract the function argument type and panic if that is not possible
funArgTy :: Type -> Type
funArgTy Type
ty
  | FunTy { ft_arg :: Type -> Type
ft_arg = Type
arg } <- Type -> Type
coreFullView Type
ty = Type
arg
  | Bool
otherwise                                 = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"funArgTy" (forall a. Outputable a => a -> SDoc
ppr Type
ty)

-- ^ Just like 'piResultTys' but for a single argument
-- Try not to iterate 'piResultTy', because it's inefficient to substitute
-- one variable at a time; instead use 'piResultTys"
piResultTy :: HasDebugCallStack => Type -> Type ->  Type
piResultTy :: HasDebugCallStack => Type -> Type -> Type
piResultTy Type
ty Type
arg = case Type -> Type -> Maybe Type
piResultTy_maybe Type
ty Type
arg of
                      Just Type
res -> Type
res
                      Maybe Type
Nothing  -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"piResultTy" (forall a. Outputable a => a -> SDoc
ppr Type
ty SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr Type
arg)

piResultTy_maybe :: Type -> Type -> Maybe Type
-- We don't need a 'tc' version, because
-- this function behaves the same for Type and Constraint
piResultTy_maybe :: Type -> Type -> Maybe Type
piResultTy_maybe Type
ty Type
arg = case Type -> Type
coreFullView Type
ty of
  FunTy { ft_res :: Type -> Type
ft_res = Type
res } -> forall a. a -> Maybe a
Just Type
res

  ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
res
    -> let empty_subst :: TCvSubst
empty_subst = InScopeSet -> TCvSubst
mkEmptyTCvSubst forall a b. (a -> b) -> a -> b
$ TyCoVarSet -> InScopeSet
mkInScopeSet forall a b. (a -> b) -> a -> b
$
                         [Type] -> TyCoVarSet
tyCoVarsOfTypes [Type
arg,Type
res]
       in forall a. a -> Maybe a
Just (HasCallStack => TCvSubst -> Type -> Type
substTy (TCvSubst -> TyVar -> Type -> TCvSubst
extendTCvSubst TCvSubst
empty_subst TyVar
tv Type
arg) Type
res)

  Type
_ -> forall a. Maybe a
Nothing

-- | (piResultTys f_ty [ty1, .., tyn]) gives the type of (f ty1 .. tyn)
--   where f :: f_ty
-- 'piResultTys' is interesting because:
--      1. 'f_ty' may have more for-alls than there are args
--      2. Less obviously, it may have fewer for-alls
-- For case 2. think of:
--   piResultTys (forall a.a) [forall b.b, Int]
-- 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.

-- If you edit this function, you may need to update the GHC formalism
-- See Note [GHC Formalism] in GHC.Core.Lint

-- This is a heavily used function (e.g. from typeKind),
-- so we pay attention to efficiency, especially in the special case
-- where there are no for-alls so we are just dropping arrows from
-- a function type/kind.
piResultTys :: HasDebugCallStack => Type -> [Type] -> Type
piResultTys :: HasDebugCallStack => Type -> [Type] -> Type
piResultTys Type
ty [] = Type
ty
piResultTys Type
ty orig_args :: [Type]
orig_args@(Type
arg:[Type]
args)
  | FunTy { ft_res :: Type -> Type
ft_res = Type
res } <- Type
ty
  = HasDebugCallStack => Type -> [Type] -> Type
piResultTys Type
res [Type]
args

  | ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
res <- Type
ty
  = TCvSubst -> Type -> [Type] -> Type
go (TCvSubst -> TyVar -> Type -> TCvSubst
extendTCvSubst TCvSubst
init_subst TyVar
tv Type
arg) Type
res [Type]
args

  | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty
  = HasDebugCallStack => Type -> [Type] -> Type
piResultTys Type
ty' [Type]
orig_args

  | Bool
otherwise
  = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"piResultTys1" (forall a. Outputable a => a -> SDoc
ppr Type
ty SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr [Type]
orig_args)
  where
    init_subst :: TCvSubst
init_subst = InScopeSet -> TCvSubst
mkEmptyTCvSubst forall a b. (a -> b) -> a -> b
$ TyCoVarSet -> InScopeSet
mkInScopeSet ([Type] -> TyCoVarSet
tyCoVarsOfTypes (Type
tyforall a. a -> [a] -> [a]
:[Type]
orig_args))

    go :: TCvSubst -> Type -> [Type] -> Type
    go :: TCvSubst -> Type -> [Type] -> Type
go TCvSubst
subst Type
ty [] = TCvSubst -> Type -> Type
substTyUnchecked TCvSubst
subst Type
ty

    go TCvSubst
subst Type
ty all_args :: [Type]
all_args@(Type
arg:[Type]
args)
      | FunTy { ft_res :: Type -> Type
ft_res = Type
res } <- Type
ty
      = TCvSubst -> Type -> [Type] -> Type
go TCvSubst
subst Type
res [Type]
args

      | ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
res <- Type
ty
      = TCvSubst -> Type -> [Type] -> Type
go (TCvSubst -> TyVar -> Type -> TCvSubst
extendTCvSubst TCvSubst
subst TyVar
tv Type
arg) Type
res [Type]
args

      | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty
      = TCvSubst -> Type -> [Type] -> Type
go TCvSubst
subst Type
ty' [Type]
all_args

      | Bool -> Bool
not (TCvSubst -> Bool
isEmptyTCvSubst TCvSubst
subst)  -- See Note [Care with kind instantiation]
      = TCvSubst -> Type -> [Type] -> Type
go TCvSubst
init_subst
          (HasCallStack => TCvSubst -> Type -> Type
substTy TCvSubst
subst Type
ty)
          [Type]
all_args

      | Bool
otherwise
      = -- We have not run out of arguments, but the function doesn't
        -- have the right kind to apply to them; so panic.
        -- Without the explicit isEmptyVarEnv test, an ill-kinded type
        -- would give an infinite loop, which is very unhelpful
        -- c.f. #15473
        forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"piResultTys2" (forall a. Outputable a => a -> SDoc
ppr Type
ty SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr [Type]
orig_args SDoc -> SDoc -> SDoc
$$ forall a. Outputable a => a -> SDoc
ppr [Type]
all_args)

applyTysX :: [TyVar] -> Type -> [Type] -> Type
-- applyTyxX beta-reduces (/\tvs. body_ty) arg_tys
-- Assumes that (/\tvs. body_ty) is closed
applyTysX :: [TyVar] -> Type -> [Type] -> Type
applyTysX [TyVar]
tvs Type
body_ty [Type]
arg_tys
  = ASSERT2( arg_tys `lengthAtLeast` n_tvs, pp_stuff )
    ASSERT2( tyCoVarsOfType body_ty `subVarSet` mkVarSet tvs, pp_stuff )
    Type -> [Type] -> Type
mkAppTys (HasCallStack => [TyVar] -> [Type] -> Type -> Type
substTyWith [TyVar]
tvs (forall a. Int -> [a] -> [a]
take Int
n_tvs [Type]
arg_tys) Type
body_ty)
             (forall a. Int -> [a] -> [a]
drop Int
n_tvs [Type]
arg_tys)
  where
    pp_stuff :: SDoc
pp_stuff = [SDoc] -> SDoc
vcat [forall a. Outputable a => a -> SDoc
ppr [TyVar]
tvs, forall a. Outputable a => a -> SDoc
ppr Type
body_ty, forall a. Outputable a => a -> SDoc
ppr [Type]
arg_tys]
    n_tvs :: Int
n_tvs = forall (t :: * -> *) a. Foldable t => t a -> Int
length [TyVar]
tvs



{- Note [Care with kind instantiation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Suppose we have
  T :: forall k. k
and we are finding the kind of
  T (forall b. b -> b) * Int
Then
  T (forall b. b->b) :: k[ k :-> forall b. b->b]
                     :: forall b. b -> b
So
  T (forall b. b->b) * :: (b -> b)[ b :-> *]
                       :: * -> *

In other words we must instantiate the forall!

Similarly (#15428)
   S :: forall k f. k -> f k
and we are finding the kind of
   S * (* ->) Int Bool
We have
   S * (* ->) :: (k -> f k)[ k :-> *, f :-> (* ->)]
              :: * -> * -> *
So again we must instantiate.

The same thing happens in GHC.CoreToIface.toIfaceAppArgsX.

---------------------------------------------------------------------
                                TyConApp
                                ~~~~~~~~
-}

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

-- | Retrieve the tycon heading this type, if there is one. Does /not/
-- look through synonyms.
tyConAppTyConPicky_maybe :: Type -> Maybe TyCon
tyConAppTyConPicky_maybe :: Type -> Maybe TyCon
tyConAppTyConPicky_maybe (TyConApp TyCon
tc [Type]
_) = forall a. a -> Maybe a
Just TyCon
tc
tyConAppTyConPicky_maybe (FunTy {})      = forall a. a -> Maybe a
Just TyCon
funTyCon
tyConAppTyConPicky_maybe Type
_               = forall a. Maybe a
Nothing


-- | The same as @fst . splitTyConApp@
{-# INLINE tyConAppTyCon_maybe #-}
tyConAppTyCon_maybe :: Type -> Maybe TyCon
tyConAppTyCon_maybe :: Type -> Maybe TyCon
tyConAppTyCon_maybe Type
ty = case Type -> Type
coreFullView Type
ty of
  TyConApp TyCon
tc [Type]
_ -> forall a. a -> Maybe a
Just TyCon
tc
  FunTy {}      -> forall a. a -> Maybe a
Just TyCon
funTyCon
  Type
_             -> forall a. Maybe a
Nothing

tyConAppTyCon :: Type -> TyCon
tyConAppTyCon :: Type -> TyCon
tyConAppTyCon Type
ty = Type -> Maybe TyCon
tyConAppTyCon_maybe Type
ty forall a. Maybe a -> a -> a
`orElse` forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConAppTyCon" (forall a. Outputable a => a -> SDoc
ppr Type
ty)

-- | The same as @snd . splitTyConApp@
tyConAppArgs_maybe :: Type -> Maybe [Type]
tyConAppArgs_maybe :: Type -> Maybe [Type]
tyConAppArgs_maybe Type
ty = case Type -> Type
coreFullView Type
ty of
  TyConApp TyCon
_ [Type]
tys -> forall a. a -> Maybe a
Just [Type]
tys
  FunTy AnonArgFlag
_ Type
w Type
arg Type
res
    | Just Type
rep1 <- HasDebugCallStack => Type -> Maybe Type
getRuntimeRep_maybe Type
arg
    , Just Type
rep2 <- HasDebugCallStack => Type -> Maybe Type
getRuntimeRep_maybe Type
res
    -> forall a. a -> Maybe a
Just [Type
w, Type
rep1, Type
rep2, Type
arg, Type
res]
  Type
_ -> forall a. Maybe a
Nothing

tyConAppArgs :: Type -> [Type]
tyConAppArgs :: Type -> [Type]
tyConAppArgs Type
ty = Type -> Maybe [Type]
tyConAppArgs_maybe Type
ty forall a. Maybe a -> a -> a
`orElse` forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConAppArgs" (forall a. Outputable a => a -> SDoc
ppr Type
ty)

tyConAppArgN :: Int -> Type -> Type
-- Executing Nth
tyConAppArgN :: Int -> Type -> Type
tyConAppArgN Int
n Type
ty
  = case Type -> Maybe [Type]
tyConAppArgs_maybe Type
ty of
      Just [Type]
tys -> [Type]
tys forall a. Outputable a => [a] -> Int -> a
`getNth` Int
n
      Maybe [Type]
Nothing  -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"tyConAppArgN" (forall a. Outputable a => a -> SDoc
ppr Int
n SDoc -> SDoc -> SDoc
<+> forall a. Outputable a => a -> SDoc
ppr Type
ty)

-- | 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'
splitTyConApp :: Type -> (TyCon, [Type])
splitTyConApp :: Type -> (TyCon, [Type])
splitTyConApp Type
ty = case HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty of
                   Just (TyCon, [Type])
stuff -> (TyCon, [Type])
stuff
                   Maybe (TyCon, [Type])
Nothing    -> forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"splitTyConApp" (forall a. Outputable a => a -> SDoc
ppr Type
ty)

-- | Attempts to tease a type apart into a type constructor and the application
-- of a number of arguments to that constructor
splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe = HasDebugCallStack => Type -> Maybe (TyCon, [Type])
repSplitTyConApp_maybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type
coreFullView

-- | Split a type constructor application into its type constructor and
-- applied types. Note that this may fail in the case of a 'FunTy' with an
-- argument of unknown kind 'FunTy' (e.g. @FunTy (a :: k) Int@. since the kind
-- of @a@ isn't of the form @TYPE rep@). Consequently, you may need to zonk your
-- type before using this function.
--
-- This does *not* split types headed with (=>), as that's not a TyCon in the
-- type-checker.
--
-- If you only need the 'TyCon', consider using 'tcTyConAppTyCon_maybe'.
tcSplitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type])
-- Defined here to avoid module loops between Unify and TcType.
tcSplitTyConApp_maybe :: HasCallStack => Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty | Just Type
ty' <- Type -> Maybe Type
tcView Type
ty = HasCallStack => Type -> Maybe (TyCon, [Type])
tcSplitTyConApp_maybe Type
ty'
                         | Bool
otherwise             = HasDebugCallStack => Type -> Maybe (TyCon, [Type])
tcRepSplitTyConApp_maybe Type
ty

-------------------
repSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
-- ^ Like 'splitTyConApp_maybe', but doesn't look through synonyms. This
-- assumes the synonyms have already been dealt with.
repSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
repSplitTyConApp_maybe (TyConApp TyCon
tc [Type]
tys) = forall a. a -> Maybe a
Just (TyCon
tc, [Type]
tys)
repSplitTyConApp_maybe (FunTy AnonArgFlag
_ Type
w Type
arg Type
res)
  -- NB: we're in Core, so no check for VisArg
  = forall a. a -> Maybe a
Just (TyCon
funTyCon, [Type
w, Type
arg_rep, Type
res_rep, Type
arg, Type
res])
  where
    arg_rep :: Type
arg_rep = HasDebugCallStack => Type -> Type
getRuntimeRep Type
arg
    res_rep :: Type
res_rep = HasDebugCallStack => Type -> Type
getRuntimeRep Type
res
repSplitTyConApp_maybe Type
_ = forall a. Maybe a
Nothing

tcRepSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
-- ^ Like 'tcSplitTyConApp_maybe', but doesn't look through synonyms. This
-- assumes the synonyms have already been dealt with.
--
-- Moreover, for a FunTy, it only succeeds if the argument types
-- have enough info to extract the runtime-rep arguments that
-- the funTyCon requires.  This will usually be true;
-- but may be temporarily false during canonicalization:
--     see Note [Decomposing FunTy] in GHC.Tc.Solver.Canonical
--     and Note [The Purely Kinded Type Invariant (PKTI)] in GHC.Tc.Gen.HsType,
--         Wrinkle around FunTy
tcRepSplitTyConApp_maybe :: HasDebugCallStack => Type -> Maybe (TyCon, [Type])
tcRepSplitTyConApp_maybe (TyConApp TyCon
tc [Type]
tys) = forall a. a -> Maybe a
Just (TyCon
tc, [Type]
tys)
tcRepSplitTyConApp_maybe (FunTy AnonArgFlag
VisArg Type
w Type
arg Type
res)
  -- NB: VisArg. See Note [Decomposing fat arrow c=>t]
  | Just Type
arg_rep <- HasDebugCallStack => Type -> Maybe Type
getRuntimeRep_maybe Type
arg
  , Just Type
res_rep <- HasDebugCallStack => Type -> Maybe Type
getRuntimeRep_maybe Type
res
  = forall a. a -> Maybe a
Just (TyCon
funTyCon, [Type
w, Type
arg_rep, Type
res_rep, Type
arg, Type
res])
tcRepSplitTyConApp_maybe Type
_ = forall a. Maybe a
Nothing

-------------------
-- | Attempts to tease a list type apart and gives the type of the elements if
-- successful (looks through type synonyms)
splitListTyConApp_maybe :: Type -> Maybe Type
splitListTyConApp_maybe :: Type -> Maybe Type
splitListTyConApp_maybe Type
ty = case HasDebugCallStack => Type -> Maybe (TyCon, [Type])
splitTyConApp_maybe Type
ty of
  Just (TyCon
tc,[Type
e]) | TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
listTyCon -> forall a. a -> Maybe a
Just Type
e
  Maybe (TyCon, [Type])
_other                          -> forall a. Maybe a
Nothing

newTyConInstRhs :: TyCon -> [Type] -> Type
-- ^ Unwrap one 'layer' of newtype on a type constructor and its
-- arguments, using an eta-reduced version of the @newtype@ if possible.
-- This requires tys to have at least @newTyConInstArity tycon@ elements.
newTyConInstRhs :: TyCon -> [Type] -> Type
newTyConInstRhs TyCon
tycon [Type]
tys
    = ASSERT2( tvs `leLength` tys, ppr tycon $$ ppr tys $$ ppr tvs )
      [TyVar] -> Type -> [Type] -> Type
applyTysX [TyVar]
tvs Type
rhs [Type]
tys
  where
    ([TyVar]
tvs, Type
rhs) = TyCon -> ([TyVar], Type)
newTyConEtadRhs TyCon
tycon

{-
---------------------------------------------------------------------
                           CastTy
                           ~~~~~~
A casted type has its *kind* casted into something new.
-}

splitCastTy_maybe :: Type -> Maybe (Type, Coercion)
splitCastTy_maybe :: Type -> Maybe (Type, KindCoercion)
splitCastTy_maybe Type
ty
  | CastTy Type
ty' KindCoercion
co <- Type -> Type
coreFullView Type
ty = forall a. a -> Maybe a
Just (Type
ty', KindCoercion
co)
  | Bool
otherwise                        = forall a. Maybe a
Nothing

-- | Make a 'CastTy'. The Coercion must be nominal. Checks the
-- Coercion for reflexivity, dropping it if it's reflexive.
-- See Note [Respecting definitional equality] in "GHC.Core.TyCo.Rep"
mkCastTy :: Type -> Coercion -> Type
mkCastTy :: Type -> KindCoercion -> Type
mkCastTy Type
ty KindCoercion
co | KindCoercion -> Bool
isReflexiveCo KindCoercion
co = Type
ty  -- (EQ2) from the Note
-- NB: Do the slow check here. This is important to keep the splitXXX
-- functions working properly. Otherwise, we may end up with something
-- like (((->) |> something_reflexive_but_not_obviously_so) biz baz)
-- fails under splitFunTy_maybe. This happened with the cheaper check
-- in test dependent/should_compile/dynamic-paper.

mkCastTy (CastTy Type
ty KindCoercion
co1) KindCoercion
co2
  -- (EQ3) from the Note
  = Type -> KindCoercion -> Type
mkCastTy Type
ty (KindCoercion
co1 KindCoercion -> KindCoercion -> KindCoercion
`mkTransCo` KindCoercion
co2)
      -- call mkCastTy again for the reflexivity check

mkCastTy (ForAllTy (Bndr TyVar
tv ArgFlag
vis) Type
inner_ty) KindCoercion
co
  -- (EQ4) from the Note
  -- See Note [Weird typing rule for ForAllTy] in GHC.Core.TyCo.Rep.
  | TyVar -> Bool
isTyVar TyVar
tv
  , let fvs :: TyCoVarSet
fvs = KindCoercion -> TyCoVarSet
tyCoVarsOfCo KindCoercion
co
  = -- have to make sure that pushing the co in doesn't capture the bound var!
    if TyVar
tv TyVar -> TyCoVarSet -> Bool
`elemVarSet` TyCoVarSet
fvs
    then let empty_subst :: TCvSubst
empty_subst = InScopeSet -> TCvSubst
mkEmptyTCvSubst (TyCoVarSet -> InScopeSet
mkInScopeSet TyCoVarSet
fvs)
             (TCvSubst
subst, TyVar
tv') = HasCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar)
substVarBndr TCvSubst
empty_subst TyVar
tv
         in VarBndr TyVar ArgFlag -> Type -> Type
ForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv' ArgFlag
vis) (HasCallStack => TCvSubst -> Type -> Type
substTy TCvSubst
subst Type
inner_ty Type -> KindCoercion -> Type
`mkCastTy` KindCoercion
co)
    else VarBndr TyVar ArgFlag -> Type -> Type
ForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv ArgFlag
vis) (Type
inner_ty Type -> KindCoercion -> Type
`mkCastTy` KindCoercion
co)

mkCastTy Type
ty KindCoercion
co = Type -> KindCoercion -> Type
CastTy Type
ty KindCoercion
co

tyConBindersTyCoBinders :: [TyConBinder] -> [TyCoBinder]
-- Return the tyConBinders in TyCoBinder form
tyConBindersTyCoBinders :: [TyConBinder] -> [TyCoBinder]
tyConBindersTyCoBinders = forall a b. (a -> b) -> [a] -> [b]
map TyConBinder -> TyCoBinder
to_tyb
  where
    to_tyb :: TyConBinder -> TyCoBinder
to_tyb (Bndr TyVar
tv (NamedTCB ArgFlag
vis)) = VarBndr TyVar ArgFlag -> TyCoBinder
Named (forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv ArgFlag
vis)
    to_tyb (Bndr TyVar
tv (AnonTCB AnonArgFlag
af))   = AnonArgFlag -> Scaled Type -> TyCoBinder
Anon AnonArgFlag
af (forall a. a -> Scaled a
tymult (TyVar -> Type
varType TyVar
tv))

-- | Create the plain type constructor type which has been applied to no type arguments at all.
mkTyConTy :: TyCon -> Type
mkTyConTy :: TyCon -> Type
mkTyConTy TyCon
tycon = TyCon -> Type
tyConNullaryTy TyCon
tycon
  -- see Note [Sharing nullary TyConApps] in GHC.Core.TyCon

-- | A key function: builds a 'TyConApp' or 'FunTy' as appropriate to
-- its arguments.  Applies its arguments to the constructor from left to right.
mkTyConApp :: TyCon -> [Type] -> Type
mkTyConApp :: TyCon -> [Type] -> Type
mkTyConApp TyCon
tycon [Type]
tys
  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys
  = TyCon -> Type
mkTyConTy TyCon
tycon

  | TyCon -> Bool
isFunTyCon TyCon
tycon
  , [Type
w, Type
_rep1,Type
_rep2,Type
ty1,Type
ty2] <- [Type]
tys
  -- The FunTyCon (->) is always a visible one
  = FunTy { ft_af :: AnonArgFlag
ft_af = AnonArgFlag
VisArg, ft_mult :: Type
ft_mult = Type
w, ft_arg :: Type
ft_arg = Type
ty1, ft_res :: Type
ft_res = Type
ty2 }

  -- See Note [Prefer Type over TYPE 'LiftedRep].
  | TyCon
tycon forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
tYPETyConKey
  , [Type
rep] <- [Type]
tys
  = Type -> Type
tYPE Type
rep
  -- The catch-all case
  | Bool
otherwise
  = TyCon -> [Type] -> Type
TyConApp TyCon
tycon [Type]
tys

{-
Note [Prefer Type over TYPE 'LiftedRep]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The Core of nearly any program will have numerous occurrences of
@TYPE 'LiftedRep@ (and, equivalently, 'Type') floating about. Concretely, while
investigating #17292 we found that these constituting a majority of TyConApp
constructors on the heap:

```
(From a sample of 100000 TyConApp closures)
0x45f3523    - 28732 - `Type`
0x420b840702 - 9629  - generic type constructors
0x42055b7e46 - 9596
0x420559b582 - 9511
0x420bb15a1e - 9509
0x420b86c6ba - 9501
0x42055bac1e - 9496
0x45e68fd    - 538 - `TYPE ...`
```

Consequently, we try hard to ensure that operations on such types are
efficient. Specifically, we strive to

 a. Avoid heap allocation of such types
 b. Use a small (shallow in the tree-depth sense) representation
    for such types

Goal (b) is particularly useful as it makes traversals (e.g. free variable
traversal, substitution, and comparison) more efficient.
Comparison in particular takes special advantage of nullary type synonym
applications (e.g. things like @TyConApp typeTyCon []@), Note [Comparing
nullary type synonyms] in "GHC.Core.Type".

To accomplish these we use a number of tricks:

 1. Instead of representing the lifted kind as
    @TyConApp tYPETyCon [liftedRepDataCon]@ we rather prefer to
    use the 'GHC.Types.Type' type synonym (represented as a nullary TyConApp).
    This serves goal (b) since there are no applied type arguments to traverse,
    e.g., during comparison.

 2. We have a top-level binding to represent `TyConApp GHC.Types.Type []`
    (namely 'GHC.Builtin.Types.Prim.liftedTypeKind'), ensuring that we
    don't need to allocate such types (goal (a)).

 3. We use the sharing mechanism described in Note [Sharing nullary TyConApps]
    in GHC.Core.TyCon to ensure that we never need to allocate such
    nullary applications (goal (a)).

See #17958.
-}


-- | Given a @RuntimeRep@, applies @TYPE@ to it.
-- See Note [TYPE and RuntimeRep] in GHC.Builtin.Types.Prim.
tYPE :: Type -> Type
tYPE :: Type -> Type
tYPE rr :: Type
rr@(TyConApp TyCon
tc [Type
arg])
  -- See Note [Prefer Type of TYPE 'LiftedRep]
  | TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
boxedRepDataConKey
  , TyConApp TyCon
tc' [] <- Type
arg
  = if | TyCon
tc' forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
liftedDataConKey   -> Type
liftedTypeKind   -- TYPE (BoxedRep 'Lifted)
       | TyCon
tc' forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
unliftedDataConKey -> Type
unliftedTypeKind -- TYPE (BoxedRep 'Unlifted)
       | Bool
otherwise                       -> TyCon -> [Type] -> Type
TyConApp TyCon
tYPETyCon [Type
rr]
  | TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
liftedRepTyCon                               -- TYPE LiftedRep
  = Type
liftedTypeKind
  | TyCon
tc forall a. Eq a => a -> a -> Bool
== TyCon
unliftedRepTyCon                             -- TYPE UnliftedRep
  = Type
unliftedTypeKind
tYPE Type
rr = TyCon -> [Type] -> Type
TyConApp TyCon
tYPETyCon [Type
rr]


{-
--------------------------------------------------------------------
                            CoercionTy
                            ~~~~~~~~~~
CoercionTy allows us to inject coercions into types. A CoercionTy
should appear only in the right-hand side of an application.
-}

mkCoercionTy :: Coercion -> Type
mkCoercionTy :: KindCoercion -> Type
mkCoercionTy = KindCoercion -> Type
CoercionTy

isCoercionTy :: Type -> Bool
isCoercionTy :: Type -> Bool
isCoercionTy (CoercionTy KindCoercion
_) = Bool
True
isCoercionTy Type
_              = Bool
False

isCoercionTy_maybe :: Type -> Maybe Coercion
isCoercionTy_maybe :: Type -> Maybe KindCoercion
isCoercionTy_maybe (CoercionTy KindCoercion
co) = forall a. a -> Maybe a
Just KindCoercion
co
isCoercionTy_maybe Type
_               = forall a. Maybe a
Nothing

stripCoercionTy :: Type -> Coercion
stripCoercionTy :: Type -> KindCoercion
stripCoercionTy (CoercionTy KindCoercion
co) = KindCoercion
co
stripCoercionTy Type
ty              = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"stripCoercionTy" (forall a. Outputable a => a -> SDoc
ppr Type
ty)

{-
---------------------------------------------------------------------
                                SynTy
                                ~~~~~

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

        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 GHC.Tc.Gen.Bind.


---------------------------------------------------------------------
                                ForAllTy
                                ~~~~~~~~
-}

-- | Make a dependent forall over an 'Inferred' variable
mkTyCoInvForAllTy :: TyCoVar -> Type -> Type
mkTyCoInvForAllTy :: TyVar -> Type -> Type
mkTyCoInvForAllTy TyVar
tv Type
ty
  | TyVar -> Bool
isCoVar TyVar
tv
  , Bool -> Bool
not (TyVar
tv TyVar -> TyCoVarSet -> Bool
`elemVarSet` Type -> TyCoVarSet
tyCoVarsOfType Type
ty)
  = Type -> Type -> Type
mkVisFunTyMany (TyVar -> Type
varType TyVar
tv) Type
ty
  | Bool
otherwise
  = VarBndr TyVar ArgFlag -> Type -> Type
ForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv ArgFlag
Inferred) Type
ty

-- | Like 'mkTyCoInvForAllTy', but tv should be a tyvar
mkInfForAllTy :: TyVar -> Type -> Type
mkInfForAllTy :: TyVar -> Type -> Type
mkInfForAllTy TyVar
tv Type
ty = ASSERT( isTyVar tv )
                      VarBndr TyVar ArgFlag -> Type -> Type
ForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv ArgFlag
Inferred) Type
ty

-- | Like 'mkForAllTys', but assumes all variables are dependent and
-- 'Inferred', a common case
mkTyCoInvForAllTys :: [TyCoVar] -> Type -> Type
mkTyCoInvForAllTys :: [TyVar] -> Type -> Type
mkTyCoInvForAllTys [TyVar]
tvs Type
ty = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TyVar -> Type -> Type
mkTyCoInvForAllTy Type
ty [TyVar]
tvs

-- | Like 'mkTyCoInvForAllTys', but tvs should be a list of tyvar
mkInfForAllTys :: [TyVar] -> Type -> Type
mkInfForAllTys :: [TyVar] -> Type -> Type
mkInfForAllTys [TyVar]
tvs Type
ty = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TyVar -> Type -> Type
mkInfForAllTy Type
ty [TyVar]
tvs

-- | Like 'mkForAllTy', but assumes the variable is dependent and 'Specified',
-- a common case
mkSpecForAllTy :: TyVar -> Type -> Type
mkSpecForAllTy :: TyVar -> Type -> Type
mkSpecForAllTy TyVar
tv Type
ty = ASSERT( isTyVar tv )
                       -- covar is always Inferred, so input should be tyvar
                       VarBndr TyVar ArgFlag -> Type -> Type
ForAllTy (forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv ArgFlag
Specified) Type
ty

-- | Like 'mkForAllTys', but assumes all variables are dependent and
-- 'Specified', a common case
mkSpecForAllTys :: [TyVar] -> Type -> Type
mkSpecForAllTys :: [TyVar] -> Type -> Type
mkSpecForAllTys [TyVar]
tvs Type
ty = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr TyVar -> Type -> Type
mkSpecForAllTy Type
ty [TyVar]
tvs

-- | Like mkForAllTys, but assumes all variables are dependent and visible
mkVisForAllTys :: [TyVar] -> Type -> Type
mkVisForAllTys :: [TyVar] -> Type -> Type
mkVisForAllTys [TyVar]
tvs = ASSERT( all isTyVar tvs )
                     -- covar is always Inferred, so all inputs should be tyvar
                     [VarBndr TyVar ArgFlag] -> Type -> Type
mkForAllTys [ forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tv ArgFlag
Required | TyVar
tv <- [TyVar]
tvs ]

-- | Given a list of type-level vars and the free vars of a result kind,
-- makes TyCoBinders, preferring anonymous binders
-- if the variable is, in fact, not dependent.
-- e.g.    mkTyConBindersPreferAnon [(k:*),(b:k),(c:k)] (k->k)
-- We want (k:*) Named, (b:k) Anon, (c:k) Anon
--
-- All non-coercion binders are /visible/.
mkTyConBindersPreferAnon :: [TyVar]      -- ^ binders
                         -> TyCoVarSet   -- ^ free variables of result
                         -> [TyConBinder]
mkTyConBindersPreferAnon :: [TyVar] -> TyCoVarSet -> [TyConBinder]
mkTyConBindersPreferAnon [TyVar]
vars TyCoVarSet
inner_tkvs = ASSERT( all isTyVar vars)
                                           forall a b. (a, b) -> a
fst ([TyVar] -> ([TyConBinder], TyCoVarSet)
go [TyVar]
vars)
  where
    go :: [TyVar] -> ([TyConBinder], VarSet) -- also returns the free vars
    go :: [TyVar] -> ([TyConBinder], TyCoVarSet)
go [] = ([], TyCoVarSet
inner_tkvs)
    go (TyVar
v:[TyVar]
vs) | TyVar
v TyVar -> TyCoVarSet -> Bool
`elemVarSet` TyCoVarSet
fvs
              = ( forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
v (ArgFlag -> TyConBndrVis
NamedTCB ArgFlag
Required) forall a. a -> [a] -> [a]
: [TyConBinder]
binders
                , TyCoVarSet
fvs TyCoVarSet -> TyVar -> TyCoVarSet
`delVarSet` TyVar
v TyCoVarSet -> TyCoVarSet -> TyCoVarSet
`unionVarSet` TyCoVarSet
kind_vars )
              | Bool
otherwise
              = ( forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
v (AnonArgFlag -> TyConBndrVis
AnonTCB AnonArgFlag
VisArg) forall a. a -> [a] -> [a]
: [TyConBinder]
binders
                , TyCoVarSet
fvs TyCoVarSet -> TyCoVarSet -> TyCoVarSet
`unionVarSet` TyCoVarSet
kind_vars )
      where
        ([TyConBinder]
binders, TyCoVarSet
fvs) = [TyVar] -> ([TyConBinder], TyCoVarSet)
go [TyVar]
vs
        kind_vars :: TyCoVarSet
kind_vars      = Type -> TyCoVarSet
tyCoVarsOfType forall a b. (a -> b) -> a -> b
$ TyVar -> Type
tyVarKind TyVar
v

-- | Take a ForAllTy apart, returning the list of tycovars and the result type.
-- This always succeeds, even if it returns only an empty list. Note that the
-- result type returned may have free variables that were bound by a forall.
splitForAllTyCoVars :: Type -> ([TyCoVar], Type)
splitForAllTyCoVars :: Type -> ([TyVar], Type)
splitForAllTyCoVars Type
ty = Type -> Type -> [TyVar] -> ([TyVar], Type)
split Type
ty Type
ty []
  where
    split :: Type -> Type -> [TyVar] -> ([TyVar], Type)
split Type
_       (ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
ty)    [TyVar]
tvs = Type -> Type -> [TyVar] -> ([TyVar], Type)
split Type
ty Type
ty (TyVar
tvforall a. a -> [a] -> [a]
:[TyVar]
tvs)
    split Type
orig_ty Type
ty [TyVar]
tvs | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Type -> [TyVar] -> ([TyVar], Type)
split Type
orig_ty Type
ty' [TyVar]
tvs
    split Type
orig_ty Type
_                            [TyVar]
tvs = (forall a. [a] -> [a]
reverse [TyVar]
tvs, Type
orig_ty)

-- | Splits the longest initial sequence of 'ForAllTy's that satisfy
-- @argf_pred@, returning the binders transformed by @argf_pred@
splitSomeForAllTyCoVarBndrs :: (ArgFlag -> Maybe af) -> Type -> ([VarBndr TyCoVar af], Type)
splitSomeForAllTyCoVarBndrs :: forall af.
(ArgFlag -> Maybe af) -> Type -> ([VarBndr TyVar af], Type)
splitSomeForAllTyCoVarBndrs ArgFlag -> Maybe af
argf_pred Type
ty = Type -> Type -> [VarBndr TyVar af] -> ([VarBndr TyVar af], Type)
split Type
ty Type
ty []
  where
    split :: Type -> Type -> [VarBndr TyVar af] -> ([VarBndr TyVar af], Type)
split Type
_ (ForAllTy (Bndr TyVar
tcv ArgFlag
argf) Type
ty) [VarBndr TyVar af]
tvs
      | Just af
argf' <- ArgFlag -> Maybe af
argf_pred ArgFlag
argf               = Type -> Type -> [VarBndr TyVar af] -> ([VarBndr TyVar af], Type)
split Type
ty Type
ty (forall var argf. var -> argf -> VarBndr var argf
Bndr TyVar
tcv af
argf' forall a. a -> [a] -> [a]
: [VarBndr TyVar af]
tvs)
    split Type
orig_ty Type
ty [VarBndr TyVar af]
tvs | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Type -> [VarBndr TyVar af] -> ([VarBndr TyVar af], Type)
split Type
orig_ty Type
ty' [VarBndr TyVar af]
tvs
    split Type
orig_ty Type
_                            [VarBndr TyVar af]
tvs = (forall a. [a] -> [a]
reverse [VarBndr TyVar af]
tvs, Type
orig_ty)

-- | Like 'splitForAllTyCoVars', but only splits 'ForAllTy's with 'Required' type
-- variable binders. Furthermore, each returned tyvar is annotated with '()'.
splitForAllReqTVBinders :: Type -> ([ReqTVBinder], Type)
splitForAllReqTVBinders :: Type -> ([ReqTVBinder], Type)
splitForAllReqTVBinders Type
ty = forall af.
(ArgFlag -> Maybe af) -> Type -> ([VarBndr TyVar af], Type)
splitSomeForAllTyCoVarBndrs ArgFlag -> Maybe ()
argf_pred Type
ty
  where
    argf_pred :: ArgFlag -> Maybe ()
    argf_pred :: ArgFlag -> Maybe ()
argf_pred ArgFlag
Required       = forall a. a -> Maybe a
Just ()
    argf_pred (Invisible {}) = forall a. Maybe a
Nothing

-- | Like 'splitForAllTyCoVars', but only splits 'ForAllTy's with 'Invisible' type
-- variable binders. Furthermore, each returned tyvar is annotated with its
-- 'Specificity'.
splitForAllInvisTVBinders :: Type -> ([InvisTVBinder], Type)
splitForAllInvisTVBinders :: Type -> ([InvisTVBinder], Type)
splitForAllInvisTVBinders Type
ty = forall af.
(ArgFlag -> Maybe af) -> Type -> ([VarBndr TyVar af], Type)
splitSomeForAllTyCoVarBndrs ArgFlag -> Maybe Specificity
argf_pred Type
ty
  where
    argf_pred :: ArgFlag -> Maybe Specificity
    argf_pred :: ArgFlag -> Maybe Specificity
argf_pred ArgFlag
Required         = forall a. Maybe a
Nothing
    argf_pred (Invisible Specificity
spec) = forall a. a -> Maybe a
Just Specificity
spec

-- | Like 'splitForAllTyCoVars', but split only for tyvars.
-- This always succeeds, even if it returns only an empty list. Note that the
-- result type returned may have free variables that were bound by a forall.
splitForAllTyVars :: Type -> ([TyVar], Type)
splitForAllTyVars :: Type -> ([TyVar], Type)
splitForAllTyVars Type
ty = Type -> Type -> [TyVar] -> ([TyVar], Type)
split Type
ty Type
ty []
  where
    split :: Type -> Type -> [TyVar] -> ([TyVar], Type)
split Type
_ (ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
ty) [TyVar]
tvs | TyVar -> Bool
isTyVar TyVar
tv = Type -> Type -> [TyVar] -> ([TyVar], Type)
split Type
ty Type
ty (TyVar
tvforall a. a -> [a] -> [a]
:[TyVar]
tvs)
    split Type
orig_ty Type
ty [TyVar]
tvs | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty     = Type -> Type -> [TyVar] -> ([TyVar], Type)
split Type
orig_ty Type
ty' [TyVar]
tvs
    split Type
orig_ty Type
_                   [TyVar]
tvs              = (forall a. [a] -> [a]
reverse [TyVar]
tvs, Type
orig_ty)

-- | Checks whether this is a proper forall (with a named binder)
isForAllTy :: Type -> Bool
isForAllTy :: Type -> Bool
isForAllTy Type
ty
  | ForAllTy {} <- Type -> Type
coreFullView Type
ty = Bool
True
  | Bool
otherwise                      = Bool
False

-- | Like `isForAllTy`, but returns True only if it is a tyvar binder
isForAllTy_ty :: Type -> Bool
isForAllTy_ty :: Type -> Bool
isForAllTy_ty Type
ty
  | ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
_ <- Type -> Type
coreFullView Type
ty
  , TyVar -> Bool
isTyVar TyVar
tv
  = Bool
True

  | Bool
otherwise = Bool
False

-- | Like `isForAllTy`, but returns True only if it is a covar binder
isForAllTy_co :: Type -> Bool
isForAllTy_co :: Type -> Bool
isForAllTy_co Type
ty
  | ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
_ <- Type -> Type
coreFullView Type
ty
  , TyVar -> Bool
isCoVar TyVar
tv
  = Bool
True

  | Bool
otherwise = Bool
False

-- | Is this a function or forall?
isPiTy :: Type -> Bool
isPiTy :: Type -> Bool
isPiTy Type
ty = case Type -> Type
coreFullView Type
ty of
  ForAllTy {} -> Bool
True
  FunTy {}    -> Bool
True
  Type
_           -> Bool
False

-- | Is this a function?
isFunTy :: Type -> Bool
isFunTy :: Type -> Bool
isFunTy Type
ty
  | FunTy {} <- Type -> Type
coreFullView Type
ty = Bool
True
  | Bool
otherwise                   = Bool
False

-- | Take a forall type apart, or panics if that is not possible.
splitForAllTyCoVar :: Type -> (TyCoVar, Type)
splitForAllTyCoVar :: Type -> (TyVar, Type)
splitForAllTyCoVar Type
ty
  | Just (TyVar, Type)
answer <- Type -> Maybe (TyVar, Type)
splitForAllTyCoVar_maybe Type
ty = (TyVar, Type)
answer
  | Bool
otherwise                                  = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"splitForAllTyCoVar" (forall a. Outputable a => a -> SDoc
ppr Type
ty)

-- | Drops all ForAllTys
dropForAlls :: Type -> Type
dropForAlls :: Type -> Type
dropForAlls Type
ty = Type -> Type
go Type
ty
  where
    go :: Type -> Type
go (ForAllTy VarBndr TyVar ArgFlag
_ Type
res)            = Type -> Type
go Type
res
    go Type
ty | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Type
go Type
ty'
    go Type
res                         = Type
res

-- | Attempts to take a forall type apart, but only if it's a proper forall,
-- with a named binder
splitForAllTyCoVar_maybe :: Type -> Maybe (TyCoVar, Type)
splitForAllTyCoVar_maybe :: Type -> Maybe (TyVar, Type)
splitForAllTyCoVar_maybe Type
ty
  | ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
inner_ty <- Type -> Type
coreFullView Type
ty = forall a. a -> Maybe a
Just (TyVar
tv, Type
inner_ty)
  | Bool
otherwise                                        = forall a. Maybe a
Nothing

-- | Like 'splitForAllTyCoVar_maybe', but only returns Just if it is a tyvar binder.
splitForAllTyVar_maybe :: Type -> Maybe (TyCoVar, Type)
splitForAllTyVar_maybe :: Type -> Maybe (TyVar, Type)
splitForAllTyVar_maybe Type
ty
  | ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
inner_ty <- Type -> Type
coreFullView Type
ty
  , TyVar -> Bool
isTyVar TyVar
tv
  = forall a. a -> Maybe a
Just (TyVar
tv, Type
inner_ty)

  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Like 'splitForAllTyCoVar_maybe', but only returns Just if it is a covar binder.
splitForAllCoVar_maybe :: Type -> Maybe (TyCoVar, Type)
splitForAllCoVar_maybe :: Type -> Maybe (TyVar, Type)
splitForAllCoVar_maybe Type
ty
  | ForAllTy (Bndr TyVar
tv ArgFlag
_) Type
inner_ty <- Type -> Type
coreFullView Type
ty
  , TyVar -> Bool
isCoVar TyVar
tv
  = forall a. a -> Maybe a
Just (TyVar
tv, Type
inner_ty)

  | Bool
otherwise = forall a. Maybe a
Nothing

-- | Attempts to take a forall type apart; works with proper foralls and
-- functions
{-# INLINE splitPiTy_maybe #-}  -- callers will immediately deconstruct
splitPiTy_maybe :: Type -> Maybe (TyCoBinder, Type)
splitPiTy_maybe :: Type -> Maybe (TyCoBinder, Type)
splitPiTy_maybe Type
ty = case Type -> Type
coreFullView Type
ty of
  ForAllTy VarBndr TyVar ArgFlag
bndr Type
ty -> forall a. a -> Maybe a
Just (VarBndr TyVar ArgFlag -> TyCoBinder
Named VarBndr TyVar ArgFlag
bndr, Type
ty)
  FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_mult :: Type -> Type
ft_mult = Type
w, ft_arg :: Type -> Type
ft_arg = Type
arg, ft_res :: Type -> Type
ft_res = Type
res}
                   -> forall a. a -> Maybe a
Just (AnonArgFlag -> Scaled Type -> TyCoBinder
Anon AnonArgFlag
af (forall a. Type -> a -> Scaled a
mkScaled Type
w Type
arg), Type
res)
  Type
_                -> forall a. Maybe a
Nothing

-- | Takes a forall type apart, or panics
splitPiTy :: Type -> (TyCoBinder, Type)
splitPiTy :: Type -> (TyCoBinder, Type)
splitPiTy Type
ty
  | Just (TyCoBinder, Type)
answer <- Type -> Maybe (TyCoBinder, Type)
splitPiTy_maybe Type
ty = (TyCoBinder, Type)
answer
  | Bool
otherwise                         = forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"splitPiTy" (forall a. Outputable a => a -> SDoc
ppr Type
ty)

-- | Split off all TyCoBinders to a type, splitting both proper foralls
-- and functions
splitPiTys :: Type -> ([TyCoBinder], Type)
splitPiTys :: Type -> ([TyCoBinder], Type)
splitPiTys Type
ty = Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
ty Type
ty []
  where
    split :: Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
_       (ForAllTy VarBndr TyVar ArgFlag
b Type
res) [TyCoBinder]
bs = Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
res Type
res (VarBndr TyVar ArgFlag -> TyCoBinder
Named VarBndr TyVar ArgFlag
b  forall a. a -> [a] -> [a]
: [TyCoBinder]
bs)
    split Type
_       (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_mult :: Type -> Type
ft_mult = Type
w, ft_arg :: Type -> Type
ft_arg = Type
arg, ft_res :: Type -> Type
ft_res = Type
res }) [TyCoBinder]
bs
                                      = Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
res Type
res (AnonArgFlag -> Scaled Type -> TyCoBinder
Anon AnonArgFlag
af (forall a. Type -> a -> Scaled a
Scaled Type
w Type
arg) forall a. a -> [a] -> [a]
: [TyCoBinder]
bs)
    split Type
orig_ty Type
ty [TyCoBinder]
bs | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
orig_ty Type
ty' [TyCoBinder]
bs
    split Type
orig_ty Type
_                [TyCoBinder]
bs = (forall a. [a] -> [a]
reverse [TyCoBinder]
bs, Type
orig_ty)

-- | Like 'splitPiTys' but split off only /named/ binders
--   and returns 'TyCoVarBinder's rather than 'TyCoBinder's
splitForAllTyCoVarBinders :: Type -> ([TyCoVarBinder], Type)
splitForAllTyCoVarBinders :: Type -> ([VarBndr TyVar ArgFlag], Type)
splitForAllTyCoVarBinders Type
ty = Type
-> Type
-> [VarBndr TyVar ArgFlag]
-> ([VarBndr TyVar ArgFlag], Type)
split Type
ty Type
ty []
  where
    split :: Type
-> Type
-> [VarBndr TyVar ArgFlag]
-> ([VarBndr TyVar ArgFlag], Type)
split Type
orig_ty Type
ty [VarBndr TyVar ArgFlag]
bs | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type
-> Type
-> [VarBndr TyVar ArgFlag]
-> ([VarBndr TyVar ArgFlag], Type)
split Type
orig_ty Type
ty' [VarBndr TyVar ArgFlag]
bs
    split Type
_       (ForAllTy VarBndr TyVar ArgFlag
b Type
res) [VarBndr TyVar ArgFlag]
bs = Type
-> Type
-> [VarBndr TyVar ArgFlag]
-> ([VarBndr TyVar ArgFlag], Type)
split Type
res Type
res (VarBndr TyVar ArgFlag
bforall a. a -> [a] -> [a]
:[VarBndr TyVar ArgFlag]
bs)
    split Type
orig_ty Type
_                [VarBndr TyVar ArgFlag]
bs = (forall a. [a] -> [a]
reverse [VarBndr TyVar ArgFlag]
bs, Type
orig_ty)
{-# INLINE splitForAllTyCoVarBinders #-}

invisibleTyBndrCount :: Type -> Int
-- Returns the number of leading invisible forall'd binders in the type
-- Includes invisible predicate arguments; e.g. for
--    e.g.  forall {k}. (k ~ *) => k -> k
-- returns 2 not 1
invisibleTyBndrCount :: Type -> Int
invisibleTyBndrCount Type
ty = forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a b. (a, b) -> a
fst (Type -> ([TyCoBinder], Type)
splitInvisPiTys Type
ty))

-- | Like 'splitPiTys', but returns only *invisible* binders, including constraints.
-- Stops at the first visible binder.
splitInvisPiTys :: Type -> ([TyCoBinder], Type)
splitInvisPiTys :: Type -> ([TyCoBinder], Type)
splitInvisPiTys Type
ty = Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
ty Type
ty []
   where
    split :: Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
_ (ForAllTy VarBndr TyVar ArgFlag
b Type
res) [TyCoBinder]
bs
      | Bndr TyVar
_ ArgFlag
vis <- VarBndr TyVar ArgFlag
b
      , ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
vis   = Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
res Type
res (VarBndr TyVar ArgFlag -> TyCoBinder
Named VarBndr TyVar ArgFlag
b  forall a. a -> [a] -> [a]
: [TyCoBinder]
bs)
    split Type
_ (FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg, ft_mult :: Type -> Type
ft_mult = Type
mult, ft_arg :: Type -> Type
ft_arg = Type
arg, ft_res :: Type -> Type
ft_res = Type
res })  [TyCoBinder]
bs
                                 = Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
res Type
res (AnonArgFlag -> Scaled Type -> TyCoBinder
Anon AnonArgFlag
InvisArg (forall a. Type -> a -> Scaled a
mkScaled Type
mult Type
arg) forall a. a -> [a] -> [a]
: [TyCoBinder]
bs)
    split Type
orig_ty Type
ty [TyCoBinder]
bs
      | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty  = Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Type
orig_ty Type
ty' [TyCoBinder]
bs
    split Type
orig_ty Type
_          [TyCoBinder]
bs  = (forall a. [a] -> [a]
reverse [TyCoBinder]
bs, Type
orig_ty)

splitInvisPiTysN :: Int -> Type -> ([TyCoBinder], Type)
-- ^ Same as 'splitInvisPiTys', but stop when
--   - you have found @n@ 'TyCoBinder's,
--   - or you run out of invisible binders
splitInvisPiTysN :: Int -> Type -> ([TyCoBinder], Type)
splitInvisPiTysN Int
n Type
ty = forall {t}.
(Eq t, Num t) =>
t -> Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split Int
n Type
ty Type
ty []
   where
    split :: t -> Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split t
n Type
orig_ty Type
ty [TyCoBinder]
bs
      | t
n forall a. Eq a => a -> a -> Bool
== t
0                  = (forall a. [a] -> [a]
reverse [TyCoBinder]
bs, Type
orig_ty)
      | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = t -> Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split t
n Type
orig_ty Type
ty' [TyCoBinder]
bs
      | ForAllTy VarBndr TyVar ArgFlag
b Type
res <- Type
ty
      , Bndr TyVar
_ ArgFlag
vis <- VarBndr TyVar ArgFlag
b
      , ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
vis  = t -> Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split (t
nforall a. Num a => a -> a -> a
-t
1) Type
res Type
res (VarBndr TyVar ArgFlag -> TyCoBinder
Named VarBndr TyVar ArgFlag
b  forall a. a -> [a] -> [a]
: [TyCoBinder]
bs)
      | FunTy { ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
InvisArg, ft_mult :: Type -> Type
ft_mult = Type
mult, ft_arg :: Type -> Type
ft_arg = Type
arg, ft_res :: Type -> Type
ft_res = Type
res } <- Type
ty
                                = t -> Type -> Type -> [TyCoBinder] -> ([TyCoBinder], Type)
split (t
nforall a. Num a => a -> a -> a
-t
1) Type
res Type
res (AnonArgFlag -> Scaled Type -> TyCoBinder
Anon AnonArgFlag
InvisArg (forall a. Type -> a -> Scaled a
Scaled Type
mult Type
arg) forall a. a -> [a] -> [a]
: [TyCoBinder]
bs)
      | Bool
otherwise               = (forall a. [a] -> [a]
reverse [TyCoBinder]
bs, Type
orig_ty)

-- | Given a 'TyCon' and a list of argument types, filter out any invisible
-- (i.e., 'Inferred' or 'Specified') arguments.
filterOutInvisibleTypes :: TyCon -> [Type] -> [Type]
filterOutInvisibleTypes :: TyCon -> [Type] -> [Type]
filterOutInvisibleTypes TyCon
tc [Type]
tys = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ TyCon -> [Type] -> ([Type], [Type])
partitionInvisibleTypes TyCon
tc [Type]
tys

-- | Given a 'TyCon' and a list of argument types, filter out any 'Inferred'
-- arguments.
filterOutInferredTypes :: TyCon -> [Type] -> [Type]
filterOutInferredTypes :: TyCon -> [Type] -> [Type]
filterOutInferredTypes TyCon
tc [Type]
tys =
  forall a. [Bool] -> [a] -> [a]
filterByList (forall a b. (a -> b) -> [a] -> [b]
map (forall a. Eq a => a -> a -> Bool
/= ArgFlag
Inferred) forall a b. (a -> b) -> a -> b
$ TyCon -> [Type] -> [ArgFlag]
tyConArgFlags TyCon
tc [Type]
tys) [Type]
tys

-- | Given a 'TyCon' and a list of argument types, partition the arguments
-- into:
--
-- 1. 'Inferred' or 'Specified' (i.e., invisible) arguments and
--
-- 2. 'Required' (i.e., visible) arguments
partitionInvisibleTypes :: TyCon -> [Type] -> ([Type], [Type])
partitionInvisibleTypes :: TyCon -> [Type] -> ([Type], [Type])
partitionInvisibleTypes TyCon
tc [Type]
tys =
  forall a. [Bool] -> [a] -> ([a], [a])
partitionByList (forall a b. (a -> b) -> [a] -> [b]
map ArgFlag -> Bool
isInvisibleArgFlag forall a b. (a -> b) -> a -> b
$ TyCon -> [Type] -> [ArgFlag]
tyConArgFlags TyCon
tc [Type]
tys) [Type]
tys

-- | Given a list of things paired with their visibilities, partition the
-- things into (invisible things, visible things).
partitionInvisibles :: [(a, ArgFlag)] -> ([a], [a])
partitionInvisibles :: forall a. [(a, ArgFlag)] -> ([a], [a])
partitionInvisibles = forall a b c. (a -> Either b c) -> [a] -> ([b], [c])
partitionWith forall a. (a, ArgFlag) -> Either a a
pick_invis
  where
    pick_invis :: (a, ArgFlag) -> Either a a
    pick_invis :: forall a. (a, ArgFlag) -> Either a a
pick_invis (a
thing, ArgFlag
vis) | ArgFlag -> Bool
isInvisibleArgFlag ArgFlag
vis = forall a b. a -> Either a b
Left a
thing
                            | Bool
otherwise              = forall a b. b -> Either a b
Right a
thing

-- | Given a 'TyCon' and a list of argument types to which the 'TyCon' is
-- applied, determine each argument's visibility
-- ('Inferred', 'Specified', or 'Required').
--
-- Wrinkle: consider the following scenario:
--
-- > T :: forall k. k -> k
-- > tyConArgFlags T [forall m. m -> m -> m, S, R, Q]
--
-- After substituting, we get
--
-- > T (forall m. m -> m -> m) :: (forall m. m -> m -> m) -> forall n. n -> n -> n
--
-- Thus, the first argument is invisible, @S@ is visible, @R@ is invisible again,
-- and @Q@ is visible.
tyConArgFlags :: TyCon -> [Type] -> [ArgFlag]
tyConArgFlags :: TyCon -> [Type] -> [ArgFlag]
tyConArgFlags TyCon
tc = Type -> [Type] -> [ArgFlag]
fun_kind_arg_flags (TyCon -> Type
tyConKind TyCon
tc)

-- | Given a 'Type' and a list of argument types to which the 'Type' is
-- applied, determine each argument's visibility
-- ('Inferred', 'Specified', or 'Required').
--
-- Most of the time, the arguments will be 'Required', but not always. Consider
-- @f :: forall a. a -> Type@. In @f Type Bool@, the first argument (@Type@) is
-- 'Specified' and the second argument (@Bool@) is 'Required'. It is precisely
-- this sort of higher-rank situation in which 'appTyArgFlags' comes in handy,
-- since @f Type Bool@ would be represented in Core using 'AppTy's.
-- (See also #15792).
appTyArgFlags :: Type -> [Type] -> [ArgFlag]
appTyArgFlags :: Type -> [Type] -> [ArgFlag]
appTyArgFlags Type
ty = Type -> [Type] -> [ArgFlag]
fun_kind_arg_flags (HasDebugCallStack => Type -> Type
typeKind Type
ty)

-- | Given a function kind and a list of argument types (where each argument's
-- kind aligns with the corresponding position in the argument kind), determine
-- each argument's visibility ('Inferred', 'Specified', or 'Required').
fun_kind_arg_flags :: Kind -> [Type] -> [ArgFlag]
fun_kind_arg_flags :: Type -> [Type] -> [ArgFlag]
fun_kind_arg_flags = TCvSubst -> Type -> [Type] -> [ArgFlag]
go TCvSubst
emptyTCvSubst
  where
    go :: TCvSubst -> Type -> [Type] -> [ArgFlag]
go TCvSubst
subst Type
ki [Type]
arg_tys
      | Just Type
ki' <- Type -> Maybe Type
coreView Type
ki = TCvSubst -> Type -> [Type] -> [ArgFlag]
go TCvSubst
subst Type
ki' [Type]
arg_tys
    go TCvSubst
_ Type
_ [] = []
    go TCvSubst
subst (ForAllTy (Bndr TyVar
tv ArgFlag
argf) Type
res_ki) (Type
arg_ty:[Type]
arg_tys)
      = ArgFlag
argf forall a. a -> [a] -> [a]
: TCvSubst -> Type -> [Type] -> [ArgFlag]
go TCvSubst
subst' Type
res_ki [Type]
arg_tys
      where
        subst' :: TCvSubst
subst' = TCvSubst -> TyVar -> Type -> TCvSubst
extendTvSubst TCvSubst
subst TyVar
tv Type
arg_ty
    go TCvSubst
subst (TyVarTy TyVar
tv) [Type]
arg_tys
      | Just Type
ki <- TCvSubst -> TyVar -> Maybe Type
lookupTyVar TCvSubst
subst TyVar
tv = TCvSubst -> Type -> [Type] -> [ArgFlag]
go TCvSubst
subst Type
ki [Type]
arg_tys
    -- This FunTy case is important to handle kinds with nested foralls, such
    -- as this kind (inspired by #16518):
    --
    --   forall {k1} k2. k1 -> k2 -> forall k3. k3 -> Type
    --
    -- Here, we want to get the following ArgFlags:
    --
    -- [Inferred,   Specified, Required, Required, Specified, Required]
    -- forall {k1}. forall k2. k1 ->     k2 ->     forall k3. k3 ->     Type
    go TCvSubst
subst (FunTy{ft_af :: Type -> AnonArgFlag
ft_af = AnonArgFlag
af, ft_res :: Type -> Type
ft_res = Type
res_ki}) (Type
_:[Type]
arg_tys)
      = ArgFlag
argf forall a. a -> [a] -> [a]
: TCvSubst -> Type -> [Type] -> [ArgFlag]
go TCvSubst
subst Type
res_ki [Type]
arg_tys
      where
        argf :: ArgFlag
argf = case AnonArgFlag
af of
                 AnonArgFlag
VisArg   -> ArgFlag
Required
                 AnonArgFlag
InvisArg -> ArgFlag
Inferred
    go TCvSubst
_ Type
_ [Type]
arg_tys = forall a b. (a -> b) -> [a] -> [b]
map (forall a b. a -> b -> a
const ArgFlag
Required) [Type]
arg_tys
                        -- something is ill-kinded. But this can happen
                        -- when printing errors. Assume everything is Required.

-- @isTauTy@ tests if a type has no foralls or (=>)
isTauTy :: Type -> Bool
isTauTy :: Type -> Bool
isTauTy Type
ty | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Bool
isTauTy Type
ty'
isTauTy (TyVarTy TyVar
_)       = Bool
True
isTauTy (LitTy {})        = Bool
True
isTauTy (TyConApp TyCon
tc [Type]
tys) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
isTauTy [Type]
tys Bool -> Bool -> Bool
&& TyCon -> Bool
isTauTyCon TyCon
tc
isTauTy (AppTy Type
a Type
b)       = Type -> Bool
isTauTy Type
a Bool -> Bool -> Bool
&& Type -> Bool
isTauTy Type
b
isTauTy (FunTy AnonArgFlag
af Type
w Type
a Type
b)    = case AnonArgFlag
af of
                                AnonArgFlag
InvisArg -> Bool
False                               -- e.g., Eq a => b
                                AnonArgFlag
VisArg   -> Type -> Bool
isTauTy Type
w Bool -> Bool -> Bool
&& Type -> Bool
isTauTy Type
a Bool -> Bool -> Bool
&& Type -> Bool
isTauTy Type
b -- e.g., a -> b
isTauTy (ForAllTy {})     = Bool
False
isTauTy (CastTy Type
ty KindCoercion
_)     = Type -> Bool
isTauTy Type
ty
isTauTy (CoercionTy KindCoercion
_)    = Bool
False  -- Not sure about this

isAtomicTy :: Type -> Bool
-- True if the type is just a single token, and can be printed compactly
-- Used when deciding how to lay out type error messages; see the
-- call in GHC.Tc.Errors
isAtomicTy :: Type -> Bool
isAtomicTy (TyVarTy {})    = Bool
True
isAtomicTy (LitTy {})      = Bool
True
isAtomicTy (TyConApp TyCon
_ []) = Bool
True

isAtomicTy Type
ty | Type -> Bool
isLiftedTypeKind Type
ty = Bool
True
   -- 'Type' prints compactly as *
   -- See GHC.Iface.Type.ppr_kind_type

isAtomicTy Type
_ = Bool
False

{-
%************************************************************************
%*                                                                      *
   TyCoBinders
%*                                                                      *
%************************************************************************
-}

-- | Make an anonymous binder
mkAnonBinder :: AnonArgFlag -> Scaled Type -> TyCoBinder
mkAnonBinder :: AnonArgFlag -> Scaled Type -> TyCoBinder
mkAnonBinder = AnonArgFlag -> Scaled Type -> TyCoBinder
Anon

-- | Does this binder bind a variable that is /not/ erased? Returns
-- 'True' for anonymous binders.
isAnonTyCoBinder :: TyCoBinder -> Bool
isAnonTyCoBinder :: TyCoBinder -> Bool
isAnonTyCoBinder (Named {}) = Bool
False
isAnonTyCoBinder (Anon {})  = Bool
True

tyCoBinderVar_maybe :: TyCoBinder -> Maybe TyCoVar
tyCoBinderVar_maybe :: TyCoBinder -> Maybe TyVar
tyCoBinderVar_maybe (Named VarBndr TyVar ArgFlag
tv) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall tv argf. VarBndr tv argf -> tv
binderVar VarBndr TyVar ArgFlag
tv
tyCoBinderVar_maybe TyCoBinder
_          = forall a. Maybe a
Nothing

tyCoBinderType :: TyCoBinder -> Type
tyCoBinderType :: TyCoBinder -> Type
tyCoBinderType (Named VarBndr TyVar ArgFlag
tvb) = forall argf. VarBndr TyVar argf -> Type
binderType VarBndr TyVar ArgFlag
tvb
tyCoBinderType (Anon AnonArgFlag
_ Scaled Type
ty)   = forall a. Scaled a -> a
scaledThing Scaled Type
ty

tyBinderType :: TyBinder -> Type
tyBinderType :: TyCoBinder -> Type
tyBinderType (Named (Bndr TyVar
tv ArgFlag
_))
  = ASSERT( isTyVar tv )
    TyVar -> Type
tyVarKind TyVar
tv
tyBinderType (Anon AnonArgFlag
_ Scaled Type
ty)   = forall a. Scaled a -> a
scaledThing Scaled Type
ty

-- | Extract a relevant type, if there is one.
binderRelevantType_maybe :: TyCoBinder -> Maybe Type
binderRelevantType_maybe :: TyCoBinder -> Maybe Type
binderRelevantType_maybe (Named {}) = forall a. Maybe a
Nothing
binderRelevantType_maybe (Anon AnonArgFlag
_ Scaled Type
ty)  = forall a. a -> Maybe a
Just (forall a. Scaled a -> a
scaledThing Scaled Type
ty)

{-
************************************************************************
*                                                                      *
\subsection{Type families}
*                                                                      *
************************************************************************
-}

mkFamilyTyConApp :: TyCon -> [Type] -> Type
-- ^ Given a family instance TyCon and its arg types, return the
-- corresponding family type.  E.g:
--
-- > data family T a
-- > data instance T (Maybe b) = MkT b
--
-- Where the instance tycon is :RTL, so:
--
-- > mkFamilyTyConApp :RTL Int  =  T (Maybe Int)
mkFamilyTyConApp :: TyCon -> [Type] -> Type
mkFamilyTyConApp TyCon
tc [Type]
tys
  | Just (TyCon
fam_tc, [Type]
fam_tys) <- TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe TyCon
tc
  , let tvs :: [TyVar]
tvs = TyCon -> [TyVar]
tyConTyVars TyCon
tc
        fam_subst :: TCvSubst
fam_subst = ASSERT2( tvs `equalLength` tys, ppr tc <+> ppr tys )
                    HasDebugCallStack => [TyVar] -> [Type] -> TCvSubst
zipTvSubst [TyVar]
tvs [Type]
tys
  = TyCon -> [Type] -> Type
mkTyConApp TyCon
fam_tc (HasCallStack => TCvSubst -> [Type] -> [Type]
substTys TCvSubst
fam_subst [Type]
fam_tys)
  | Bool
otherwise
  = TyCon -> [Type] -> Type
mkTyConApp TyCon
tc [Type]
tys

-- | Get the type on the LHS of a coercion induced by a type/data
-- family instance.
coAxNthLHS :: CoAxiom br -> Int -> Type
coAxNthLHS :: forall (br :: BranchFlag). CoAxiom br -> Int -> Type
coAxNthLHS CoAxiom br
ax Int
ind =
  TyCon -> [Type] -> Type
mkTyConApp (forall (br :: BranchFlag). CoAxiom br -> TyCon
coAxiomTyCon CoAxiom br
ax) (CoAxBranch -> [Type]
coAxBranchLHS (forall (br :: BranchFlag). CoAxiom br -> Int -> CoAxBranch
coAxiomNthBranch CoAxiom br
ax Int
ind))

isFamFreeTy :: Type -> Bool
isFamFreeTy :: Type -> Bool
isFamFreeTy Type
ty | Just Type
ty' <- Type -> Maybe Type
coreView Type
ty = Type -> Bool
isFamFreeTy Type
ty'
isFamFreeTy (TyVarTy TyVar
_)       = Bool
True
isFamFreeTy (LitTy {})        = Bool
True
isFamFreeTy (TyConApp TyCon
tc [Type]
tys) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Type -> Bool
isFamFreeTy [Type]
tys Bool -> Bool -> Bool
&& TyCon -> Bool
isFamFreeTyCon TyCon
tc
isFamFreeTy (AppTy Type
a Type
b)       = Type -> Bool
isFamFreeTy Type
a Bool -> Bool -> Bool
&& Type -> Bool
isFamFreeTy Type
b
isFamFreeTy (FunTy AnonArgFlag
_ Type
w Type
a Type
b)   = Type -> Bool
isFamFreeTy Type
w Bool -> Bool -> Bool
&& Type -> Bool
isFamFreeTy Type
a Bool -> Bool -> Bool
&& Type -> Bool
isFamFreeTy Type
b
isFamFreeTy (ForAllTy VarBndr TyVar ArgFlag
_ Type
ty)   = Type -> Bool
isFamFreeTy Type
ty
isFamFreeTy (CastTy Type
ty KindCoercion
_)     = Type -> Bool
isFamFreeTy Type
ty
isFamFreeTy (CoercionTy KindCoercion
_)    = Bool
False  -- Not sure about this

-- | Does this type classify a core (unlifted) Coercion?
-- At either role nominal or representational
--    (t1 ~# t2) or (t1 ~R# t2)
-- See Note [Types for coercions, predicates, and evidence] in "GHC.Core.TyCo.Rep"
isCoVarType :: Type -> Bool
  -- ToDo: should we check saturation?
isCoVarType :: Type -> Bool
isCoVarType Type
ty
  | Just TyCon
tc <- Type -> Maybe TyCon
tyConAppTyCon_maybe Type
ty
  = TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqPrimTyConKey Bool -> Bool -> Bool
|| TyCon
tc forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
eqReprPrimTyConKey
  | Bool
otherwise
  = Bool
False

buildSynTyCon :: Name -> [KnotTied TyConBinder] -> Kind   -- ^ /result/ kind
              -> [Role] -> KnotTied Type -> TyCon
-- This function is here because here is where we have
--   isFamFree and isTauTy
buildSynTyCon :: Name -> [TyConBinder] -> Type -> [Role] -> Type -> TyCon
buildSynTyCon Name
name [TyConBinder]
binders Type
res_kind [Role]
roles Type
rhs
  = Name
-> [TyConBinder]
-> Type
-> [Role]
-> Type
-> Bool
-> Bool
-> Bool
-> TyCon
mkSynonymTyCon Name
name [TyConBinder]
binders Type
res_kind [Role]
roles Type
rhs Bool
is_tau Bool
is_fam_free Bool
is_forgetful
  where
    is_tau :: Bool
is_tau       = Type -> Bool
isTauTy Type
rhs
    is_fam_free :: Bool
is_fam_free  = Type -> Bool
isFamFreeTy Type