-- | Compute the 'Type' of an @'HsExpr' 'GhcTc'@ in a pure fashion.
--
-- Note that this does /not/ currently support the use case of annotating
-- every subexpression in an 'HsExpr' with its 'Type'. For more information on
-- this task, see #12706, #15320, #16804, and #17331.
module GHC.Hs.Syn.Type (
    -- * Extracting types from HsExpr
    lhsExprType, hsExprType, hsWrapperType,
    -- * Extracting types from HsSyn
    hsLitType, hsPatType, hsLPatType

  ) where

import GHC.Prelude

import GHC.Builtin.Types
import GHC.Builtin.Types.Prim
import GHC.Core.Coercion
import GHC.Core.ConLike
import GHC.Core.DataCon
import GHC.Core.PatSyn
import GHC.Core.TyCo.Rep
import GHC.Core.Type
import GHC.Core.Utils
import GHC.Hs
import GHC.Tc.Types.Evidence
import GHC.Types.Id
import GHC.Types.SrcLoc
import GHC.Utils.Outputable
import GHC.Utils.Panic

{-
************************************************************************
*                                                                      *
       Extracting the type from HsSyn
*                                                                      *
************************************************************************

-}

hsLPatType :: LPat GhcTc -> Type
hsLPatType :: LPat GhcTc -> Type
hsLPatType (L SrcSpanAnnA
_ Pat GhcTc
p) = Pat GhcTc -> Type
hsPatType Pat GhcTc
p

hsPatType :: Pat GhcTc -> Type
hsPatType :: Pat GhcTc -> Type
hsPatType (ParPat XParPat GhcTc
_ LHsToken "(" GhcTc
_ LPat GhcTc
pat LHsToken ")" GhcTc
_)            = LPat GhcTc -> Type
hsLPatType LPat GhcTc
pat
hsPatType (WildPat XWildPat GhcTc
ty)                  = XWildPat GhcTc
Type
ty
hsPatType (VarPat XVarPat GhcTc
_ LIdP GhcTc
lvar)               = Id -> Type
idType (GenLocated SrcSpanAnnN Id -> Id
forall l e. GenLocated l e -> e
unLoc LIdP GhcTc
GenLocated SrcSpanAnnN Id
lvar)
hsPatType (BangPat XBangPat GhcTc
_ LPat GhcTc
pat)               = LPat GhcTc -> Type
hsLPatType LPat GhcTc
pat
hsPatType (LazyPat XLazyPat GhcTc
_ LPat GhcTc
pat)               = LPat GhcTc -> Type
hsLPatType LPat GhcTc
pat
hsPatType (LitPat XLitPat GhcTc
_ HsLit GhcTc
lit)                = HsLit GhcTc -> Type
forall (p :: Pass). HsLit (GhcPass p) -> Type
hsLitType HsLit GhcTc
lit
hsPatType (AsPat XAsPat GhcTc
_ LIdP GhcTc
var LPat GhcTc
_)               = Id -> Type
idType (GenLocated SrcSpanAnnN Id -> Id
forall l e. GenLocated l e -> e
unLoc LIdP GhcTc
GenLocated SrcSpanAnnN Id
var)
hsPatType (ViewPat XViewPat GhcTc
ty LHsExpr GhcTc
_ LPat GhcTc
_)              = XViewPat GhcTc
Type
ty
hsPatType (ListPat XListPat GhcTc
ty [LPat GhcTc]
_)                = Type -> Type
mkListTy XListPat GhcTc
Type
ty
hsPatType (TuplePat XTuplePat GhcTc
tys [LPat GhcTc]
_ Boxity
bx)           = Boxity -> [Type] -> Type
mkTupleTy1 Boxity
bx [Type]
XTuplePat GhcTc
tys
                  -- See Note [Don't flatten tuples from HsSyn] in GHC.Core.Make
hsPatType (SumPat XSumPat GhcTc
tys LPat GhcTc
_ ConTag
_ ConTag
_ )           = [Type] -> Type
mkSumTy [Type]
XSumPat GhcTc
tys
hsPatType (ConPat { pat_con :: forall p. Pat p -> XRec p (ConLikeP p)
pat_con = XRec GhcTc (ConLikeP GhcTc)
lcon
                  , pat_con_ext :: forall p. Pat p -> XConPat p
pat_con_ext = ConPatTc
                    { cpt_arg_tys :: ConPatTc -> [Type]
cpt_arg_tys = [Type]
tys
                    }
                  })
                                        = ConLike -> [Type] -> Type
conLikeResTy (GenLocated SrcSpanAnnN ConLike -> ConLike
forall l e. GenLocated l e -> e
unLoc XRec GhcTc (ConLikeP GhcTc)
GenLocated SrcSpanAnnN ConLike
lcon) [Type]
tys
hsPatType (SigPat XSigPat GhcTc
ty LPat GhcTc
_ HsPatSigType (NoGhcTc GhcTc)
_)               = XSigPat GhcTc
Type
ty
hsPatType (NPat XNPat GhcTc
ty XRec GhcTc (HsOverLit GhcTc)
_ Maybe (SyntaxExpr GhcTc)
_ SyntaxExpr GhcTc
_)               = XNPat GhcTc
Type
ty
hsPatType (NPlusKPat XNPlusKPat GhcTc
ty LIdP GhcTc
_ XRec GhcTc (HsOverLit GhcTc)
_ HsOverLit GhcTc
_ SyntaxExpr GhcTc
_ SyntaxExpr GhcTc
_)      = XNPlusKPat GhcTc
Type
ty
hsPatType (XPat XXPat GhcTc
ext) =
  case XXPat GhcTc
ext of
    CoPat HsWrapper
_ Pat GhcTc
_ Type
ty       -> Type
ty
    ExpansionPat Pat GhcRn
_ Pat GhcTc
pat -> Pat GhcTc -> Type
hsPatType Pat GhcTc
pat
hsPatType (SplicePat XSplicePat GhcTc
v HsSplice GhcTc
_)               = DataConCantHappen -> Type
forall a. DataConCantHappen -> a
dataConCantHappen XSplicePat GhcTc
DataConCantHappen
v

hsLitType :: HsLit (GhcPass p) -> Type
hsLitType :: forall (p :: Pass). HsLit (GhcPass p) -> Type
hsLitType (HsChar XHsChar (GhcPass p)
_ Char
_)       = Type
charTy
hsLitType (HsCharPrim XHsCharPrim (GhcPass p)
_ Char
_)   = Type
charPrimTy
hsLitType (HsString XHsString (GhcPass p)
_ FastString
_)     = Type
stringTy
hsLitType (HsStringPrim XHsStringPrim (GhcPass p)
_ ByteString
_) = Type
addrPrimTy
hsLitType (HsInt XHsInt (GhcPass p)
_ IntegralLit
_)        = Type
intTy
hsLitType (HsIntPrim XHsIntPrim (GhcPass p)
_ Integer
_)    = Type
intPrimTy
hsLitType (HsWordPrim XHsWordPrim (GhcPass p)
_ Integer
_)   = Type
wordPrimTy
hsLitType (HsInt64Prim XHsInt64Prim (GhcPass p)
_ Integer
_)  = Type
int64PrimTy
hsLitType (HsWord64Prim XHsWord64Prim (GhcPass p)
_ Integer
_) = Type
word64PrimTy
hsLitType (HsInteger XHsInteger (GhcPass p)
_ Integer
_ Type
ty) = Type
ty
hsLitType (HsRat XHsRat (GhcPass p)
_ FractionalLit
_ Type
ty)     = Type
ty
hsLitType (HsFloatPrim XHsFloatPrim (GhcPass p)
_ FractionalLit
_)  = Type
floatPrimTy
hsLitType (HsDoublePrim XHsDoublePrim (GhcPass p)
_ FractionalLit
_) = Type
doublePrimTy


-- | Compute the 'Type' of an @'LHsExpr' 'GhcTc'@ in a pure fashion.
lhsExprType :: LHsExpr GhcTc -> Type
lhsExprType :: LHsExpr GhcTc -> Type
lhsExprType (L SrcSpanAnnA
_ HsExpr GhcTc
e) = HsExpr GhcTc -> Type
hsExprType HsExpr GhcTc
e

-- | Compute the 'Type' of an @'HsExpr' 'GhcTc'@ in a pure fashion.
hsExprType :: HsExpr GhcTc -> Type
hsExprType :: HsExpr GhcTc -> Type
hsExprType (HsVar XVar GhcTc
_ (L SrcSpanAnnN
_ Id
id)) = Id -> Type
idType Id
id
hsExprType (HsUnboundVar (HER IORef EvTerm
_ Type
ty Unique
_) OccName
_) = Type
ty
hsExprType (HsRecSel XRecSel GhcTc
_ (FieldOcc XCFieldOcc GhcTc
id XRec GhcTc RdrName
_)) = Id -> Type
idType XCFieldOcc GhcTc
Id
id
hsExprType (HsOverLabel XOverLabel GhcTc
v FastString
_) = DataConCantHappen -> Type
forall a. DataConCantHappen -> a
dataConCantHappen XOverLabel GhcTc
DataConCantHappen
v
hsExprType (HsIPVar XIPVar GhcTc
v HsIPName
_) = DataConCantHappen -> Type
forall a. DataConCantHappen -> a
dataConCantHappen XIPVar GhcTc
DataConCantHappen
v
hsExprType (HsOverLit XOverLitE GhcTc
_ HsOverLit GhcTc
lit) = HsOverLit GhcTc -> Type
overLitType HsOverLit GhcTc
lit
hsExprType (HsLit XLitE GhcTc
_ HsLit GhcTc
lit) = HsLit GhcTc -> Type
forall (p :: Pass). HsLit (GhcPass p) -> Type
hsLitType HsLit GhcTc
lit
hsExprType (HsLam     XLam GhcTc
_ (MG { mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = XMG GhcTc (LHsExpr GhcTc)
match_group })) = MatchGroupTc -> Type
matchGroupTcType XMG GhcTc (LHsExpr GhcTc)
MatchGroupTc
match_group
hsExprType (HsLamCase XLamCase GhcTc
_ LamCaseVariant
_ (MG { mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = XMG GhcTc (LHsExpr GhcTc)
match_group })) = MatchGroupTc -> Type
matchGroupTcType XMG GhcTc (LHsExpr GhcTc)
MatchGroupTc
match_group
hsExprType (HsApp XApp GhcTc
_ LHsExpr GhcTc
f LHsExpr GhcTc
_) = Type -> Type
funResultTy (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
f
hsExprType (HsAppType XAppTypeE GhcTc
x LHsExpr GhcTc
f LHsWcType (NoGhcTc GhcTc)
_) = (() :: Constraint) => Type -> Type -> Type
Type -> Type -> Type
piResultTy (LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
f) XAppTypeE GhcTc
Type
x
hsExprType (OpApp XOpApp GhcTc
v LHsExpr GhcTc
_ LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen -> Type
forall a. DataConCantHappen -> a
dataConCantHappen XOpApp GhcTc
DataConCantHappen
v
hsExprType (NegApp XNegApp GhcTc
_ LHsExpr GhcTc
_ SyntaxExpr GhcTc
se) = SyntaxExpr GhcTc -> Type
syntaxExprType SyntaxExpr GhcTc
se
hsExprType (HsPar XPar GhcTc
_ LHsToken "(" GhcTc
_ LHsExpr GhcTc
e LHsToken ")" GhcTc
_) = LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
e
hsExprType (SectionL XSectionL GhcTc
v LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen -> Type
forall a. DataConCantHappen -> a
dataConCantHappen XSectionL GhcTc
DataConCantHappen
v
hsExprType (SectionR XSectionR GhcTc
v LHsExpr GhcTc
_ LHsExpr GhcTc
_) = DataConCantHappen -> Type
forall a. DataConCantHappen -> a
dataConCantHappen XSectionR GhcTc
DataConCantHappen
v
hsExprType (ExplicitTuple XExplicitTuple GhcTc
_ [HsTupArg GhcTc]
args Boxity
box) = Boxity -> [Type] -> Type
mkTupleTy Boxity
box ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ (HsTupArg GhcTc -> Type) -> [HsTupArg GhcTc] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map HsTupArg GhcTc -> Type
hsTupArgType [HsTupArg GhcTc]
args
hsExprType (ExplicitSum XExplicitSum GhcTc
alt_tys ConTag
_ ConTag
_ LHsExpr GhcTc
_) = [Type] -> Type
mkSumTy [Type]
XExplicitSum GhcTc
alt_tys
hsExprType (HsCase XCase GhcTc
_ LHsExpr GhcTc
_ (MG { mg_ext :: forall p body. MatchGroup p body -> XMG p body
mg_ext = XMG GhcTc (LHsExpr GhcTc)
match_group })) = MatchGroupTc -> Type
mg_res_ty XMG GhcTc (LHsExpr GhcTc)
MatchGroupTc
match_group
hsExprType (HsIf XIf GhcTc
_ LHsExpr GhcTc
_ LHsExpr GhcTc
t LHsExpr GhcTc
_) = LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
t
hsExprType (HsMultiIf XMultiIf GhcTc
ty [LGRHS GhcTc (LHsExpr GhcTc)]
_) = XMultiIf GhcTc
Type
ty
hsExprType (HsLet XLet GhcTc
_ LHsToken "let" GhcTc
_ HsLocalBinds GhcTc
_ LHsToken "in" GhcTc
_ LHsExpr GhcTc
body) = LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
body
hsExprType (HsDo XDo GhcTc
ty HsDoFlavour
_ XRec GhcTc [ExprLStmt GhcTc]
_) = XDo GhcTc
Type
ty
hsExprType (ExplicitList XExplicitList GhcTc
ty [LHsExpr GhcTc]
_) = Type -> Type
mkListTy XExplicitList GhcTc
Type
ty
hsExprType (RecordCon XRecordCon GhcTc
con_expr XRec GhcTc (ConLikeP GhcTc)
_ HsRecordBinds GhcTc
_) = HsExpr GhcTc -> Type
hsExprType XRecordCon GhcTc
HsExpr GhcTc
con_expr
hsExprType e :: HsExpr GhcTc
e@(RecordUpd (RecordUpdTc { rupd_cons :: RecordUpdTc -> [ConLike]
rupd_cons = [ConLike]
cons, rupd_out_tys :: RecordUpdTc -> [Type]
rupd_out_tys = [Type]
out_tys }) LHsExpr GhcTc
_ Either [LHsRecUpdField GhcTc] [LHsRecUpdProj GhcTc]
_) =
  case [ConLike]
cons of
    ConLike
con_like:[ConLike]
_ -> ConLike -> [Type] -> Type
conLikeResTy ConLike
con_like [Type]
out_tys
    []         -> String -> SDoc -> Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"hsExprType: RecordUpdTc with empty rupd_cons"
                           (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
e)
hsExprType (HsGetField { gf_ext :: forall p. HsExpr p -> XGetField p
gf_ext = XGetField GhcTc
v }) = DataConCantHappen -> Type
forall a. DataConCantHappen -> a
dataConCantHappen XGetField GhcTc
DataConCantHappen
v
hsExprType (HsProjection { proj_ext :: forall p. HsExpr p -> XProjection p
proj_ext = XProjection GhcTc
v }) = DataConCantHappen -> Type
forall a. DataConCantHappen -> a
dataConCantHappen XProjection GhcTc
DataConCantHappen
v
hsExprType (ExprWithTySig XExprWithTySig GhcTc
_ LHsExpr GhcTc
e LHsSigWcType (NoGhcTc GhcTc)
_) = LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
e
hsExprType (ArithSeq XArithSeq GhcTc
_ Maybe (SyntaxExpr GhcTc)
mb_overloaded_op ArithSeqInfo GhcTc
asi) = case Maybe (SyntaxExpr GhcTc)
mb_overloaded_op of
  Just SyntaxExpr GhcTc
op -> (() :: Constraint) => Type -> Type -> Type
Type -> Type -> Type
piResultTy (SyntaxExpr GhcTc -> Type
syntaxExprType SyntaxExpr GhcTc
op) Type
asi_ty
  Maybe (SyntaxExpr GhcTc)
Nothing -> Type
asi_ty
  where
    asi_ty :: Type
asi_ty = ArithSeqInfo GhcTc -> Type
arithSeqInfoType ArithSeqInfo GhcTc
asi
hsExprType (HsTypedBracket   (HsBracketTc HsQuote GhcRn
_ Type
ty Maybe QuoteWrapper
_wrap [PendingTcSplice]
_pending) LHsExpr GhcTc
_) = Type
ty
hsExprType (HsUntypedBracket (HsBracketTc HsQuote GhcRn
_ Type
ty Maybe QuoteWrapper
_wrap [PendingTcSplice]
_pending) HsQuote GhcTc
_) = Type
ty
hsExprType e :: HsExpr GhcTc
e@(HsSpliceE{}) = String -> SDoc -> Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"hsExprType: Unexpected HsSpliceE"
                                      (HsExpr GhcTc -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsExpr GhcTc
e)
                                      -- Typed splices should have been eliminated during zonking, but we
                                      -- can't use `dataConCantHappen` since they are still present before
                                      -- than in the typechecked AST.
hsExprType (HsProc XProc GhcTc
_ LPat GhcTc
_ LHsCmdTop GhcTc
lcmd_top) = LHsCmdTop GhcTc -> Type
lhsCmdTopType LHsCmdTop GhcTc
lcmd_top
hsExprType (HsStatic (NameSet
_, Type
ty) LHsExpr GhcTc
_s) = Type
ty
hsExprType (HsPragE XPragE GhcTc
_ HsPragE GhcTc
_ LHsExpr GhcTc
e) = LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
e
hsExprType (XExpr (WrapExpr (HsWrap HsWrapper
wrap HsExpr GhcTc
e))) = HsWrapper -> Type -> Type
hsWrapperType HsWrapper
wrap (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ HsExpr GhcTc -> Type
hsExprType HsExpr GhcTc
e
hsExprType (XExpr (ExpansionExpr (HsExpanded HsExpr GhcRn
_ HsExpr GhcTc
tc_e))) = HsExpr GhcTc -> Type
hsExprType HsExpr GhcTc
tc_e
hsExprType (XExpr (ConLikeTc ConLike
con [Id]
_ [Scaled Type]
_)) = ConLike -> Type
conLikeType ConLike
con
hsExprType (XExpr (HsTick CoreTickish
_ LHsExpr GhcTc
e)) = LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
e
hsExprType (XExpr (HsBinTick ConTag
_ ConTag
_ LHsExpr GhcTc
e)) = LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
e

arithSeqInfoType :: ArithSeqInfo GhcTc -> Type
arithSeqInfoType :: ArithSeqInfo GhcTc -> Type
arithSeqInfoType ArithSeqInfo GhcTc
asi = Type -> Type
mkListTy (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ case ArithSeqInfo GhcTc
asi of
  From LHsExpr GhcTc
x           -> LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
x
  FromThen LHsExpr GhcTc
x LHsExpr GhcTc
_     -> LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
x
  FromTo LHsExpr GhcTc
x LHsExpr GhcTc
_       -> LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
x
  FromThenTo LHsExpr GhcTc
x LHsExpr GhcTc
_ LHsExpr GhcTc
_ -> LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
x

conLikeType :: ConLike -> Type
conLikeType :: ConLike -> Type
conLikeType (RealDataCon DataCon
con)  = DataCon -> Type
dataConNonlinearType DataCon
con
conLikeType (PatSynCon PatSyn
patsyn) = case PatSyn -> PatSynBuilder
patSynBuilder PatSyn
patsyn of
    Just (Name
_, Type
ty, Bool
_) -> Type
ty
    PatSynBuilder
Nothing         -> String -> SDoc -> Type
forall a. HasCallStack => String -> SDoc -> a
pprPanic String
"conLikeType: Unidirectional pattern synonym in expression position"
                                (PatSyn -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatSyn
patsyn)

hsTupArgType :: HsTupArg GhcTc -> Type
hsTupArgType :: HsTupArg GhcTc -> Type
hsTupArgType (Present XPresent GhcTc
_ LHsExpr GhcTc
e)           = LHsExpr GhcTc -> Type
lhsExprType LHsExpr GhcTc
e
hsTupArgType (Missing (Scaled Type
_ Type
ty)) = Type
ty


-- | The PRType (ty, tas) is short for (piResultTys ty (reverse tas))
type PRType = (Type, [Type])

prTypeType :: PRType -> Type
prTypeType :: PRType -> Type
prTypeType (Type
ty, [Type]
tys)
  | [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
tys  = Type
ty
  | Bool
otherwise = (() :: Constraint) => Type -> [Type] -> Type
Type -> [Type] -> Type
piResultTys Type
ty ([Type] -> [Type]
forall a. [a] -> [a]
reverse [Type]
tys)

liftPRType :: (Type -> Type) -> PRType -> PRType
liftPRType :: (Type -> Type) -> PRType -> PRType
liftPRType Type -> Type
f PRType
pty = (Type -> Type
f (PRType -> Type
prTypeType PRType
pty), [])

hsWrapperType :: HsWrapper -> Type -> Type
hsWrapperType :: HsWrapper -> Type -> Type
hsWrapperType HsWrapper
wrap Type
ty = PRType -> Type
prTypeType (PRType -> Type) -> PRType -> Type
forall a b. (a -> b) -> a -> b
$ HsWrapper -> PRType -> PRType
go HsWrapper
wrap (Type
ty,[])
  where
    go :: HsWrapper -> PRType -> PRType
go HsWrapper
WpHole              = PRType -> PRType
forall a. a -> a
id
    go (HsWrapper
w1 `WpCompose` HsWrapper
w2) = HsWrapper -> PRType -> PRType
go HsWrapper
w1 (PRType -> PRType) -> (PRType -> PRType) -> PRType -> PRType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsWrapper -> PRType -> PRType
go HsWrapper
w2
    go (WpFun HsWrapper
_ HsWrapper
w2 (Scaled Type
m Type
exp_arg)) = (Type -> Type) -> PRType -> PRType
liftPRType ((Type -> Type) -> PRType -> PRType)
-> (Type -> Type) -> PRType -> PRType
forall a b. (a -> b) -> a -> b
$ \Type
t ->
      let act_res :: Type
act_res = Type -> Type
funResultTy Type
t
          exp_res :: Type
exp_res = HsWrapper -> Type -> Type
hsWrapperType HsWrapper
w2 Type
act_res
      in Type -> Type -> Type -> Type
mkFunctionType Type
m Type
exp_arg Type
exp_res
    go (WpCast TcCoercionR
co)        = (Type -> Type) -> PRType -> PRType
liftPRType ((Type -> Type) -> PRType -> PRType)
-> (Type -> Type) -> PRType -> PRType
forall a b. (a -> b) -> a -> b
$ \Type
_ -> TcCoercionR -> Type
coercionRKind TcCoercionR
co
    go (WpEvLam Id
v)        = (Type -> Type) -> PRType -> PRType
liftPRType ((Type -> Type) -> PRType -> PRType)
-> (Type -> Type) -> PRType -> PRType
forall a b. (a -> b) -> a -> b
$ Type -> Type -> Type
mkInvisFunTyMany (Id -> Type
idType Id
v)
    go (WpEvApp EvTerm
_)        = (Type -> Type) -> PRType -> PRType
liftPRType ((Type -> Type) -> PRType -> PRType)
-> (Type -> Type) -> PRType -> PRType
forall a b. (a -> b) -> a -> b
$ Type -> Type
funResultTy
    go (WpTyLam Id
tv)       = (Type -> Type) -> PRType -> PRType
liftPRType ((Type -> Type) -> PRType -> PRType)
-> (Type -> Type) -> PRType -> PRType
forall a b. (a -> b) -> a -> b
$ Id -> ArgFlag -> Type -> Type
mkForAllTy Id
tv ArgFlag
Inferred
    go (WpTyApp Type
ta)       = \(Type
ty,[Type]
tas) -> (Type
ty, Type
taType -> [Type] -> [Type]
forall a. a -> [a] -> [a]
:[Type]
tas)
    go (WpLet TcEvBinds
_)          = PRType -> PRType
forall a. a -> a
id
    go (WpMultCoercion TcCoercionR
_) = PRType -> PRType
forall a. a -> a
id

lhsCmdTopType :: LHsCmdTop GhcTc -> Type
lhsCmdTopType :: LHsCmdTop GhcTc -> Type
lhsCmdTopType (L SrcAnn NoEpAnns
_ (HsCmdTop (CmdTopTc Type
_ Type
ret_ty CmdSyntaxTable GhcTc
_) LHsCmd GhcTc
_)) = Type
ret_ty

matchGroupTcType :: MatchGroupTc -> Type
matchGroupTcType :: MatchGroupTc -> Type
matchGroupTcType (MatchGroupTc [Scaled Type]
args Type
res) = [Scaled Type] -> Type -> Type
mkVisFunTys [Scaled Type]
args Type
res

syntaxExprType :: SyntaxExpr GhcTc -> Type
syntaxExprType :: SyntaxExpr GhcTc -> Type
syntaxExprType (SyntaxExprTc HsExpr GhcTc
e [HsWrapper]
_ HsWrapper
_) = HsExpr GhcTc -> Type
hsExprType HsExpr GhcTc
e
syntaxExprType SyntaxExpr GhcTc
SyntaxExprTc
NoSyntaxExprTc       = String -> Type
forall a. String -> a
panic String
"syntaxExprType: Unexpected NoSyntaxExprTc"