{-# LANGUAGE CPP #-}

-- | Functions for converting Core things to interface file things.
module ToIface
    ( -- * Binders
      toIfaceTvBndr
    , toIfaceTvBndrs
    , toIfaceIdBndr
    , toIfaceBndr
    , toIfaceForAllBndr
    , toIfaceTyCoVarBinders
    , toIfaceTyVar
      -- * Types
    , toIfaceType, toIfaceTypeX
    , toIfaceKind
    , toIfaceTcArgs
    , toIfaceTyCon
    , toIfaceTyCon_name
    , toIfaceTyLit
      -- * Tidying types
    , tidyToIfaceType
    , tidyToIfaceContext
    , tidyToIfaceTcArgs
      -- * Coercions
    , toIfaceCoercion, toIfaceCoercionX
      -- * Pattern synonyms
    , patSynToIfaceDecl
      -- * Expressions
    , toIfaceExpr
    , toIfaceBang
    , toIfaceSrcBang
    , toIfaceLetBndr
    , toIfaceIdDetails
    , toIfaceIdInfo
    , toIfUnfolding
    , toIfaceOneShot
    , toIfaceTickish
    , toIfaceBind
    , toIfaceAlt
    , toIfaceCon
    , toIfaceApp
    , toIfaceVar
    ) where

#include "HsVersions.h"

import GhcPrelude

import IfaceSyn
import DataCon
import Id
import IdInfo
import CoreSyn
import TyCon hiding ( pprPromotionQuote )
import CoAxiom
import TysPrim ( eqPrimTyCon, eqReprPrimTyCon )
import TysWiredIn ( heqTyCon )
import MkId ( noinlineIdName )
import PrelNames
import Name
import BasicTypes
import Type
import PatSyn
import Outputable
import FastString
import Util
import Var
import VarEnv
import VarSet
import TyCoRep
import Demand ( isTopSig )

import Data.Maybe ( catMaybes )

----------------
toIfaceTvBndr :: TyVar -> IfaceTvBndr
toIfaceTvBndr :: TyVar -> IfaceTvBndr
toIfaceTvBndr = VarSet -> TyVar -> IfaceTvBndr
toIfaceTvBndrX VarSet
emptyVarSet

toIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr
toIfaceTvBndrX :: VarSet -> TyVar -> IfaceTvBndr
toIfaceTvBndrX fr :: VarSet
fr tyvar :: TyVar
tyvar = ( OccName -> FastString
occNameFS (TyVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyVar
tyvar)
                          , VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr (TyVar -> Type
tyVarKind TyVar
tyvar)
                          )

toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]
toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]
toIfaceTvBndrs = (TyVar -> IfaceTvBndr) -> [TyVar] -> [IfaceTvBndr]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> IfaceTvBndr
toIfaceTvBndr

toIfaceIdBndr :: Id -> IfaceIdBndr
toIfaceIdBndr :: TyVar -> IfaceTvBndr
toIfaceIdBndr = VarSet -> TyVar -> IfaceTvBndr
toIfaceIdBndrX VarSet
emptyVarSet

toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr
toIfaceIdBndrX :: VarSet -> TyVar -> IfaceTvBndr
toIfaceIdBndrX fr :: VarSet
fr covar :: TyVar
covar = ( OccName -> FastString
occNameFS (TyVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyVar
covar)
                          , VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr (TyVar -> Type
varType TyVar
covar)
                          )

toIfaceBndr :: Var -> IfaceBndr
toIfaceBndr :: TyVar -> IfaceBndr
toIfaceBndr var :: TyVar
var
  | TyVar -> Bool
isId TyVar
var  = IfaceTvBndr -> IfaceBndr
IfaceIdBndr (TyVar -> IfaceTvBndr
toIfaceIdBndr TyVar
var)
  | Bool
otherwise = IfaceTvBndr -> IfaceBndr
IfaceTvBndr (TyVar -> IfaceTvBndr
toIfaceTvBndr TyVar
var)

toIfaceBndrX :: VarSet -> Var -> IfaceBndr
toIfaceBndrX :: VarSet -> TyVar -> IfaceBndr
toIfaceBndrX fr :: VarSet
fr var :: TyVar
var
  | TyVar -> Bool
isId TyVar
var  = IfaceTvBndr -> IfaceBndr
IfaceIdBndr (VarSet -> TyVar -> IfaceTvBndr
toIfaceIdBndrX VarSet
fr TyVar
var)
  | Bool
otherwise = IfaceTvBndr -> IfaceBndr
IfaceTvBndr (VarSet -> TyVar -> IfaceTvBndr
toIfaceTvBndrX VarSet
fr TyVar
var)

toIfaceTyCoVarBinder :: VarBndr Var vis -> VarBndr IfaceBndr vis
toIfaceTyCoVarBinder :: VarBndr TyVar vis -> VarBndr IfaceBndr vis
toIfaceTyCoVarBinder (Bndr tv :: TyVar
tv vis :: vis
vis) = IfaceBndr -> vis -> VarBndr IfaceBndr vis
forall var argf. var -> argf -> VarBndr var argf
Bndr (TyVar -> IfaceBndr
toIfaceBndr TyVar
tv) vis
vis

toIfaceTyCoVarBinders :: [VarBndr Var vis] -> [VarBndr IfaceBndr vis]
toIfaceTyCoVarBinders :: [VarBndr TyVar vis] -> [VarBndr IfaceBndr vis]
toIfaceTyCoVarBinders = (VarBndr TyVar vis -> VarBndr IfaceBndr vis)
-> [VarBndr TyVar vis] -> [VarBndr IfaceBndr vis]
forall a b. (a -> b) -> [a] -> [b]
map VarBndr TyVar vis -> VarBndr IfaceBndr vis
forall vis. VarBndr TyVar vis -> VarBndr IfaceBndr vis
toIfaceTyCoVarBinder

{-
************************************************************************
*                                                                      *
        Conversion from Type to IfaceType
*                                                                      *
************************************************************************
-}

toIfaceKind :: Type -> IfaceType
toIfaceKind :: Type -> IfaceType
toIfaceKind = Type -> IfaceType
toIfaceType

---------------------
toIfaceType :: Type -> IfaceType
toIfaceType :: Type -> IfaceType
toIfaceType = VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
emptyVarSet

toIfaceTypeX :: VarSet -> Type -> IfaceType
-- (toIfaceTypeX free ty)
--    translates the tyvars in 'free' as IfaceFreeTyVars
--
-- Synonyms are retained in the interface type
toIfaceTypeX :: VarSet -> Type -> IfaceType
toIfaceTypeX fr :: VarSet
fr (TyVarTy tv :: TyVar
tv)   -- See Note [TcTyVars in IfaceType] in IfaceType
  | TyVar
tv TyVar -> VarSet -> Bool
`elemVarSet` VarSet
fr         = TyVar -> IfaceType
IfaceFreeTyVar TyVar
tv
  | Bool
otherwise                  = FastString -> IfaceType
IfaceTyVar (TyVar -> FastString
toIfaceTyVar TyVar
tv)
toIfaceTypeX fr :: VarSet
fr ty :: Type
ty@(AppTy {})  =
  -- Flatten as many argument AppTys as possible, then turn them into an
  -- IfaceAppArgs list.
  -- See Note [Suppressing invisible arguments] in IfaceType.
  let (head :: Type
head, args :: [Type]
args) = Type -> (Type, [Type])
splitAppTys Type
ty
  in IfaceType -> IfaceAppArgs -> IfaceType
IfaceAppTy (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
head) (VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppTyArgsX VarSet
fr Type
head [Type]
args)
toIfaceTypeX _  (LitTy n :: TyLit
n)      = IfaceTyLit -> IfaceType
IfaceLitTy (TyLit -> IfaceTyLit
toIfaceTyLit TyLit
n)
toIfaceTypeX fr :: VarSet
fr (ForAllTy b :: TyCoVarBinder
b t :: Type
t) = IfaceForAllBndr -> IfaceType -> IfaceType
IfaceForAllTy (VarSet -> TyCoVarBinder -> IfaceForAllBndr
toIfaceForAllBndrX VarSet
fr TyCoVarBinder
b)
                                               (VarSet -> Type -> IfaceType
toIfaceTypeX (VarSet
fr VarSet -> TyVar -> VarSet
`delVarSet` TyCoVarBinder -> TyVar
forall tv argf. VarBndr tv argf -> tv
binderVar TyCoVarBinder
b) Type
t)
toIfaceTypeX fr :: VarSet
fr (FunTy t1 :: Type
t1 t2 :: Type
t2)
  | Type -> Bool
isPredTy Type
t1                 = IfaceType -> IfaceType -> IfaceType
IfaceDFunTy (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t1) (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t2)
  | Bool
otherwise                   = IfaceType -> IfaceType -> IfaceType
IfaceFunTy  (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t1) (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t2)
toIfaceTypeX fr :: VarSet
fr (CastTy ty :: Type
ty co :: KindCoercion
co)  = IfaceType -> IfaceCoercion -> IfaceType
IfaceCastTy (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
ty) (VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr KindCoercion
co)
toIfaceTypeX fr :: VarSet
fr (CoercionTy co :: KindCoercion
co) = IfaceCoercion -> IfaceType
IfaceCoercionTy (VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr KindCoercion
co)

toIfaceTypeX fr :: VarSet
fr (TyConApp tc :: TyCon
tc tys :: [Type]
tys)
    -- tuples
  | Just sort :: TupleSort
sort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc
  , Int
n_tys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arity
  = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
sort PromotionFlag
NotPromoted (VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Type]
tys)

  | Just dc :: DataCon
dc <- TyCon -> Maybe DataCon
isPromotedDataCon_maybe TyCon
tc
  , DataCon -> Bool
isTupleDataCon DataCon
dc
  , Int
n_tys Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
arity
  = TupleSort -> PromotionFlag -> IfaceAppArgs -> IfaceType
IfaceTupleTy TupleSort
BoxedTuple PromotionFlag
IsPromoted (VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc (Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
drop Int
arity [Type]
tys))

  | TyCon
tc TyCon -> [TyCon] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ TyCon
eqPrimTyCon, TyCon
eqReprPrimTyCon, TyCon
heqTyCon ]
  , (k1 :: Type
k1:k2 :: Type
k2:_) <- [Type]
tys
  = let info :: IfaceTyConInfo
info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
sort
        sort :: IfaceTyConSort
sort | Type
k1 Type -> Type -> Bool
`eqType` Type
k2 = IfaceTyConSort
IfaceEqualityTyCon
             | Bool
otherwise      = IfaceTyConSort
IfaceNormalTyCon
    in IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon (TyCon -> IfExtName
tyConName TyCon
tc) IfaceTyConInfo
info) (VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Type]
tys)

    -- other applications
  | Bool
otherwise
  = IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc) (VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
fr TyCon
tc [Type]
tys)
  where
    arity :: Int
arity = TyCon -> Int
tyConArity TyCon
tc
    n_tys :: Int
n_tys = [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
tys

toIfaceTyVar :: TyVar -> FastString
toIfaceTyVar :: TyVar -> FastString
toIfaceTyVar = OccName -> FastString
occNameFS (OccName -> FastString)
-> (TyVar -> OccName) -> TyVar -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName

toIfaceCoVar :: CoVar -> FastString
toIfaceCoVar :: TyVar -> FastString
toIfaceCoVar = OccName -> FastString
occNameFS (OccName -> FastString)
-> (TyVar -> OccName) -> TyVar -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName

toIfaceForAllBndr :: TyCoVarBinder -> IfaceForAllBndr
toIfaceForAllBndr :: TyCoVarBinder -> IfaceForAllBndr
toIfaceForAllBndr = VarSet -> TyCoVarBinder -> IfaceForAllBndr
toIfaceForAllBndrX VarSet
emptyVarSet

toIfaceForAllBndrX :: VarSet -> TyCoVarBinder -> IfaceForAllBndr
toIfaceForAllBndrX :: VarSet -> TyCoVarBinder -> IfaceForAllBndr
toIfaceForAllBndrX fr :: VarSet
fr (Bndr v :: TyVar
v vis :: ArgFlag
vis) = IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (VarSet -> TyVar -> IfaceBndr
toIfaceBndrX VarSet
fr TyVar
v) ArgFlag
vis

----------------
toIfaceTyCon :: TyCon -> IfaceTyCon
toIfaceTyCon :: TyCon -> IfaceTyCon
toIfaceTyCon tc :: TyCon
tc
  = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
tc_name IfaceTyConInfo
info
  where
    tc_name :: IfExtName
tc_name = TyCon -> IfExtName
tyConName TyCon
tc
    info :: IfaceTyConInfo
info    = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
promoted IfaceTyConSort
sort
    promoted :: PromotionFlag
promoted | TyCon -> Bool
isPromotedDataCon TyCon
tc = PromotionFlag
IsPromoted
             | Bool
otherwise            = PromotionFlag
NotPromoted

    tupleSort :: TyCon -> Maybe IfaceTyConSort
    tupleSort :: TyCon -> Maybe IfaceTyConSort
tupleSort tc' :: TyCon
tc' =
        case TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc' of
          Just UnboxedTuple -> let arity :: Int
arity = TyCon -> Int
tyConArity TyCon
tc' Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
                               in IfaceTyConSort -> Maybe IfaceTyConSort
forall a. a -> Maybe a
Just (IfaceTyConSort -> Maybe IfaceTyConSort)
-> IfaceTyConSort -> Maybe IfaceTyConSort
forall a b. (a -> b) -> a -> b
$ Int -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon Int
arity TupleSort
UnboxedTuple
          Just sort :: TupleSort
sort         -> let arity :: Int
arity = TyCon -> Int
tyConArity TyCon
tc'
                               in IfaceTyConSort -> Maybe IfaceTyConSort
forall a. a -> Maybe a
Just (IfaceTyConSort -> Maybe IfaceTyConSort)
-> IfaceTyConSort -> Maybe IfaceTyConSort
forall a b. (a -> b) -> a -> b
$ Int -> TupleSort -> IfaceTyConSort
IfaceTupleTyCon Int
arity TupleSort
sort
          Nothing           -> Maybe IfaceTyConSort
forall a. Maybe a
Nothing

    sort :: IfaceTyConSort
sort
      | Just tsort :: IfaceTyConSort
tsort <- TyCon -> Maybe IfaceTyConSort
tupleSort TyCon
tc           = IfaceTyConSort
tsort

      | Just dcon :: DataCon
dcon <- TyCon -> Maybe DataCon
isPromotedDataCon_maybe TyCon
tc
      , let tc' :: TyCon
tc' = DataCon -> TyCon
dataConTyCon DataCon
dcon
      , Just tsort :: IfaceTyConSort
tsort <- TyCon -> Maybe IfaceTyConSort
tupleSort TyCon
tc'          = IfaceTyConSort
tsort

      | TyCon -> Bool
isUnboxedSumTyCon TyCon
tc
      , Just cons :: [DataCon]
cons <- TyCon -> Maybe [DataCon]
isDataSumTyCon_maybe TyCon
tc = Int -> IfaceTyConSort
IfaceSumTyCon ([DataCon] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [DataCon]
cons)

      | Bool
otherwise                            = IfaceTyConSort
IfaceNormalTyCon


toIfaceTyCon_name :: Name -> IfaceTyCon
toIfaceTyCon_name :: IfExtName -> IfaceTyCon
toIfaceTyCon_name n :: IfExtName
n = IfExtName -> IfaceTyConInfo -> IfaceTyCon
IfaceTyCon IfExtName
n IfaceTyConInfo
info
  where info :: IfaceTyConInfo
info = PromotionFlag -> IfaceTyConSort -> IfaceTyConInfo
IfaceTyConInfo PromotionFlag
NotPromoted IfaceTyConSort
IfaceNormalTyCon
  -- Used for the "rough-match" tycon stuff,
  -- where pretty-printing is not an issue

toIfaceTyLit :: TyLit -> IfaceTyLit
toIfaceTyLit :: TyLit -> IfaceTyLit
toIfaceTyLit (NumTyLit x :: Integer
x) = Integer -> IfaceTyLit
IfaceNumTyLit Integer
x
toIfaceTyLit (StrTyLit x :: FastString
x) = FastString -> IfaceTyLit
IfaceStrTyLit FastString
x

----------------
toIfaceCoercion :: Coercion -> IfaceCoercion
toIfaceCoercion :: KindCoercion -> IfaceCoercion
toIfaceCoercion = VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
emptyVarSet

toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
-- (toIfaceCoercionX free ty)
--    translates the tyvars in 'free' as IfaceFreeTyVars
toIfaceCoercionX :: VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX fr :: VarSet
fr co :: KindCoercion
co
  = KindCoercion -> IfaceCoercion
go KindCoercion
co
  where
    go_mco :: MCoercion -> IfaceMCoercion
go_mco MRefl     = IfaceMCoercion
IfaceMRefl
    go_mco (MCo co :: KindCoercion
co)  = IfaceCoercion -> IfaceMCoercion
IfaceMCo (IfaceCoercion -> IfaceMCoercion)
-> IfaceCoercion -> IfaceMCoercion
forall a b. (a -> b) -> a -> b
$ KindCoercion -> IfaceCoercion
go KindCoercion
co

    go :: KindCoercion -> IfaceCoercion
go (Refl ty :: Type
ty)            = IfaceType -> IfaceCoercion
IfaceReflCo (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
ty)
    go (GRefl r :: Role
r ty :: Type
ty mco :: MCoercion
mco)     = Role -> IfaceType -> IfaceMCoercion -> IfaceCoercion
IfaceGReflCo Role
r (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
ty) (MCoercion -> IfaceMCoercion
go_mco MCoercion
mco)
    go (CoVarCo cv :: TyVar
cv)
      -- See [TcTyVars in IfaceType] in IfaceType
      | TyVar
cv TyVar -> VarSet -> Bool
`elemVarSet` VarSet
fr  = TyVar -> IfaceCoercion
IfaceFreeCoVar TyVar
cv
      | Bool
otherwise           = FastString -> IfaceCoercion
IfaceCoVarCo (TyVar -> FastString
toIfaceCoVar TyVar
cv)
    go (HoleCo h :: CoercionHole
h)           = TyVar -> IfaceCoercion
IfaceHoleCo  (CoercionHole -> TyVar
coHoleCoVar CoercionHole
h)

    go (AppCo co1 :: KindCoercion
co1 co2 :: KindCoercion
co2)      = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceAppCo  (KindCoercion -> IfaceCoercion
go KindCoercion
co1) (KindCoercion -> IfaceCoercion
go KindCoercion
co2)
    go (SymCo co :: KindCoercion
co)           = IfaceCoercion -> IfaceCoercion
IfaceSymCo (KindCoercion -> IfaceCoercion
go KindCoercion
co)
    go (TransCo co1 :: KindCoercion
co1 co2 :: KindCoercion
co2)    = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceTransCo (KindCoercion -> IfaceCoercion
go KindCoercion
co1) (KindCoercion -> IfaceCoercion
go KindCoercion
co2)
    go (NthCo _r :: Role
_r d :: Int
d co :: KindCoercion
co)      = Int -> IfaceCoercion -> IfaceCoercion
IfaceNthCo Int
d (KindCoercion -> IfaceCoercion
go KindCoercion
co)
    go (LRCo lr :: LeftOrRight
lr co :: KindCoercion
co)         = LeftOrRight -> IfaceCoercion -> IfaceCoercion
IfaceLRCo LeftOrRight
lr (KindCoercion -> IfaceCoercion
go KindCoercion
co)
    go (InstCo co :: KindCoercion
co arg :: KindCoercion
arg)      = IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceInstCo (KindCoercion -> IfaceCoercion
go KindCoercion
co) (KindCoercion -> IfaceCoercion
go KindCoercion
arg)
    go (KindCo c :: KindCoercion
c)           = IfaceCoercion -> IfaceCoercion
IfaceKindCo (KindCoercion -> IfaceCoercion
go KindCoercion
c)
    go (SubCo co :: KindCoercion
co)           = IfaceCoercion -> IfaceCoercion
IfaceSubCo (KindCoercion -> IfaceCoercion
go KindCoercion
co)
    go (AxiomRuleCo co :: CoAxiomRule
co cs :: [KindCoercion]
cs)  = FastString -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomRuleCo (CoAxiomRule -> FastString
coaxrName CoAxiomRule
co) ((KindCoercion -> IfaceCoercion)
-> [KindCoercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map KindCoercion -> IfaceCoercion
go [KindCoercion]
cs)
    go (AxiomInstCo c :: CoAxiom Branched
c i :: Int
i cs :: [KindCoercion]
cs) = IfExtName -> Int -> [IfaceCoercion] -> IfaceCoercion
IfaceAxiomInstCo (CoAxiom Branched -> IfExtName
forall (br :: BranchFlag). CoAxiom br -> IfExtName
coAxiomName CoAxiom Branched
c) Int
i ((KindCoercion -> IfaceCoercion)
-> [KindCoercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map KindCoercion -> IfaceCoercion
go [KindCoercion]
cs)
    go (UnivCo p :: UnivCoProvenance
p r :: Role
r t1 :: Type
t1 t2 :: Type
t2)   = IfaceUnivCoProv -> Role -> IfaceType -> IfaceType -> IfaceCoercion
IfaceUnivCo (UnivCoProvenance -> IfaceUnivCoProv
go_prov UnivCoProvenance
p) Role
r
                                          (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t1)
                                          (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t2)
    go (TyConAppCo r :: Role
r tc :: TyCon
tc cos :: [KindCoercion]
cos)
      | TyCon
tc TyCon -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
funTyConKey
      , [_,_,_,_] <- [KindCoercion]
cos         = String -> SDoc -> IfaceCoercion
forall a. HasCallStack => String -> SDoc -> a
pprPanic "toIfaceCoercion" (KindCoercion -> SDoc
forall a. Outputable a => a -> SDoc
ppr KindCoercion
co)
      | Bool
otherwise                = Role -> IfaceTyCon -> [IfaceCoercion] -> IfaceCoercion
IfaceTyConAppCo Role
r (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
tc) ((KindCoercion -> IfaceCoercion)
-> [KindCoercion] -> [IfaceCoercion]
forall a b. (a -> b) -> [a] -> [b]
map KindCoercion -> IfaceCoercion
go [KindCoercion]
cos)
    go (FunCo r :: Role
r co1 :: KindCoercion
co1 co2 :: KindCoercion
co2)   = Role -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceFunCo Role
r (KindCoercion -> IfaceCoercion
go KindCoercion
co1) (KindCoercion -> IfaceCoercion
go KindCoercion
co2)

    go (ForAllCo tv :: TyVar
tv k :: KindCoercion
k co :: KindCoercion
co) = IfaceBndr -> IfaceCoercion -> IfaceCoercion -> IfaceCoercion
IfaceForAllCo (TyVar -> IfaceBndr
toIfaceBndr TyVar
tv)
                                          (VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr' KindCoercion
k)
                                          (VarSet -> KindCoercion -> IfaceCoercion
toIfaceCoercionX VarSet
fr' KindCoercion
co)
                          where
                            fr' :: VarSet
fr' = VarSet
fr VarSet -> TyVar -> VarSet
`delVarSet` TyVar
tv

    go_prov :: UnivCoProvenance -> IfaceUnivCoProv
    go_prov :: UnivCoProvenance -> IfaceUnivCoProv
go_prov UnsafeCoerceProv    = IfaceUnivCoProv
IfaceUnsafeCoerceProv
    go_prov (PhantomProv co :: KindCoercion
co)    = IfaceCoercion -> IfaceUnivCoProv
IfacePhantomProv (KindCoercion -> IfaceCoercion
go KindCoercion
co)
    go_prov (ProofIrrelProv co :: KindCoercion
co) = IfaceCoercion -> IfaceUnivCoProv
IfaceProofIrrelProv (KindCoercion -> IfaceCoercion
go KindCoercion
co)
    go_prov (PluginProv str :: String
str)    = String -> IfaceUnivCoProv
IfacePluginProv String
str

toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs = VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX VarSet
emptyVarSet

toIfaceTcArgsX :: VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX :: VarSet -> TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgsX fr :: VarSet
fr tc :: TyCon
tc ty_args :: [Type]
ty_args = VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppArgsX VarSet
fr (TyCon -> Type
tyConKind TyCon
tc) [Type]
ty_args

toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppTyArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppTyArgsX fr :: VarSet
fr ty :: Type
ty ty_args :: [Type]
ty_args = VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppArgsX VarSet
fr (HasDebugCallStack => Type -> Type
Type -> Type
typeKind Type
ty) [Type]
ty_args

toIfaceAppArgsX :: VarSet -> Kind -> [Type] -> IfaceAppArgs
-- See Note [Suppressing invisible arguments] in IfaceType
-- We produce a result list of args describing visibility
-- The awkward case is
--    T :: forall k. * -> k
-- And consider
--    T (forall j. blah) * blib
-- Is 'blib' visible?  It depends on the visibility flag on j,
-- so we have to substitute for k.  Annoying!
toIfaceAppArgsX :: VarSet -> Type -> [Type] -> IfaceAppArgs
toIfaceAppArgsX fr :: VarSet
fr kind :: Type
kind ty_args :: [Type]
ty_args
  = TCvSubst -> Type -> [Type] -> IfaceAppArgs
go (InScopeSet -> TCvSubst
mkEmptyTCvSubst InScopeSet
in_scope) Type
kind [Type]
ty_args
  where
    in_scope :: InScopeSet
in_scope = VarSet -> InScopeSet
mkInScopeSet ([Type] -> VarSet
tyCoVarsOfTypes [Type]
ty_args)

    go :: TCvSubst -> Type -> [Type] -> IfaceAppArgs
go _   _                   []     = IfaceAppArgs
IA_Nil
    go env :: TCvSubst
env ty :: Type
ty                  ts :: [Type]
ts
      | Just ty' :: Type
ty' <- Type -> Maybe Type
coreView Type
ty
      = TCvSubst -> Type -> [Type] -> IfaceAppArgs
go TCvSubst
env Type
ty' [Type]
ts
    go env :: TCvSubst
env (ForAllTy (Bndr tv :: TyVar
tv vis :: ArgFlag
vis) res :: Type
res) (t :: Type
t:ts :: [Type]
ts)
      = IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg IfaceType
t' ArgFlag
vis IfaceAppArgs
ts'
      where
        t' :: IfaceType
t'  = VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t
        ts' :: IfaceAppArgs
ts' = TCvSubst -> Type -> [Type] -> IfaceAppArgs
go (TCvSubst -> TyVar -> Type -> TCvSubst
extendTCvSubst TCvSubst
env TyVar
tv Type
t) Type
res [Type]
ts

    go env :: TCvSubst
env (FunTy _ res :: Type
res) (t :: Type
t:ts :: [Type]
ts) -- No type-class args in tycon apps
      = IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t) ArgFlag
Required (TCvSubst -> Type -> [Type] -> IfaceAppArgs
go TCvSubst
env Type
res [Type]
ts)

    go env :: TCvSubst
env ty :: Type
ty ts :: [Type]
ts@(t1 :: Type
t1:ts1 :: [Type]
ts1)
      | Bool -> Bool
not (TCvSubst -> Bool
isEmptyTCvSubst TCvSubst
env)
      = TCvSubst -> Type -> [Type] -> IfaceAppArgs
go (TCvSubst -> TCvSubst
zapTCvSubst TCvSubst
env) (HasCallStack => TCvSubst -> Type -> Type
TCvSubst -> Type -> Type
substTy TCvSubst
env Type
ty) [Type]
ts
        -- See Note [Care with kind instantiation] in Type.hs

      | Bool
otherwise
      = -- There's a kind error in the type we are trying to print
        -- e.g. kind = k, ty_args = [Int]
        -- This is probably a compiler bug, so we print a trace and
        -- carry on as if it were FunTy.  Without the test for
        -- isEmptyTCvSubst we'd get an infinite loop (Trac #15473)
        WARN( True, ppr kind $$ ppr ty_args )
        IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (VarSet -> Type -> IfaceType
toIfaceTypeX VarSet
fr Type
t1) ArgFlag
Required (TCvSubst -> Type -> [Type] -> IfaceAppArgs
go TCvSubst
env Type
ty [Type]
ts1)

tidyToIfaceType :: TidyEnv -> Type -> IfaceType
tidyToIfaceType :: TidyEnv -> Type -> IfaceType
tidyToIfaceType env :: TidyEnv
env ty :: Type
ty = Type -> IfaceType
toIfaceType (TidyEnv -> Type -> Type
tidyType TidyEnv
env Type
ty)

tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
tidyToIfaceTcArgs :: TidyEnv -> TyCon -> [Type] -> IfaceAppArgs
tidyToIfaceTcArgs env :: TidyEnv
env tc :: TyCon
tc tys :: [Type]
tys = TyCon -> [Type] -> IfaceAppArgs
toIfaceTcArgs TyCon
tc (TidyEnv -> [Type] -> [Type]
tidyTypes TidyEnv
env [Type]
tys)

tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
tidyToIfaceContext :: TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext env :: TidyEnv
env theta :: [Type]
theta = (Type -> IfaceType) -> [Type] -> IfaceContext
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env) [Type]
theta

{-
************************************************************************
*                                                                      *
        Conversion of pattern synonyms
*                                                                      *
************************************************************************
-}

patSynToIfaceDecl :: PatSyn -> IfaceDecl
patSynToIfaceDecl :: PatSyn -> IfaceDecl
patSynToIfaceDecl ps :: PatSyn
ps
  = IfacePatSyn :: IfExtName
-> Bool
-> (IfExtName, Bool)
-> Maybe (IfExtName, Bool)
-> [IfaceForAllBndr]
-> [IfaceForAllBndr]
-> IfaceContext
-> IfaceContext
-> IfaceContext
-> IfaceType
-> [FieldLabel]
-> IfaceDecl
IfacePatSyn { ifName :: IfExtName
ifName          = PatSyn -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName (PatSyn -> IfExtName) -> PatSyn -> IfExtName
forall a b. (a -> b) -> a -> b
$ PatSyn
ps
                , ifPatMatcher :: (IfExtName, Bool)
ifPatMatcher    = (TyVar, Bool) -> (IfExtName, Bool)
forall b. (TyVar, b) -> (IfExtName, b)
to_if_pr (PatSyn -> (TyVar, Bool)
patSynMatcher PatSyn
ps)
                , ifPatBuilder :: Maybe (IfExtName, Bool)
ifPatBuilder    = ((TyVar, Bool) -> (IfExtName, Bool))
-> Maybe (TyVar, Bool) -> Maybe (IfExtName, Bool)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (TyVar, Bool) -> (IfExtName, Bool)
forall b. (TyVar, b) -> (IfExtName, b)
to_if_pr (PatSyn -> Maybe (TyVar, Bool)
patSynBuilder PatSyn
ps)
                , ifPatIsInfix :: Bool
ifPatIsInfix    = PatSyn -> Bool
patSynIsInfix PatSyn
ps
                , ifPatUnivBndrs :: [IfaceForAllBndr]
ifPatUnivBndrs  = (TyCoVarBinder -> IfaceForAllBndr)
-> [TyCoVarBinder] -> [IfaceForAllBndr]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVarBinder -> IfaceForAllBndr
toIfaceForAllBndr [TyCoVarBinder]
univ_bndrs'
                , ifPatExBndrs :: [IfaceForAllBndr]
ifPatExBndrs    = (TyCoVarBinder -> IfaceForAllBndr)
-> [TyCoVarBinder] -> [IfaceForAllBndr]
forall a b. (a -> b) -> [a] -> [b]
map TyCoVarBinder -> IfaceForAllBndr
toIfaceForAllBndr [TyCoVarBinder]
ex_bndrs'
                , ifPatProvCtxt :: IfaceContext
ifPatProvCtxt   = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
env2 [Type]
prov_theta
                , ifPatReqCtxt :: IfaceContext
ifPatReqCtxt    = TidyEnv -> [Type] -> IfaceContext
tidyToIfaceContext TidyEnv
env2 [Type]
req_theta
                , ifPatArgs :: IfaceContext
ifPatArgs       = (Type -> IfaceType) -> [Type] -> IfaceContext
forall a b. (a -> b) -> [a] -> [b]
map (TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env2) [Type]
args
                , ifPatTy :: IfaceType
ifPatTy         = TidyEnv -> Type -> IfaceType
tidyToIfaceType TidyEnv
env2 Type
rhs_ty
                , ifFieldLabels :: [FieldLabel]
ifFieldLabels   = (PatSyn -> [FieldLabel]
patSynFieldLabels PatSyn
ps)
                }
  where
    (_univ_tvs :: [TyVar]
_univ_tvs, req_theta :: [Type]
req_theta, _ex_tvs :: [TyVar]
_ex_tvs, prov_theta :: [Type]
prov_theta, args :: [Type]
args, rhs_ty :: Type
rhs_ty) = PatSyn -> ([TyVar], [Type], [TyVar], [Type], [Type], Type)
patSynSig PatSyn
ps
    univ_bndrs :: [TyCoVarBinder]
univ_bndrs = PatSyn -> [TyCoVarBinder]
patSynUnivTyVarBinders PatSyn
ps
    ex_bndrs :: [TyCoVarBinder]
ex_bndrs   = PatSyn -> [TyCoVarBinder]
patSynExTyVarBinders PatSyn
ps
    (env1 :: TidyEnv
env1, univ_bndrs' :: [TyCoVarBinder]
univ_bndrs') = TidyEnv -> [TyCoVarBinder] -> (TidyEnv, [TyCoVarBinder])
forall vis.
TidyEnv -> [VarBndr TyVar vis] -> (TidyEnv, [VarBndr TyVar vis])
tidyTyCoVarBinders TidyEnv
emptyTidyEnv [TyCoVarBinder]
univ_bndrs
    (env2 :: TidyEnv
env2, ex_bndrs' :: [TyCoVarBinder]
ex_bndrs')   = TidyEnv -> [TyCoVarBinder] -> (TidyEnv, [TyCoVarBinder])
forall vis.
TidyEnv -> [VarBndr TyVar vis] -> (TidyEnv, [VarBndr TyVar vis])
tidyTyCoVarBinders TidyEnv
env1 [TyCoVarBinder]
ex_bndrs
    to_if_pr :: (TyVar, b) -> (IfExtName, b)
to_if_pr (id :: TyVar
id, needs_dummy :: b
needs_dummy) = (TyVar -> IfExtName
idName TyVar
id, b
needs_dummy)

{-
************************************************************************
*                                                                      *
        Conversion of other things
*                                                                      *
************************************************************************
-}

toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
toIfaceBang :: TidyEnv -> HsImplBang -> IfaceBang
toIfaceBang _    HsLazy              = IfaceBang
IfNoBang
toIfaceBang _   (HsUnpack Nothing)   = IfaceBang
IfUnpack
toIfaceBang env :: TidyEnv
env (HsUnpack (Just co :: KindCoercion
co)) = IfaceCoercion -> IfaceBang
IfUnpackCo (KindCoercion -> IfaceCoercion
toIfaceCoercion (TidyEnv -> KindCoercion -> KindCoercion
tidyCo TidyEnv
env KindCoercion
co))
toIfaceBang _   HsStrict             = IfaceBang
IfStrict

toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
toIfaceSrcBang :: HsSrcBang -> IfaceSrcBang
toIfaceSrcBang (HsSrcBang _ unpk :: SrcUnpackedness
unpk bang :: SrcStrictness
bang) = SrcUnpackedness -> SrcStrictness -> IfaceSrcBang
IfSrcBang SrcUnpackedness
unpk SrcStrictness
bang

toIfaceLetBndr :: Id -> IfaceLetBndr
toIfaceLetBndr :: TyVar -> IfaceLetBndr
toIfaceLetBndr id :: TyVar
id  = FastString
-> IfaceType -> IfaceIdInfo -> IfaceJoinInfo -> IfaceLetBndr
IfLetBndr (OccName -> FastString
occNameFS (TyVar -> OccName
forall a. NamedThing a => a -> OccName
getOccName TyVar
id))
                               (Type -> IfaceType
toIfaceType (TyVar -> Type
idType TyVar
id))
                               (IdInfo -> IfaceIdInfo
toIfaceIdInfo (HasDebugCallStack => TyVar -> IdInfo
TyVar -> IdInfo
idInfo TyVar
id))
                               (Maybe Int -> IfaceJoinInfo
toIfaceJoinInfo (TyVar -> Maybe Int
isJoinId_maybe TyVar
id))
  -- Put into the interface file any IdInfo that CoreTidy.tidyLetBndr
  -- has left on the Id.  See Note [IdInfo on nested let-bindings] in IfaceSyn

toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails :: IdDetails -> IfaceIdDetails
toIfaceIdDetails VanillaId                      = IfaceIdDetails
IfVanillaId
toIfaceIdDetails (DFunId {})                    = IfaceIdDetails
IfDFunId
toIfaceIdDetails (RecSelId { sel_naughty :: IdDetails -> Bool
sel_naughty = Bool
n
                           , sel_tycon :: IdDetails -> RecSelParent
sel_tycon = RecSelParent
tc })  =
  let iface :: Either IfaceTyCon IfaceDecl
iface = case RecSelParent
tc of
                RecSelData ty_con :: TyCon
ty_con -> IfaceTyCon -> Either IfaceTyCon IfaceDecl
forall a b. a -> Either a b
Left (TyCon -> IfaceTyCon
toIfaceTyCon TyCon
ty_con)
                RecSelPatSyn pat_syn :: PatSyn
pat_syn -> IfaceDecl -> Either IfaceTyCon IfaceDecl
forall a b. b -> Either a b
Right (PatSyn -> IfaceDecl
patSynToIfaceDecl PatSyn
pat_syn)
  in Either IfaceTyCon IfaceDecl -> Bool -> IfaceIdDetails
IfRecSelId Either IfaceTyCon IfaceDecl
iface Bool
n

  -- The remaining cases are all "implicit Ids" which don't
  -- appear in interface files at all
toIfaceIdDetails other :: IdDetails
other = String -> SDoc -> IfaceIdDetails -> IfaceIdDetails
forall a. String -> SDoc -> a -> a
pprTrace "toIfaceIdDetails" (IdDetails -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdDetails
other)
                         IfaceIdDetails
IfVanillaId   -- Unexpected; the other

toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo :: IdInfo -> IfaceIdInfo
toIfaceIdInfo id_info :: IdInfo
id_info
  = case [Maybe IfaceInfoItem] -> [IfaceInfoItem]
forall a. [Maybe a] -> [a]
catMaybes [Maybe IfaceInfoItem
arity_hsinfo, Maybe IfaceInfoItem
caf_hsinfo, Maybe IfaceInfoItem
strict_hsinfo,
                    Maybe IfaceInfoItem
inline_hsinfo,  Maybe IfaceInfoItem
unfold_hsinfo, Maybe IfaceInfoItem
levity_hsinfo] of
       []    -> IfaceIdInfo
NoInfo
       infos :: [IfaceInfoItem]
infos -> [IfaceInfoItem] -> IfaceIdInfo
HasInfo [IfaceInfoItem]
infos
               -- NB: strictness and arity must appear in the list before unfolding
               -- See TcIface.tcUnfolding
  where
    ------------  Arity  --------------
    arity_info :: Int
arity_info = IdInfo -> Int
arityInfo IdInfo
id_info
    arity_hsinfo :: Maybe IfaceInfoItem
arity_hsinfo | Int
arity_info Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
                 | Bool
otherwise       = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (Int -> IfaceInfoItem
HsArity Int
arity_info)

    ------------ Caf Info --------------
    caf_info :: CafInfo
caf_info   = IdInfo -> CafInfo
cafInfo IdInfo
id_info
    caf_hsinfo :: Maybe IfaceInfoItem
caf_hsinfo = case CafInfo
caf_info of
                   NoCafRefs -> IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just IfaceInfoItem
HsNoCafRefs
                   _other :: CafInfo
_other    -> Maybe IfaceInfoItem
forall a. Maybe a
Nothing

    ------------  Strictness  --------------
        -- No point in explicitly exporting TopSig
    sig_info :: StrictSig
sig_info = IdInfo -> StrictSig
strictnessInfo IdInfo
id_info
    strict_hsinfo :: Maybe IfaceInfoItem
strict_hsinfo | Bool -> Bool
not (StrictSig -> Bool
isTopSig StrictSig
sig_info) = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (StrictSig -> IfaceInfoItem
HsStrictness StrictSig
sig_info)
                  | Bool
otherwise               = Maybe IfaceInfoItem
forall a. Maybe a
Nothing

    ------------  Unfolding  --------------
    unfold_hsinfo :: Maybe IfaceInfoItem
unfold_hsinfo = Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding Bool
loop_breaker (IdInfo -> Unfolding
unfoldingInfo IdInfo
id_info)
    loop_breaker :: Bool
loop_breaker  = OccInfo -> Bool
isStrongLoopBreaker (IdInfo -> OccInfo
occInfo IdInfo
id_info)

    ------------  Inline prag  --------------
    inline_prag :: InlinePragma
inline_prag = IdInfo -> InlinePragma
inlinePragInfo IdInfo
id_info
    inline_hsinfo :: Maybe IfaceInfoItem
inline_hsinfo | InlinePragma -> Bool
isDefaultInlinePragma InlinePragma
inline_prag = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
                  | Bool
otherwise = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (InlinePragma -> IfaceInfoItem
HsInline InlinePragma
inline_prag)

    ------------  Levity polymorphism  ----------
    levity_hsinfo :: Maybe IfaceInfoItem
levity_hsinfo | IdInfo -> Bool
isNeverLevPolyIdInfo IdInfo
id_info = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just IfaceInfoItem
HsLevity
                  | Bool
otherwise                    = Maybe IfaceInfoItem
forall a. Maybe a
Nothing

toIfaceJoinInfo :: Maybe JoinArity -> IfaceJoinInfo
toIfaceJoinInfo :: Maybe Int -> IfaceJoinInfo
toIfaceJoinInfo (Just ar :: Int
ar) = Int -> IfaceJoinInfo
IfaceJoinPoint Int
ar
toIfaceJoinInfo Nothing   = IfaceJoinInfo
IfaceNotJoinPoint

--------------------------
toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding :: Bool -> Unfolding -> Maybe IfaceInfoItem
toIfUnfolding lb :: Bool
lb (CoreUnfolding { uf_tmpl :: Unfolding -> CoreExpr
uf_tmpl = CoreExpr
rhs
                                , uf_src :: Unfolding -> UnfoldingSource
uf_src = UnfoldingSource
src
                                , uf_guidance :: Unfolding -> UnfoldingGuidance
uf_guidance = UnfoldingGuidance
guidance })
  = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (IfaceInfoItem -> Maybe IfaceInfoItem)
-> IfaceInfoItem -> Maybe IfaceInfoItem
forall a b. (a -> b) -> a -> b
$ Bool -> IfaceUnfolding -> IfaceInfoItem
HsUnfold Bool
lb (IfaceUnfolding -> IfaceInfoItem)
-> IfaceUnfolding -> IfaceInfoItem
forall a b. (a -> b) -> a -> b
$
    case UnfoldingSource
src of
        InlineStable
          -> case UnfoldingGuidance
guidance of
               UnfWhen {ug_arity :: UnfoldingGuidance -> Int
ug_arity = Int
arity, ug_unsat_ok :: UnfoldingGuidance -> Bool
ug_unsat_ok = Bool
unsat_ok, ug_boring_ok :: UnfoldingGuidance -> Bool
ug_boring_ok =  Bool
boring_ok }
                      -> Int -> Bool -> Bool -> IfaceExpr -> IfaceUnfolding
IfInlineRule Int
arity Bool
unsat_ok Bool
boring_ok IfaceExpr
if_rhs
               _other :: UnfoldingGuidance
_other -> Bool -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold Bool
True IfaceExpr
if_rhs
        InlineCompulsory -> IfaceExpr -> IfaceUnfolding
IfCompulsory IfaceExpr
if_rhs
        InlineRhs        -> Bool -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold Bool
False IfaceExpr
if_rhs
        -- Yes, even if guidance is UnfNever, expose the unfolding
        -- If we didn't want to expose the unfolding, TidyPgm would
        -- have stuck in NoUnfolding.  For supercompilation we want
        -- to see that unfolding!
  where
    if_rhs :: IfaceExpr
if_rhs = CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
rhs

toIfUnfolding lb :: Bool
lb (DFunUnfolding { df_bndrs :: Unfolding -> [TyVar]
df_bndrs = [TyVar]
bndrs, df_args :: Unfolding -> [CoreExpr]
df_args = [CoreExpr]
args })
  = IfaceInfoItem -> Maybe IfaceInfoItem
forall a. a -> Maybe a
Just (Bool -> IfaceUnfolding -> IfaceInfoItem
HsUnfold Bool
lb ([IfaceBndr] -> [IfaceExpr] -> IfaceUnfolding
IfDFunUnfold ((TyVar -> IfaceBndr) -> [TyVar] -> [IfaceBndr]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> IfaceBndr
toIfaceBndr [TyVar]
bndrs) ((CoreExpr -> IfaceExpr) -> [CoreExpr] -> [IfaceExpr]
forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> IfaceExpr
toIfaceExpr [CoreExpr]
args)))
      -- No need to serialise the data constructor;
      -- we can recover it from the type of the dfun

toIfUnfolding _ (OtherCon {}) = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
  -- The binding site of an Id doesn't have OtherCon, except perhaps
  -- where we have called zapUnfolding; and that evald'ness info is
  -- not needed by importing modules

toIfUnfolding _ BootUnfolding = Maybe IfaceInfoItem
forall a. Maybe a
Nothing
  -- Can't happen; we only have BootUnfolding for imported binders

toIfUnfolding _ NoUnfolding = Maybe IfaceInfoItem
forall a. Maybe a
Nothing

{-
************************************************************************
*                                                                      *
        Conversion of expressions
*                                                                      *
************************************************************************
-}

toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr :: CoreExpr -> IfaceExpr
toIfaceExpr (Var v :: TyVar
v)         = TyVar -> IfaceExpr
toIfaceVar TyVar
v
toIfaceExpr (Lit l :: Literal
l)         = Literal -> IfaceExpr
IfaceLit Literal
l
toIfaceExpr (Type ty :: Type
ty)       = IfaceType -> IfaceExpr
IfaceType (Type -> IfaceType
toIfaceType Type
ty)
toIfaceExpr (Coercion co :: KindCoercion
co)   = IfaceCoercion -> IfaceExpr
IfaceCo   (KindCoercion -> IfaceCoercion
toIfaceCoercion KindCoercion
co)
toIfaceExpr (Lam x :: TyVar
x b :: CoreExpr
b)       = IfaceLamBndr -> IfaceExpr -> IfaceExpr
IfaceLam (TyVar -> IfaceBndr
toIfaceBndr TyVar
x, TyVar -> IfaceOneShot
toIfaceOneShot TyVar
x) (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
b)
toIfaceExpr (App f :: CoreExpr
f a :: CoreExpr
a)       = CoreExpr -> [CoreExpr] -> IfaceExpr
toIfaceApp CoreExpr
f [CoreExpr
a]
toIfaceExpr (Case s :: CoreExpr
s x :: TyVar
x ty :: Type
ty as :: [Alt TyVar]
as)
  | [Alt TyVar] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Alt TyVar]
as                 = IfaceExpr -> IfaceType -> IfaceExpr
IfaceECase (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
s) (Type -> IfaceType
toIfaceType Type
ty)
  | Bool
otherwise               = IfaceExpr -> FastString -> [IfaceAlt] -> IfaceExpr
IfaceCase (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
s) (TyVar -> FastString
forall a. NamedThing a => a -> FastString
getOccFS TyVar
x) ((Alt TyVar -> IfaceAlt) -> [Alt TyVar] -> [IfaceAlt]
forall a b. (a -> b) -> [a] -> [b]
map Alt TyVar -> IfaceAlt
toIfaceAlt [Alt TyVar]
as)
toIfaceExpr (Let b :: Bind TyVar
b e :: CoreExpr
e)       = IfaceBinding -> IfaceExpr -> IfaceExpr
IfaceLet (Bind TyVar -> IfaceBinding
toIfaceBind Bind TyVar
b) (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e)
toIfaceExpr (Cast e :: CoreExpr
e co :: KindCoercion
co)     = IfaceExpr -> IfaceCoercion -> IfaceExpr
IfaceCast (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e) (KindCoercion -> IfaceCoercion
toIfaceCoercion KindCoercion
co)
toIfaceExpr (Tick t :: Tickish TyVar
t e :: CoreExpr
e)
  | Just t' :: IfaceTickish
t' <- Tickish TyVar -> Maybe IfaceTickish
toIfaceTickish Tickish TyVar
t = IfaceTickish -> IfaceExpr -> IfaceExpr
IfaceTick IfaceTickish
t' (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e)
  | Bool
otherwise                   = CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e

toIfaceOneShot :: Id -> IfaceOneShot
toIfaceOneShot :: TyVar -> IfaceOneShot
toIfaceOneShot id :: TyVar
id | TyVar -> Bool
isId TyVar
id
                  , OneShotInfo
OneShotLam <- IdInfo -> OneShotInfo
oneShotInfo (HasDebugCallStack => TyVar -> IdInfo
TyVar -> IdInfo
idInfo TyVar
id)
                  = IfaceOneShot
IfaceOneShot
                  | Bool
otherwise
                  = IfaceOneShot
IfaceNoOneShot

---------------------
toIfaceTickish :: Tickish Id -> Maybe IfaceTickish
toIfaceTickish :: Tickish TyVar -> Maybe IfaceTickish
toIfaceTickish (ProfNote cc :: CostCentre
cc tick :: Bool
tick push :: Bool
push) = IfaceTickish -> Maybe IfaceTickish
forall a. a -> Maybe a
Just (CostCentre -> Bool -> Bool -> IfaceTickish
IfaceSCC CostCentre
cc Bool
tick Bool
push)
toIfaceTickish (HpcTick modl :: Module
modl ix :: Int
ix)       = IfaceTickish -> Maybe IfaceTickish
forall a. a -> Maybe a
Just (Module -> Int -> IfaceTickish
IfaceHpcTick Module
modl Int
ix)
toIfaceTickish (SourceNote src :: RealSrcSpan
src names :: String
names)  = IfaceTickish -> Maybe IfaceTickish
forall a. a -> Maybe a
Just (RealSrcSpan -> String -> IfaceTickish
IfaceSource RealSrcSpan
src String
names)
toIfaceTickish (Breakpoint {})         = Maybe IfaceTickish
forall a. Maybe a
Nothing
   -- Ignore breakpoints, since they are relevant only to GHCi, and
   -- should not be serialised (Trac #8333)

---------------------
toIfaceBind :: Bind Id -> IfaceBinding
toIfaceBind :: Bind TyVar -> IfaceBinding
toIfaceBind (NonRec b :: TyVar
b r :: CoreExpr
r) = IfaceLetBndr -> IfaceExpr -> IfaceBinding
IfaceNonRec (TyVar -> IfaceLetBndr
toIfaceLetBndr TyVar
b) (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
r)
toIfaceBind (Rec prs :: [(TyVar, CoreExpr)]
prs)    = [(IfaceLetBndr, IfaceExpr)] -> IfaceBinding
IfaceRec [(TyVar -> IfaceLetBndr
toIfaceLetBndr TyVar
b, CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
r) | (b :: TyVar
b,r :: CoreExpr
r) <- [(TyVar, CoreExpr)]
prs]

---------------------
toIfaceAlt :: (AltCon, [Var], CoreExpr)
           -> (IfaceConAlt, [FastString], IfaceExpr)
toIfaceAlt :: Alt TyVar -> IfaceAlt
toIfaceAlt (c :: AltCon
c,bs :: [TyVar]
bs,r :: CoreExpr
r) = (AltCon -> IfaceConAlt
toIfaceCon AltCon
c, (TyVar -> FastString) -> [TyVar] -> [FastString]
forall a b. (a -> b) -> [a] -> [b]
map TyVar -> FastString
forall a. NamedThing a => a -> FastString
getOccFS [TyVar]
bs, CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
r)

---------------------
toIfaceCon :: AltCon -> IfaceConAlt
toIfaceCon :: AltCon -> IfaceConAlt
toIfaceCon (DataAlt dc :: DataCon
dc) = IfExtName -> IfaceConAlt
IfaceDataAlt (DataCon -> IfExtName
forall a. NamedThing a => a -> IfExtName
getName DataCon
dc)
toIfaceCon (LitAlt l :: Literal
l)   = Literal -> IfaceConAlt
IfaceLitAlt Literal
l
toIfaceCon DEFAULT      = IfaceConAlt
IfaceDefault

---------------------
toIfaceApp :: Expr CoreBndr -> [Arg CoreBndr] -> IfaceExpr
toIfaceApp :: CoreExpr -> [CoreExpr] -> IfaceExpr
toIfaceApp (App f :: CoreExpr
f a :: CoreExpr
a) as :: [CoreExpr]
as = CoreExpr -> [CoreExpr] -> IfaceExpr
toIfaceApp CoreExpr
f (CoreExpr
aCoreExpr -> [CoreExpr] -> [CoreExpr]
forall a. a -> [a] -> [a]
:[CoreExpr]
as)
toIfaceApp (Var v :: TyVar
v) as :: [CoreExpr]
as
  = case TyVar -> Maybe DataCon
isDataConWorkId_maybe TyVar
v of
        -- We convert the *worker* for tuples into IfaceTuples
        Just dc :: DataCon
dc |  Bool
saturated
                ,  Just tup_sort :: TupleSort
tup_sort <- TyCon -> Maybe TupleSort
tyConTuple_maybe TyCon
tc
                -> TupleSort -> [IfaceExpr] -> IfaceExpr
IfaceTuple TupleSort
tup_sort [IfaceExpr]
tup_args
          where
            val_args :: [CoreExpr]
val_args  = (CoreExpr -> Bool) -> [CoreExpr] -> [CoreExpr]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile CoreExpr -> Bool
forall b. Expr b -> Bool
isTypeArg [CoreExpr]
as
            saturated :: Bool
saturated = [CoreExpr]
val_args [CoreExpr] -> Int -> Bool
forall a. [a] -> Int -> Bool
`lengthIs` TyVar -> Int
idArity TyVar
v
            tup_args :: [IfaceExpr]
tup_args  = (CoreExpr -> IfaceExpr) -> [CoreExpr] -> [IfaceExpr]
forall a b. (a -> b) -> [a] -> [b]
map CoreExpr -> IfaceExpr
toIfaceExpr [CoreExpr]
val_args
            tc :: TyCon
tc        = DataCon -> TyCon
dataConTyCon DataCon
dc

        _ -> IfaceExpr -> [CoreExpr] -> IfaceExpr
mkIfaceApps (TyVar -> IfaceExpr
toIfaceVar TyVar
v) [CoreExpr]
as

toIfaceApp e :: CoreExpr
e as :: [CoreExpr]
as = IfaceExpr -> [CoreExpr] -> IfaceExpr
mkIfaceApps (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
e) [CoreExpr]
as

mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
mkIfaceApps :: IfaceExpr -> [CoreExpr] -> IfaceExpr
mkIfaceApps f :: IfaceExpr
f as :: [CoreExpr]
as = (IfaceExpr -> CoreExpr -> IfaceExpr)
-> IfaceExpr -> [CoreExpr] -> IfaceExpr
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\f :: IfaceExpr
f a :: CoreExpr
a -> IfaceExpr -> IfaceExpr -> IfaceExpr
IfaceApp IfaceExpr
f (CoreExpr -> IfaceExpr
toIfaceExpr CoreExpr
a)) IfaceExpr
f [CoreExpr]
as

---------------------
toIfaceVar :: Id -> IfaceExpr
toIfaceVar :: TyVar -> IfaceExpr
toIfaceVar v :: TyVar
v
    | Unfolding -> Bool
isBootUnfolding (TyVar -> Unfolding
idUnfolding TyVar
v)
    = -- See Note [Inlining and hs-boot files]
      IfaceExpr -> IfaceExpr -> IfaceExpr
IfaceApp (IfaceExpr -> IfaceExpr -> IfaceExpr
IfaceApp (IfExtName -> IfaceExpr
IfaceExt IfExtName
noinlineIdName)
                         (IfaceType -> IfaceExpr
IfaceType (Type -> IfaceType
toIfaceType (TyVar -> Type
idType TyVar
v))))
               (IfExtName -> IfaceExpr
IfaceExt IfExtName
name) -- don't use mkIfaceApps, or infinite loop

    | Just fcall :: ForeignCall
fcall <- TyVar -> Maybe ForeignCall
isFCallId_maybe TyVar
v = ForeignCall -> IfaceType -> IfaceExpr
IfaceFCall ForeignCall
fcall (Type -> IfaceType
toIfaceType (TyVar -> Type
idType TyVar
v))
                                      -- Foreign calls have special syntax

    | IfExtName -> Bool
isExternalName IfExtName
name             = IfExtName -> IfaceExpr
IfaceExt IfExtName
name
    | Bool
otherwise                       = FastString -> IfaceExpr
IfaceLcl (IfExtName -> FastString
forall a. NamedThing a => a -> FastString
getOccFS IfExtName
name)
  where name :: IfExtName
name = TyVar -> IfExtName
idName TyVar
v


{- Note [Inlining and hs-boot files]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this example (Trac #10083, #12789):

    ---------- RSR.hs-boot ------------
    module RSR where
      data RSR
      eqRSR :: RSR -> RSR -> Bool

    ---------- SR.hs ------------
    module SR where
      import {-# SOURCE #-} RSR
      data SR = MkSR RSR
      eqSR (MkSR r1) (MkSR r2) = eqRSR r1 r2

    ---------- RSR.hs ------------
    module RSR where
      import SR
      data RSR = MkRSR SR -- deriving( Eq )
      eqRSR (MkRSR s1) (MkRSR s2) = (eqSR s1 s2)
      foo x y = not (eqRSR x y)

When compiling RSR we get this code

    RSR.eqRSR :: RSR -> RSR -> Bool
    RSR.eqRSR = \ (ds1 :: RSR.RSR) (ds2 :: RSR.RSR) ->
                case ds1 of _ { RSR.MkRSR s1 ->
                case ds2 of _ { RSR.MkRSR s2 ->
                SR.eqSR s1 s2 }}

    RSR.foo :: RSR -> RSR -> Bool
    RSR.foo = \ (x :: RSR) (y :: RSR) -> not (RSR.eqRSR x y)

Now, when optimising foo:
    Inline eqRSR (small, non-rec)
    Inline eqSR  (small, non-rec)
but the result of inlining eqSR from SR is another call to eqRSR, so
everything repeats.  Neither eqSR nor eqRSR are (apparently) loop
breakers.

Solution: in the unfolding of eqSR in SR.hi, replace `eqRSR` in SR
with `noinline eqRSR`, so that eqRSR doesn't get inlined.  This means
that when GHC inlines `eqSR`, it will not also inline `eqRSR`, exactly
as would have been the case if `foo` had been defined in SR.hs (and
marked as a loop-breaker).

But how do we arrange for this to happen?  There are two ingredients:

    1. When we serialize out unfoldings to IfaceExprs (toIfaceVar),
    for every variable reference we see if we are referring to an
    'Id' that came from an hs-boot file.  If so, we add a `noinline`
    to the reference.

    2. But how do we know if a reference came from an hs-boot file
    or not?  We could record this directly in the 'IdInfo', but
    actually we deduce this by looking at the unfolding: 'Id's
    that come from boot files are given a special unfolding
    (upon typechecking) 'BootUnfolding' which say that there is
    no unfolding, and the reason is because the 'Id' came from
    a boot file.

Here is a solution that doesn't work: when compiling RSR,
add a NOINLINE pragma to every function exported by the boot-file
for RSR (if it exists).  Doing so makes the bootstrapped GHC itself
slower by 8% overall (on Trac #9872a-d, and T1969: the reason
is that these NOINLINE'd functions now can't be profitably inlined
outside of the hs-boot loop.

-}