{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-}

{-# LANGUAGE CPP #-}

module IfaceSyn (
        module IfaceType,

        IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..),
        IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
        IfaceExpr(..), IfaceAlt, IfaceLetBndr(..), IfaceJoinInfo(..),
        IfaceBinding(..), IfaceConAlt(..),
        IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
        IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
        IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
        IfaceClassBody(..),
        IfaceBang(..),
        IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),
        IfaceAxBranch(..),
        IfaceTyConParent(..),
        IfaceCompleteMatch(..),

        -- * Binding names
        IfaceTopBndr,
        putIfaceTopBndr, getIfaceTopBndr,

        -- Misc
        ifaceDeclImplicitBndrs, visibleIfConDecls,
        ifaceDeclFingerprints,

        -- Free Names
        freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,

        -- Pretty printing
        pprIfaceExpr,
        pprIfaceDecl,
        AltPpr(..), ShowSub(..), ShowHowMuch(..), showToIface, showToHeader
    ) where

#include "HsVersions.h"

import GhcPrelude

import IfaceType
import BinFingerprint
import CoreSyn( IsOrphan, isOrphan )
import PprCore()            -- Printing DFunArgs
import Demand
import Class
import FieldLabel
import NameSet
import CoAxiom ( BranchIndex )
import Name
import CostCentre
import Literal
import ForeignCall
import Annotations( AnnPayload, AnnTarget )
import BasicTypes
import Outputable
import Module
import SrcLoc
import Fingerprint
import Binary
import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
import Var( VarBndr(..), binderVar )
import TyCon ( Role (..), Injectivity(..), tyConBndrVisArgFlag )
import Util( dropList, filterByList )
import DataCon (SrcStrictness(..), SrcUnpackedness(..))
import Lexeme (isLexSym)

import Control.Monad
import System.IO.Unsafe

infixl 3 &&&

{-
************************************************************************
*                                                                      *
                    Declarations
*                                                                      *
************************************************************************
-}

-- | A binding top-level 'Name' in an interface file (e.g. the name of an
-- 'IfaceDecl').
type IfaceTopBndr = Name
  -- It's convenient to have a Name in the IfaceSyn, although in each
  -- case the namespace is implied by the context. However, having an
  -- Name makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
  -- very convenient. Moreover, having the key of the binder means that
  -- we can encode known-key things cleverly in the symbol table. See Note
  -- [Symbol table representation of Names]
  --
  -- We don't serialise the namespace onto the disk though; rather we
  -- drop it when serialising and add it back in when deserialising.

getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr
getIfaceTopBndr :: BinHandle -> IO IfaceTopBndr
getIfaceTopBndr bh :: BinHandle
bh = BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr :: BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr bh :: BinHandle
bh name :: IfaceTopBndr
name =
    case BinHandle -> UserData
getUserData BinHandle
bh of
      UserData{ ud_put_binding_name :: UserData -> BinHandle -> IfaceTopBndr -> IO ()
ud_put_binding_name = BinHandle -> IfaceTopBndr -> IO ()
put_binding_name } ->
          --pprTrace "putIfaceTopBndr" (ppr name) $
          BinHandle -> IfaceTopBndr -> IO ()
put_binding_name BinHandle
bh IfaceTopBndr
name

data IfaceDecl
  = IfaceId { IfaceDecl -> IfaceTopBndr
ifName      :: IfaceTopBndr,
              IfaceDecl -> IfaceType
ifType      :: IfaceType,
              IfaceDecl -> IfaceIdDetails
ifIdDetails :: IfaceIdDetails,
              IfaceDecl -> IfaceIdInfo
ifIdInfo    :: IfaceIdInfo }

  | IfaceData { ifName       :: IfaceTopBndr,   -- Type constructor
                IfaceDecl -> [IfaceTyConBinder]
ifBinders    :: [IfaceTyConBinder],
                IfaceDecl -> IfaceType
ifResKind    :: IfaceType,      -- Result kind of type constructor
                IfaceDecl -> Maybe CType
ifCType      :: Maybe CType,    -- C type for CAPI FFI
                IfaceDecl -> [Role]
ifRoles      :: [Role],         -- Roles
                IfaceDecl -> IfaceContext
ifCtxt       :: IfaceContext,   -- The "stupid theta"
                IfaceDecl -> IfaceConDecls
ifCons       :: IfaceConDecls,  -- Includes new/data/data family info
                IfaceDecl -> Bool
ifGadtSyntax :: Bool,           -- True <=> declared using
                                                -- GADT syntax
                IfaceDecl -> IfaceTyConParent
ifParent     :: IfaceTyConParent -- The axiom, for a newtype,
                                                 -- or data/newtype family instance
    }

  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor
                   ifRoles   :: [Role],            -- Roles
                   ifBinders :: [IfaceTyConBinder],
                   ifResKind :: IfaceKind,         -- Kind of the *result*
                   IfaceDecl -> IfaceType
ifSynRhs  :: IfaceType }

  | IfaceFamily  { ifName    :: IfaceTopBndr,      -- Type constructor
                   IfaceDecl -> Maybe IfLclName
ifResVar  :: Maybe IfLclName,   -- Result variable name, used
                                                   -- only for pretty-printing
                                                   -- with --show-iface
                   ifBinders :: [IfaceTyConBinder],
                   ifResKind :: IfaceKind,         -- Kind of the *tycon*
                   IfaceDecl -> IfaceFamTyConFlav
ifFamFlav :: IfaceFamTyConFlav,
                   IfaceDecl -> Injectivity
ifFamInj  :: Injectivity }      -- injectivity information

  | IfaceClass { ifName    :: IfaceTopBndr,             -- Name of the class TyCon
                 ifRoles   :: [Role],                   -- Roles
                 ifBinders :: [IfaceTyConBinder],
                 IfaceDecl -> [FunDep IfLclName]
ifFDs     :: [FunDep IfLclName],       -- Functional dependencies
                 IfaceDecl -> IfaceClassBody
ifBody    :: IfaceClassBody            -- Methods, superclasses, ATs
    }

  | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name
                 IfaceDecl -> IfaceTyCon
ifTyCon      :: IfaceTyCon,     -- LHS TyCon
                 IfaceDecl -> Role
ifRole       :: Role,           -- Role of axiom
                 IfaceDecl -> [IfaceAxBranch]
ifAxBranches :: [IfaceAxBranch] -- Branches
    }

  | IfacePatSyn { ifName          :: IfaceTopBndr,           -- Name of the pattern synonym
                  IfaceDecl -> Bool
ifPatIsInfix    :: Bool,
                  IfaceDecl -> (IfaceTopBndr, Bool)
ifPatMatcher    :: (IfExtName, Bool),
                  IfaceDecl -> Maybe (IfaceTopBndr, Bool)
ifPatBuilder    :: Maybe (IfExtName, Bool),
                  -- Everything below is redundant,
                  -- but needed to implement pprIfaceDecl
                  IfaceDecl -> [IfaceForAllBndr]
ifPatUnivBndrs  :: [IfaceForAllBndr],
                  IfaceDecl -> [IfaceForAllBndr]
ifPatExBndrs    :: [IfaceForAllBndr],
                  IfaceDecl -> IfaceContext
ifPatProvCtxt   :: IfaceContext,
                  IfaceDecl -> IfaceContext
ifPatReqCtxt    :: IfaceContext,
                  IfaceDecl -> IfaceContext
ifPatArgs       :: [IfaceType],
                  IfaceDecl -> IfaceType
ifPatTy         :: IfaceType,
                  IfaceDecl -> [FieldLabel]
ifFieldLabels   :: [FieldLabel] }

-- See also 'ClassBody'
data IfaceClassBody
  -- Abstract classes don't specify their body; they only occur in @hs-boot@ and
  -- @hsig@ files.
  = IfAbstractClass
  | IfConcreteClass {
     IfaceClassBody -> IfaceContext
ifClassCtxt :: IfaceContext,             -- Super classes
     IfaceClassBody -> [IfaceAT]
ifATs       :: [IfaceAT],                -- Associated type families
     IfaceClassBody -> [IfaceClassOp]
ifSigs      :: [IfaceClassOp],           -- Method signatures
     IfaceClassBody -> BooleanFormula IfLclName
ifMinDef    :: BooleanFormula IfLclName  -- Minimal complete definition
    }

data IfaceTyConParent
  = IfNoParent
  | IfDataInstance
       IfExtName     -- Axiom name
       IfaceTyCon    -- Family TyCon (pretty-printing only, not used in TcIface)
                     -- see Note [Pretty printing via IfaceSyn] in PprTyThing
       IfaceAppArgs  -- Arguments of the family TyCon

data IfaceFamTyConFlav
  = IfaceDataFamilyTyCon                      -- Data family
  | IfaceOpenSynFamilyTyCon
  | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))
    -- ^ Name of associated axiom and branches for pretty printing purposes,
    -- or 'Nothing' for an empty closed family without an axiom
    -- See Note [Pretty printing via IfaceSyn] in PprTyThing
  | IfaceAbstractClosedSynFamilyTyCon
  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only

data IfaceClassOp
  = IfaceClassOp IfaceTopBndr
                 IfaceType                         -- Class op type
                 (Maybe (DefMethSpec IfaceType))   -- Default method
                 -- The types of both the class op itself,
                 -- and the default method, are *not* quantified
                 -- over the class variables

data IfaceAT = IfaceAT  -- See Class.ClassATItem
                  IfaceDecl          -- The associated type declaration
                  (Maybe IfaceType)  -- Default associated type instance, if any


-- This is just like CoAxBranch
data IfaceAxBranch = IfaceAxBranch { IfaceAxBranch -> [IfaceTvBndr]
ifaxbTyVars    :: [IfaceTvBndr]
                                   , IfaceAxBranch -> [IfaceTvBndr]
ifaxbEtaTyVars :: [IfaceTvBndr]
                                   , IfaceAxBranch -> [IfaceTvBndr]
ifaxbCoVars    :: [IfaceIdBndr]
                                   , IfaceAxBranch -> IfaceAppArgs
ifaxbLHS       :: IfaceAppArgs
                                   , IfaceAxBranch -> [Role]
ifaxbRoles     :: [Role]
                                   , IfaceAxBranch -> IfaceType
ifaxbRHS       :: IfaceType
                                   , IfaceAxBranch -> [BranchIndex]
ifaxbIncomps   :: [BranchIndex] }
                                     -- See Note [Storing compatibility] in CoAxiom

data IfaceConDecls
  = IfAbstractTyCon     -- c.f TyCon.AbstractTyCon
  | IfDataTyCon [IfaceConDecl] -- Data type decls
  | IfNewTyCon  IfaceConDecl   -- Newtype decls

-- For IfDataTyCon and IfNewTyCon we store:
--  * the data constructor(s);
-- The field labels are stored individually in the IfaceConDecl
-- (there is some redundancy here, because a field label may occur
-- in multiple IfaceConDecls and represent the same field label)

data IfaceConDecl
  = IfCon {
        IfaceConDecl -> IfaceTopBndr
ifConName    :: IfaceTopBndr,                -- Constructor name
        IfaceConDecl -> Bool
ifConWrapper :: Bool,                   -- True <=> has a wrapper
        IfaceConDecl -> Bool
ifConInfix   :: Bool,                   -- True <=> declared infix

        -- The universal type variables are precisely those
        -- of the type constructor of this data constructor
        -- This is *easy* to guarantee when creating the IfCon
        -- but it's not so easy for the original TyCon/DataCon
        -- So this guarantee holds for IfaceConDecl, but *not* for DataCon

        IfaceConDecl -> [IfaceBndr]
ifConExTCvs   :: [IfaceBndr],  -- Existential ty/covars
        IfaceConDecl -> [IfaceForAllBndr]
ifConUserTvBinders :: [IfaceForAllBndr],
          -- The tyvars, in the order the user wrote them
          -- INVARIANT: the set of tyvars in ifConUserTvBinders is exactly the
          --            set of tyvars (*not* covars) of ifConExTCvs, unioned
          --            with the set of ifBinders (from the parent IfaceDecl)
          --            whose tyvars do not appear in ifConEqSpec
          -- See Note [DataCon user type variable binders] in DataCon
        IfaceConDecl -> [IfaceTvBndr]
ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints
        IfaceConDecl -> IfaceContext
ifConCtxt    :: IfaceContext,       -- Non-stupid context
        IfaceConDecl -> IfaceContext
ifConArgTys  :: [IfaceType],        -- Arg types
        IfaceConDecl -> [FieldLabel]
ifConFields  :: [FieldLabel],  -- ...ditto... (field labels)
        IfaceConDecl -> [IfaceBang]
ifConStricts :: [IfaceBang],
          -- Empty (meaning all lazy),
          -- or 1-1 corresp with arg tys
          -- See Note [Bangs on imported data constructors] in MkId
        IfaceConDecl -> [IfaceSrcBang]
ifConSrcStricts :: [IfaceSrcBang] } -- empty meaning no src stricts

type IfaceEqSpec = [(IfLclName,IfaceType)]

-- | This corresponds to an HsImplBang; that is, the final
-- implementation decision about the data constructor arg
data IfaceBang
  = IfNoBang | IfStrict | IfUnpack | IfUnpackCo IfaceCoercion

-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

data IfaceClsInst
  = IfaceClsInst { IfaceClsInst -> IfaceTopBndr
ifInstCls  :: IfExtName,                -- See comments with
                   IfaceClsInst -> [Maybe IfaceTyCon]
ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
                   IfaceClsInst -> IfaceTopBndr
ifDFun     :: IfExtName,                -- The dfun
                   IfaceClsInst -> OverlapFlag
ifOFlag    :: OverlapFlag,              -- Overlap flag
                   IfaceClsInst -> IsOrphan
ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv
        -- There's always a separate IfaceDecl for the DFun, which gives
        -- its IdInfo with its full type and version number.
        -- The instance declarations taken together have a version number,
        -- and we don't want that to wobble gratuitously
        -- If this instance decl is *used*, we'll record a usage on the dfun;
        -- and if the head does not change it won't be used if it wasn't before

-- The ifFamInstTys field of IfaceFamInst contains a list of the rough
-- match types
data IfaceFamInst
  = IfaceFamInst { IfaceFamInst -> IfaceTopBndr
ifFamInstFam      :: IfExtName            -- Family name
                 , IfaceFamInst -> [Maybe IfaceTyCon]
ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above
                 , IfaceFamInst -> IfaceTopBndr
ifFamInstAxiom    :: IfExtName            -- The axiom
                 , IfaceFamInst -> IsOrphan
ifFamInstOrph     :: IsOrphan             -- Just like IfaceClsInst
                 }

data IfaceRule
  = IfaceRule {
        IfaceRule -> IfLclName
ifRuleName   :: RuleName,
        IfaceRule -> Activation
ifActivation :: Activation,
        IfaceRule -> [IfaceBndr]
ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
        IfaceRule -> IfaceTopBndr
ifRuleHead   :: IfExtName,      -- Head of lhs
        IfaceRule -> [IfaceExpr]
ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
        IfaceRule -> IfaceExpr
ifRuleRhs    :: IfaceExpr,
        IfaceRule -> Bool
ifRuleAuto   :: Bool,
        IfaceRule -> IsOrphan
ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst
    }

data IfaceAnnotation
  = IfaceAnnotation {
        IfaceAnnotation -> IfaceAnnTarget
ifAnnotatedTarget :: IfaceAnnTarget,
        IfaceAnnotation -> AnnPayload
ifAnnotatedValue  :: AnnPayload
  }

type IfaceAnnTarget = AnnTarget OccName

data IfaceCompleteMatch = IfaceCompleteMatch [IfExtName] IfExtName

instance Outputable IfaceCompleteMatch where
  ppr :: IfaceCompleteMatch -> SDoc
ppr (IfaceCompleteMatch cls :: [IfaceTopBndr]
cls ty :: IfaceTopBndr
ty) = String -> SDoc
text "COMPLETE" SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> [IfaceTopBndr] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceTopBndr]
cls
                                                    SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
ty




-- Here's a tricky case:
--   * Compile with -O module A, and B which imports A.f
--   * Change function f in A, and recompile without -O
--   * When we read in old A.hi we read in its IdInfo (as a thunk)
--      (In earlier GHCs we used to drop IdInfo immediately on reading,
--       but we do not do that now.  Instead it's discarded when the
--       ModIface is read into the various decl pools.)
--   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
--      and so gives a new version.

data IfaceIdInfo
  = NoInfo                      -- When writing interface file without -O
  | HasInfo [IfaceInfoItem]     -- Has info, and here it is

data IfaceInfoItem
  = HsArity         Arity
  | HsStrictness    StrictSig
  | HsInline        InlinePragma
  | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true
                    IfaceUnfolding   -- See Note [Expose recursive functions]
  | HsNoCafRefs
  | HsLevity                         -- Present <=> never levity polymorphic

-- NB: Specialisations and rules come in separately and are
-- only later attached to the Id.  Partial reason: some are orphans.

data IfaceUnfolding
  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
                                -- Possibly could eliminate the Bool here, the information
                                -- is also in the InlinePragma.

  | IfCompulsory IfaceExpr      -- Only used for default methods, in fact

  | IfInlineRule Arity          -- INLINE pragmas
                 Bool           -- OK to inline even if *un*-saturated
                 Bool           -- OK to inline even if context is boring
                 IfaceExpr

  | IfDFunUnfold [IfaceBndr] [IfaceExpr]


-- We only serialise the IdDetails of top-level Ids, and even then
-- we only need a very limited selection.  Notably, none of the
-- implicit ones are needed here, because they are not put it
-- interface files

data IfaceIdDetails
  = IfVanillaId
  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
  | IfDFunId

{-
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]


************************************************************************
*                                                                      *
                Functions over declarations
*                                                                      *
************************************************************************
-}

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls IfAbstractTyCon  = []
visibleIfConDecls (IfDataTyCon cs :: [IfaceConDecl]
cs) = [IfaceConDecl]
cs
visibleIfConDecls (IfNewTyCon c :: IfaceConDecl
c)   = [IfaceConDecl
c]

ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
--  *Excludes* the 'main' name, but *includes* the implicitly-bound names
-- Deeply revolting, because it has to predict what gets bound,
-- especially the question of whether there's a wrapper for a datacon
-- See Note [Implicit TyThings] in HscTypes

-- N.B. the set of names returned here *must* match the set of
-- TyThings returned by HscTypes.implicitTyThings, in the sense that
-- TyThing.getOccName should define a bijection between the two lists.
-- This invariant is used in LoadIface.loadDecl (see note [Tricky iface loop])
-- The order of the list does not matter.

ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
ifaceDeclImplicitBndrs (IfaceData {ifName :: IfaceDecl -> IfaceTopBndr
ifName = IfaceTopBndr
tc_name, ifCons :: IfaceDecl -> IfaceConDecls
ifCons = IfaceConDecls
cons })
  = case IfaceConDecls
cons of
      IfAbstractTyCon -> []
      IfNewTyCon  cd :: IfaceConDecl
cd  -> OccName -> OccName
mkNewTyCoOcc (IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
tc_name) OccName -> [OccName] -> [OccName]
forall a. a -> [a] -> [a]
: IfaceConDecl -> [OccName]
ifaceConDeclImplicitBndrs IfaceConDecl
cd
      IfDataTyCon cds :: [IfaceConDecl]
cds -> (IfaceConDecl -> [OccName]) -> [IfaceConDecl] -> [OccName]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap IfaceConDecl -> [OccName]
ifaceConDeclImplicitBndrs [IfaceConDecl]
cds

ifaceDeclImplicitBndrs (IfaceClass { ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfaceClassBody
IfAbstractClass })
  = []

ifaceDeclImplicitBndrs (IfaceClass { ifName :: IfaceDecl -> IfaceTopBndr
ifName = IfaceTopBndr
cls_tc_name
                                   , ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfConcreteClass {
                                        ifClassCtxt :: IfaceClassBody -> IfaceContext
ifClassCtxt = IfaceContext
sc_ctxt,
                                        ifSigs :: IfaceClassBody -> [IfaceClassOp]
ifSigs      = [IfaceClassOp]
sigs,
                                        ifATs :: IfaceClassBody -> [IfaceAT]
ifATs       = [IfaceAT]
ats
                                     }})
  = --   (possibly) newtype coercion
    [OccName]
co_occs [OccName] -> [OccName] -> [OccName]
forall a. [a] -> [a] -> [a]
++
    --    data constructor (DataCon namespace)
    --    data worker (Id namespace)
    --    no wrapper (class dictionaries never have a wrapper)
    [OccName
dc_occ, OccName
dcww_occ] [OccName] -> [OccName] -> [OccName]
forall a. [a] -> [a] -> [a]
++
    -- associated types
    [IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName (IfaceDecl -> IfaceTopBndr
ifName IfaceDecl
at) | IfaceAT at :: IfaceDecl
at _ <- [IfaceAT]
ats ] [OccName] -> [OccName] -> [OccName]
forall a. [a] -> [a] -> [a]
++
    -- superclass selectors
    [BranchIndex -> OccName -> OccName
mkSuperDictSelOcc BranchIndex
n OccName
cls_tc_occ | BranchIndex
n <- [1..BranchIndex
n_ctxt]] [OccName] -> [OccName] -> [OccName]
forall a. [a] -> [a] -> [a]
++
    -- operation selectors
    [IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
op | IfaceClassOp op :: IfaceTopBndr
op  _ _ <- [IfaceClassOp]
sigs]
  where
    cls_tc_occ :: OccName
cls_tc_occ = IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
cls_tc_name
    n_ctxt :: BranchIndex
n_ctxt = IfaceContext -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length IfaceContext
sc_ctxt
    n_sigs :: BranchIndex
n_sigs = [IfaceClassOp] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [IfaceClassOp]
sigs
    co_occs :: [OccName]
co_occs | Bool
is_newtype = [OccName -> OccName
mkNewTyCoOcc OccName
cls_tc_occ]
            | Bool
otherwise  = []
    dcww_occ :: OccName
dcww_occ = OccName -> OccName
mkDataConWorkerOcc OccName
dc_occ
    dc_occ :: OccName
dc_occ = OccName -> OccName
mkClassDataConOcc OccName
cls_tc_occ
    is_newtype :: Bool
is_newtype = BranchIndex
n_sigs BranchIndex -> BranchIndex -> BranchIndex
forall a. Num a => a -> a -> a
+ BranchIndex
n_ctxt BranchIndex -> BranchIndex -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -- Sigh (keep this synced with buildClass)

ifaceDeclImplicitBndrs _ = []

ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
ifaceConDeclImplicitBndrs (IfCon {
        ifConWrapper :: IfaceConDecl -> Bool
ifConWrapper = Bool
has_wrapper, ifConName :: IfaceConDecl -> IfaceTopBndr
ifConName = IfaceTopBndr
con_name })
  = [IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
con_name, OccName
work_occ] [OccName] -> [OccName] -> [OccName]
forall a. [a] -> [a] -> [a]
++ [OccName]
wrap_occs
  where
    con_occ :: OccName
con_occ = IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
con_name
    work_occ :: OccName
work_occ  = OccName -> OccName
mkDataConWorkerOcc OccName
con_occ                   -- Id namespace
    wrap_occs :: [OccName]
wrap_occs | Bool
has_wrapper = [OccName -> OccName
mkDataConWrapperOcc OccName
con_occ]  -- Id namespace
              | Bool
otherwise   = []

-- -----------------------------------------------------------------------------
-- The fingerprints of an IfaceDecl

       -- We better give each name bound by the declaration a
       -- different fingerprint!  So we calculate the fingerprint of
       -- each binder by combining the fingerprint of the whole
       -- declaration with the name of the binder. (#5614, #7215)
ifaceDeclFingerprints :: Fingerprint -> IfaceDecl -> [(OccName,Fingerprint)]
ifaceDeclFingerprints :: Fingerprint -> IfaceDecl -> [(OccName, Fingerprint)]
ifaceDeclFingerprints hash :: Fingerprint
hash decl :: IfaceDecl
decl
  = (IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName IfaceDecl
decl, Fingerprint
hash) (OccName, Fingerprint)
-> [(OccName, Fingerprint)] -> [(OccName, Fingerprint)]
forall a. a -> [a] -> [a]
:
    [ (OccName
occ, (Fingerprint, OccName) -> Fingerprint
computeFingerprint' (Fingerprint
hash,OccName
occ))
    | OccName
occ <- IfaceDecl -> [OccName]
ifaceDeclImplicitBndrs IfaceDecl
decl ]
  where
     computeFingerprint' :: (Fingerprint, OccName) -> Fingerprint
computeFingerprint' =
       IO Fingerprint -> Fingerprint
forall a. IO a -> a
unsafeDupablePerformIO
        (IO Fingerprint -> Fingerprint)
-> ((Fingerprint, OccName) -> IO Fingerprint)
-> (Fingerprint, OccName)
-> Fingerprint
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (BinHandle -> IfaceTopBndr -> IO ())
-> (Fingerprint, OccName) -> IO Fingerprint
forall a.
Binary a =>
(BinHandle -> IfaceTopBndr -> IO ()) -> a -> IO Fingerprint
computeFingerprint (String -> BinHandle -> IfaceTopBndr -> IO ()
forall a. String -> a
panic "ifaceDeclFingerprints")

{-
************************************************************************
*                                                                      *
                Expressions
*                                                                      *
************************************************************************
-}

data IfaceExpr
  = IfaceLcl    IfLclName
  | IfaceExt    IfExtName
  | IfaceType   IfaceType
  | IfaceCo     IfaceCoercion
  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
  | IfaceLam    IfaceLamBndr IfaceExpr
  | IfaceApp    IfaceExpr IfaceExpr
  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
  | IfaceLet    IfaceBinding  IfaceExpr
  | IfaceCast   IfaceExpr IfaceCoercion
  | IfaceLit    Literal
  | IfaceFCall  ForeignCall IfaceType
  | IfaceTick   IfaceTickish IfaceExpr    -- from Tick tickish E

data IfaceTickish
  = IfaceHpcTick Module Int                -- from HpcTick x
  | IfaceSCC     CostCentre Bool Bool      -- from ProfNote
  | IfaceSource  RealSrcSpan String        -- from SourceNote
  -- no breakpoints: we never export these into interface files

type IfaceAlt = (IfaceConAlt, [IfLclName], IfaceExpr)
        -- Note: IfLclName, not IfaceBndr (and same with the case binder)
        -- We reconstruct the kind/type of the thing from the context
        -- thus saving bulk in interface files

data IfaceConAlt = IfaceDefault
                 | IfaceDataAlt IfExtName
                 | IfaceLitAlt Literal

data IfaceBinding
  = IfaceNonRec IfaceLetBndr IfaceExpr
  | IfaceRec    [(IfaceLetBndr, IfaceExpr)]

-- IfaceLetBndr is like IfaceIdBndr, but has IdInfo too
-- It's used for *non-top-level* let/rec binders
-- See Note [IdInfo on nested let-bindings]
data IfaceLetBndr = IfLetBndr IfLclName IfaceType IfaceIdInfo IfaceJoinInfo

data IfaceJoinInfo = IfaceNotJoinPoint
                   | IfaceJoinPoint JoinArity

{-
Note [Empty case alternatives]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In IfaceSyn an IfaceCase does not record the types of the alternatives,
unlike CorSyn Case.  But we need this type if the alternatives are empty.
Hence IfaceECase.  See Note [Empty case alternatives] in CoreSyn.

Note [Expose recursive functions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For supercompilation we want to put *all* unfoldings in the interface
file, even for functions that are recursive (or big).  So we need to
know when an unfolding belongs to a loop-breaker so that we can refrain
from inlining it (except during supercompilation).

Note [IdInfo on nested let-bindings]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Occasionally we want to preserve IdInfo on nested let bindings. The one
that came up was a NOINLINE pragma on a let-binding inside an INLINE
function.  The user (Duncan Coutts) really wanted the NOINLINE control
to cross the separate compilation boundary.

In general we retain all info that is left by CoreTidy.tidyLetBndr, since
that is what is seen by importing module with --make


************************************************************************
*                                                                      *
              Printing IfaceDecl
*                                                                      *
************************************************************************
-}

pprAxBranch :: SDoc -> IfaceAxBranch -> SDoc
-- The TyCon might be local (just an OccName), or this might
-- be a branch for an imported TyCon, so it would be an ExtName
-- So it's easier to take an SDoc here
--
-- This function is used
--    to print interface files,
--    in debug messages
--    in :info F for GHCi, which goes via toConToIfaceDecl on the family tycon
-- For user error messages we use Coercion.pprCoAxiom and friends
pprAxBranch :: SDoc -> IfaceAxBranch -> SDoc
pprAxBranch pp_tc :: SDoc
pp_tc (IfaceAxBranch { ifaxbTyVars :: IfaceAxBranch -> [IfaceTvBndr]
ifaxbTyVars = [IfaceTvBndr]
tvs
                                 , ifaxbCoVars :: IfaceAxBranch -> [IfaceTvBndr]
ifaxbCoVars = [IfaceTvBndr]
_cvs
                                 , ifaxbLHS :: IfaceAxBranch -> IfaceAppArgs
ifaxbLHS = IfaceAppArgs
pat_tys
                                 , ifaxbRHS :: IfaceAxBranch -> IfaceType
ifaxbRHS = IfaceType
rhs
                                 , ifaxbIncomps :: IfaceAxBranch -> [BranchIndex]
ifaxbIncomps = [BranchIndex]
incomps })
  = WARN( not (null _cvs), pp_tc $$ ppr _cvs )
    SDoc -> BranchIndex -> SDoc -> SDoc
hang SDoc
ppr_binders 2 (SDoc -> BranchIndex -> SDoc -> SDoc
hang SDoc
pp_lhs 2 (SDoc
equals SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
rhs))
    SDoc -> SDoc -> SDoc
$+$
    BranchIndex -> SDoc -> SDoc
nest 2 SDoc
maybe_incomps
  where
    -- See Note [Printing foralls in type family instances] in IfaceType
    ppr_binders :: SDoc
ppr_binders = [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll ([IfaceForAllBndr] -> SDoc) -> [IfaceForAllBndr] -> SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceTvBndr -> IfaceForAllBndr)
-> [IfaceTvBndr] -> [IfaceForAllBndr]
forall a b. (a -> b) -> [a] -> [b]
map (ArgFlag -> IfaceTvBndr -> IfaceForAllBndr
mkIfaceForAllTvBndr ArgFlag
Specified) [IfaceTvBndr]
tvs
    pp_lhs :: SDoc
pp_lhs = SDoc -> BranchIndex -> SDoc -> SDoc
hang SDoc
pp_tc 2 (IfaceAppArgs -> SDoc
pprParendIfaceAppArgs IfaceAppArgs
pat_tys)
    maybe_incomps :: SDoc
maybe_incomps = Bool -> SDoc -> SDoc
ppUnless ([BranchIndex] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [BranchIndex]
incomps) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
parens (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                    String -> SDoc
text "incompatible indices:" SDoc -> SDoc -> SDoc
<+> [BranchIndex] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [BranchIndex]
incomps

instance Outputable IfaceAnnotation where
  ppr :: IfaceAnnotation -> SDoc
ppr (IfaceAnnotation target :: IfaceAnnTarget
target value :: AnnPayload
value) = IfaceAnnTarget -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceAnnTarget
target SDoc -> SDoc -> SDoc
<+> SDoc
colon SDoc -> SDoc -> SDoc
<+> AnnPayload -> SDoc
forall a. Outputable a => a -> SDoc
ppr AnnPayload
value

instance NamedThing IfaceClassOp where
  getName :: IfaceClassOp -> IfaceTopBndr
getName (IfaceClassOp n :: IfaceTopBndr
n _ _) = IfaceTopBndr
n

instance HasOccName IfaceClassOp where
  occName :: IfaceClassOp -> OccName
occName = IfaceClassOp -> OccName
forall a. NamedThing a => a -> OccName
getOccName

instance NamedThing IfaceConDecl where
  getName :: IfaceConDecl -> IfaceTopBndr
getName = IfaceConDecl -> IfaceTopBndr
ifConName

instance HasOccName IfaceConDecl where
  occName :: IfaceConDecl -> OccName
occName = IfaceConDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName

instance NamedThing IfaceDecl where
  getName :: IfaceDecl -> IfaceTopBndr
getName = IfaceDecl -> IfaceTopBndr
ifName

instance HasOccName IfaceDecl where
  occName :: IfaceDecl -> OccName
occName = IfaceDecl -> OccName
forall a. NamedThing a => a -> OccName
getOccName

instance Outputable IfaceDecl where
  ppr :: IfaceDecl -> SDoc
ppr = ShowSub -> IfaceDecl -> SDoc
pprIfaceDecl ShowSub
showToIface

{-
Note [Minimal complete definition] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The minimal complete definition should only be included if a complete
class definition is shown. Since the minimal complete definition is
anonymous we can't reuse the same mechanism that is used for the
filtering of method signatures. Instead we just check if anything at all is
filtered and hide it in that case.
-}

data ShowSub
  = ShowSub
      { ShowSub -> ShowHowMuch
ss_how_much :: ShowHowMuch
      , ShowSub -> ShowForAllFlag
ss_forall :: ShowForAllFlag }

-- See Note [Printing IfaceDecl binders]
-- The alternative pretty printer referred to in the note.
newtype AltPpr = AltPpr (Maybe (OccName -> SDoc))

data ShowHowMuch
  = ShowHeader AltPpr -- ^Header information only, not rhs
  | ShowSome [OccName] AltPpr
  -- ^ Show only some sub-components. Specifically,
  --
  -- [@[]@] Print all sub-components.
  -- [@(n:ns)@] Print sub-component @n@ with @ShowSub = ns@;
  -- elide other sub-components to @...@
  -- May 14: the list is max 1 element long at the moment
  | ShowIface
  -- ^Everything including GHC-internal information (used in --show-iface)

{-
Note [Printing IfaceDecl binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The binders in an IfaceDecl are just OccNames, so we don't know what module they
come from.  But when we pretty-print a TyThing by converting to an IfaceDecl
(see PprTyThing), the TyThing may come from some other module so we really need
the module qualifier.  We solve this by passing in a pretty-printer for the
binders.

When printing an interface file (--show-iface), we want to print
everything unqualified, so we can just print the OccName directly.
-}

instance Outputable ShowHowMuch where
  ppr :: ShowHowMuch -> SDoc
ppr (ShowHeader _)    = String -> SDoc
text "ShowHeader"
  ppr ShowIface         = String -> SDoc
text "ShowIface"
  ppr (ShowSome occs :: [OccName]
occs _) = String -> SDoc
text "ShowSome" SDoc -> SDoc -> SDoc
<+> [OccName] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [OccName]
occs

showToHeader :: ShowSub
showToHeader :: ShowSub
showToHeader = ShowSub :: ShowHowMuch -> ShowForAllFlag -> ShowSub
ShowSub { ss_how_much :: ShowHowMuch
ss_how_much = AltPpr -> ShowHowMuch
ShowHeader (AltPpr -> ShowHowMuch) -> AltPpr -> ShowHowMuch
forall a b. (a -> b) -> a -> b
$ Maybe (OccName -> SDoc) -> AltPpr
AltPpr Maybe (OccName -> SDoc)
forall a. Maybe a
Nothing
                       , ss_forall :: ShowForAllFlag
ss_forall = ShowForAllFlag
ShowForAllWhen }

showToIface :: ShowSub
showToIface :: ShowSub
showToIface = ShowSub :: ShowHowMuch -> ShowForAllFlag -> ShowSub
ShowSub { ss_how_much :: ShowHowMuch
ss_how_much = ShowHowMuch
ShowIface
                      , ss_forall :: ShowForAllFlag
ss_forall = ShowForAllFlag
ShowForAllWhen }

ppShowIface :: ShowSub -> SDoc -> SDoc
ppShowIface :: ShowSub -> SDoc -> SDoc
ppShowIface (ShowSub { ss_how_much :: ShowSub -> ShowHowMuch
ss_how_much = ShowHowMuch
ShowIface }) doc :: SDoc
doc = SDoc
doc
ppShowIface _                                     _   = SDoc
Outputable.empty

-- show if all sub-components or the complete interface is shown
ppShowAllSubs :: ShowSub -> SDoc -> SDoc -- Note [Minimal complete definition]
ppShowAllSubs :: ShowSub -> SDoc -> SDoc
ppShowAllSubs (ShowSub { ss_how_much :: ShowSub -> ShowHowMuch
ss_how_much = ShowSome [] _ }) doc :: SDoc
doc = SDoc
doc
ppShowAllSubs (ShowSub { ss_how_much :: ShowSub -> ShowHowMuch
ss_how_much = ShowHowMuch
ShowIface })     doc :: SDoc
doc = SDoc
doc
ppShowAllSubs _                                         _   = SDoc
Outputable.empty

ppShowRhs :: ShowSub -> SDoc -> SDoc
ppShowRhs :: ShowSub -> SDoc -> SDoc
ppShowRhs (ShowSub { ss_how_much :: ShowSub -> ShowHowMuch
ss_how_much = ShowHeader _ }) _   = SDoc
Outputable.empty
ppShowRhs _                                        doc :: SDoc
doc = SDoc
doc

showSub :: HasOccName n => ShowSub -> n -> Bool
showSub :: ShowSub -> n -> Bool
showSub (ShowSub { ss_how_much :: ShowSub -> ShowHowMuch
ss_how_much = ShowHeader _ })     _     = Bool
False
showSub (ShowSub { ss_how_much :: ShowSub -> ShowHowMuch
ss_how_much = ShowSome (n :: OccName
n:_) _ }) thing :: n
thing = OccName
n OccName -> OccName -> Bool
forall a. Eq a => a -> a -> Bool
== n -> OccName
forall name. HasOccName name => name -> OccName
occName n
thing
showSub (ShowSub { ss_how_much :: ShowSub -> ShowHowMuch
ss_how_much = ShowHowMuch
_ })              _     = Bool
True

ppr_trim :: [Maybe SDoc] -> [SDoc]
-- Collapse a group of Nothings to a single "..."
ppr_trim :: [Maybe SDoc] -> [SDoc]
ppr_trim xs :: [Maybe SDoc]
xs
  = (Bool, [SDoc]) -> [SDoc]
forall a b. (a, b) -> b
snd ((Maybe SDoc -> (Bool, [SDoc]) -> (Bool, [SDoc]))
-> (Bool, [SDoc]) -> [Maybe SDoc] -> (Bool, [SDoc])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Maybe SDoc -> (Bool, [SDoc]) -> (Bool, [SDoc])
go (Bool
False, []) [Maybe SDoc]
xs)
  where
    go :: Maybe SDoc -> (Bool, [SDoc]) -> (Bool, [SDoc])
go (Just doc :: SDoc
doc) (_,     so_far :: [SDoc]
so_far) = (Bool
False, SDoc
doc SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc]
so_far)
    go Nothing    (True,  so_far :: [SDoc]
so_far) = (Bool
True, [SDoc]
so_far)
    go Nothing    (False, so_far :: [SDoc]
so_far) = (Bool
True, String -> SDoc
text "..." SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc]
so_far)

isIfaceDataInstance :: IfaceTyConParent -> Bool
isIfaceDataInstance :: IfaceTyConParent -> Bool
isIfaceDataInstance IfNoParent = Bool
False
isIfaceDataInstance _          = Bool
True

pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
pprClassRoles :: ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
pprClassRoles ss :: ShowSub
ss clas :: IfaceTopBndr
clas binders :: [IfaceTyConBinder]
binders roles :: [Role]
roles =
    (Role -> Bool) -> SDoc -> [IfaceTyConBinder] -> [Role] -> SDoc
pprRoles (Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
Nominal)
             (ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr (ShowSub -> ShowHowMuch
ss_how_much ShowSub
ss) (IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
clas))
             [IfaceTyConBinder]
binders
             [Role]
roles

pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
pprIfaceDecl ss :: ShowSub
ss (IfaceData { ifName :: IfaceDecl -> IfaceTopBndr
ifName = IfaceTopBndr
tycon, ifCType :: IfaceDecl -> Maybe CType
ifCType = Maybe CType
ctype,
                             ifCtxt :: IfaceDecl -> IfaceContext
ifCtxt = IfaceContext
context, ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
kind,
                             ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles, ifCons :: IfaceDecl -> IfaceConDecls
ifCons = IfaceConDecls
condecls,
                             ifParent :: IfaceDecl -> IfaceTyConParent
ifParent = IfaceTyConParent
parent,
                             ifGadtSyntax :: IfaceDecl -> Bool
ifGadtSyntax = Bool
gadt,
                             ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders })

  | Bool
gadt      = [SDoc] -> SDoc
vcat [ SDoc
pp_roles
                     , SDoc
pp_nd SDoc -> SDoc -> SDoc
<+> SDoc
pp_lhs SDoc -> SDoc -> SDoc
<+> SDoc
pp_kind SDoc -> SDoc -> SDoc
<+> SDoc
pp_where
                     , BranchIndex -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
vcat [SDoc]
pp_cons)
                     , BranchIndex -> SDoc -> SDoc
nest 2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ ShowSub -> SDoc -> SDoc
ppShowIface ShowSub
ss SDoc
pp_extra ]
  | Bool
otherwise = [SDoc] -> SDoc
vcat [ SDoc
pp_roles
                     , SDoc -> BranchIndex -> SDoc -> SDoc
hang (SDoc
pp_nd SDoc -> SDoc -> SDoc
<+> SDoc
pp_lhs SDoc -> SDoc -> SDoc
<+> SDoc
pp_kind) 2 ([SDoc] -> SDoc
add_bars [SDoc]
pp_cons)
                     , BranchIndex -> SDoc -> SDoc
nest 2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ ShowSub -> SDoc -> SDoc
ppShowIface ShowSub
ss SDoc
pp_extra ]
  where
    is_data_instance :: Bool
is_data_instance = IfaceTyConParent -> Bool
isIfaceDataInstance IfaceTyConParent
parent
    -- See Note [Printing foralls in type family instances] in IfaceType
    pp_data_inst_forall :: SDoc
    pp_data_inst_forall :: SDoc
pp_data_inst_forall = [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
forall_bndrs

    forall_bndrs :: [IfaceForAllBndr]
    forall_bndrs :: [IfaceForAllBndr]
forall_bndrs = [IfaceBndr -> ArgFlag -> IfaceForAllBndr
forall var argf. var -> argf -> VarBndr var argf
Bndr (IfaceTyConBinder -> IfaceBndr
forall tv argf. VarBndr tv argf -> tv
binderVar IfaceTyConBinder
tc_bndr) ArgFlag
Specified | IfaceTyConBinder
tc_bndr <- [IfaceTyConBinder]
binders]

    cons :: [IfaceConDecl]
cons       = IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls IfaceConDecls
condecls
    pp_where :: SDoc
pp_where   = Bool -> SDoc -> SDoc
ppWhen (Bool
gadt Bool -> Bool -> Bool
&& Bool -> Bool
not ([IfaceConDecl] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IfaceConDecl]
cons)) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ String -> SDoc
text "where"
    pp_cons :: [SDoc]
pp_cons    = [Maybe SDoc] -> [SDoc]
ppr_trim ((IfaceConDecl -> Maybe SDoc) -> [IfaceConDecl] -> [Maybe SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceConDecl -> Maybe SDoc
show_con [IfaceConDecl]
cons) :: [SDoc]
    pp_kind :: SDoc
pp_kind
      | IfaceType -> Bool
isIfaceLiftedTypeKind IfaceType
kind = SDoc
empty
      | Bool
otherwise = SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
kind

    pp_lhs :: SDoc
pp_lhs = case IfaceTyConParent
parent of
               IfNoParent -> IfaceContext
-> ShowSub
-> IfaceTopBndr
-> [IfaceTyConBinder]
-> Maybe IfaceType
-> SDoc
pprIfaceDeclHead IfaceContext
context ShowSub
ss IfaceTopBndr
tycon [IfaceTyConBinder]
binders Maybe IfaceType
forall a. Maybe a
Nothing
               IfDataInstance{}
                          -> String -> SDoc
text "instance" SDoc -> SDoc -> SDoc
<+> SDoc
pp_data_inst_forall
                                             SDoc -> SDoc -> SDoc
<+> IfaceTyConParent -> SDoc
pprIfaceTyConParent IfaceTyConParent
parent

    pp_roles :: SDoc
pp_roles
      | Bool
is_data_instance = SDoc
empty
      | Bool
otherwise        = (Role -> Bool) -> SDoc -> [IfaceTyConBinder] -> [Role] -> SDoc
pprRoles (Role -> Role -> Bool
forall a. Eq a => a -> a -> Bool
== Role
Representational)
                                    (ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr
                                        (ShowSub -> ShowHowMuch
ss_how_much ShowSub
ss)
                                        (IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
tycon))
                                    [IfaceTyConBinder]
binders [Role]
roles
            -- Don't display roles for data family instances (yet)
            -- See discussion on Trac #8672.

    add_bars :: [SDoc] -> SDoc
add_bars []     = SDoc
Outputable.empty
    add_bars (c :: SDoc
c:cs :: [SDoc]
cs) = [SDoc] -> SDoc
sep ((SDoc
equals SDoc -> SDoc -> SDoc
<+> SDoc
c) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc
vbar SDoc -> SDoc -> SDoc
<+>) [SDoc]
cs)

    ok_con :: IfaceConDecl -> Bool
ok_con dc :: IfaceConDecl
dc = ShowSub -> IfaceConDecl -> Bool
forall n. HasOccName n => ShowSub -> n -> Bool
showSub ShowSub
ss IfaceConDecl
dc Bool -> Bool -> Bool
|| (FieldLabel -> Bool) -> [FieldLabel] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ShowSub -> IfaceTopBndr -> Bool
forall n. HasOccName n => ShowSub -> n -> Bool
showSub ShowSub
ss (IfaceTopBndr -> Bool)
-> (FieldLabel -> IfaceTopBndr) -> FieldLabel -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FieldLabel -> IfaceTopBndr
forall a. FieldLbl a -> a
flSelector) (IfaceConDecl -> [FieldLabel]
ifConFields IfaceConDecl
dc)

    show_con :: IfaceConDecl -> Maybe SDoc
show_con dc :: IfaceConDecl
dc
      | IfaceConDecl -> Bool
ok_con IfaceConDecl
dc = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ ShowSub
-> Bool
-> IfaceTopBndr
-> [IfaceTyConBinder]
-> IfaceTyConParent
-> IfaceConDecl
-> SDoc
pprIfaceConDecl ShowSub
ss Bool
gadt IfaceTopBndr
tycon [IfaceTyConBinder]
binders IfaceTyConParent
parent IfaceConDecl
dc
      | Bool
otherwise = Maybe SDoc
forall a. Maybe a
Nothing

    pp_nd :: SDoc
pp_nd = case IfaceConDecls
condecls of
              IfAbstractTyCon{} -> String -> SDoc
text "data"
              IfDataTyCon{}     -> String -> SDoc
text "data"
              IfNewTyCon{}      -> String -> SDoc
text "newtype"

    pp_extra :: SDoc
pp_extra = [SDoc] -> SDoc
vcat [Maybe CType -> SDoc
pprCType Maybe CType
ctype]

pprIfaceDecl ss :: ShowSub
ss (IfaceClass { ifName :: IfaceDecl -> IfaceTopBndr
ifName  = IfaceTopBndr
clas
                            , ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles
                            , ifFDs :: IfaceDecl -> [FunDep IfLclName]
ifFDs    = [FunDep IfLclName]
fds
                            , ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders
                            , ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfaceClassBody
IfAbstractClass })
  = [SDoc] -> SDoc
vcat [ ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
pprClassRoles ShowSub
ss IfaceTopBndr
clas [IfaceTyConBinder]
binders [Role]
roles
         , String -> SDoc
text "class" SDoc -> SDoc -> SDoc
<+> IfaceContext
-> ShowSub
-> IfaceTopBndr
-> [IfaceTyConBinder]
-> Maybe IfaceType
-> SDoc
pprIfaceDeclHead [] ShowSub
ss IfaceTopBndr
clas [IfaceTyConBinder]
binders Maybe IfaceType
forall a. Maybe a
Nothing
                                SDoc -> SDoc -> SDoc
<+> [FunDep IfLclName] -> SDoc
forall a. Outputable a => [FunDep a] -> SDoc
pprFundeps [FunDep IfLclName]
fds ]

pprIfaceDecl ss :: ShowSub
ss (IfaceClass { ifName :: IfaceDecl -> IfaceTopBndr
ifName  = IfaceTopBndr
clas
                            , ifRoles :: IfaceDecl -> [Role]
ifRoles = [Role]
roles
                            , ifFDs :: IfaceDecl -> [FunDep IfLclName]
ifFDs    = [FunDep IfLclName]
fds
                            , ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders
                            , ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfConcreteClass {
                                ifATs :: IfaceClassBody -> [IfaceAT]
ifATs = [IfaceAT]
ats,
                                ifSigs :: IfaceClassBody -> [IfaceClassOp]
ifSigs = [IfaceClassOp]
sigs,
                                ifClassCtxt :: IfaceClassBody -> IfaceContext
ifClassCtxt = IfaceContext
context,
                                ifMinDef :: IfaceClassBody -> BooleanFormula IfLclName
ifMinDef = BooleanFormula IfLclName
minDef
                              }})
  = [SDoc] -> SDoc
vcat [ ShowSub -> IfaceTopBndr -> [IfaceTyConBinder] -> [Role] -> SDoc
pprClassRoles ShowSub
ss IfaceTopBndr
clas [IfaceTyConBinder]
binders [Role]
roles
         , String -> SDoc
text "class" SDoc -> SDoc -> SDoc
<+> IfaceContext
-> ShowSub
-> IfaceTopBndr
-> [IfaceTyConBinder]
-> Maybe IfaceType
-> SDoc
pprIfaceDeclHead IfaceContext
context ShowSub
ss IfaceTopBndr
clas [IfaceTyConBinder]
binders Maybe IfaceType
forall a. Maybe a
Nothing
                                SDoc -> SDoc -> SDoc
<+> [FunDep IfLclName] -> SDoc
forall a. Outputable a => [FunDep a] -> SDoc
pprFundeps [FunDep IfLclName]
fds SDoc -> SDoc -> SDoc
<+> SDoc
pp_where
         , BranchIndex -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
vcat [ [SDoc] -> SDoc
vcat [SDoc]
asocs, [SDoc] -> SDoc
vcat [SDoc]
dsigs
                        , ShowSub -> SDoc -> SDoc
ppShowAllSubs ShowSub
ss (BooleanFormula IfLclName -> SDoc
pprMinDef BooleanFormula IfLclName
minDef)])]
    where
      pp_where :: SDoc
pp_where = ShowSub -> SDoc -> SDoc
ppShowRhs ShowSub
ss (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Bool -> SDoc -> SDoc
ppUnless ([IfaceClassOp] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IfaceClassOp]
sigs Bool -> Bool -> Bool
&& [IfaceAT] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IfaceAT]
ats) (String -> SDoc
text "where")

      asocs :: [SDoc]
asocs = [Maybe SDoc] -> [SDoc]
ppr_trim ([Maybe SDoc] -> [SDoc]) -> [Maybe SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (IfaceAT -> Maybe SDoc) -> [IfaceAT] -> [Maybe SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceAT -> Maybe SDoc
maybeShowAssoc [IfaceAT]
ats
      dsigs :: [SDoc]
dsigs = [Maybe SDoc] -> [SDoc]
ppr_trim ([Maybe SDoc] -> [SDoc]) -> [Maybe SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ (IfaceClassOp -> Maybe SDoc) -> [IfaceClassOp] -> [Maybe SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceClassOp -> Maybe SDoc
maybeShowSig [IfaceClassOp]
sigs

      maybeShowAssoc :: IfaceAT -> Maybe SDoc
      maybeShowAssoc :: IfaceAT -> Maybe SDoc
maybeShowAssoc asc :: IfaceAT
asc@(IfaceAT d :: IfaceDecl
d _)
        | ShowSub -> IfaceDecl -> Bool
forall n. HasOccName n => ShowSub -> n -> Bool
showSub ShowSub
ss IfaceDecl
d = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$ ShowSub -> IfaceAT -> SDoc
pprIfaceAT ShowSub
ss IfaceAT
asc
        | Bool
otherwise    = Maybe SDoc
forall a. Maybe a
Nothing

      maybeShowSig :: IfaceClassOp -> Maybe SDoc
      maybeShowSig :: IfaceClassOp -> Maybe SDoc
maybeShowSig sg :: IfaceClassOp
sg
        | ShowSub -> IfaceClassOp -> Bool
forall n. HasOccName n => ShowSub -> n -> Bool
showSub ShowSub
ss IfaceClassOp
sg = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
forall a b. (a -> b) -> a -> b
$  ShowSub -> IfaceClassOp -> SDoc
pprIfaceClassOp ShowSub
ss IfaceClassOp
sg
        | Bool
otherwise     = Maybe SDoc
forall a. Maybe a
Nothing

      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef :: BooleanFormula IfLclName -> SDoc
pprMinDef minDef :: BooleanFormula IfLclName
minDef = Bool -> SDoc -> SDoc
ppUnless (BooleanFormula IfLclName -> Bool
forall a. BooleanFormula a -> Bool
isTrue BooleanFormula IfLclName
minDef) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ -- hide empty definitions
        String -> SDoc
text "{-# MINIMAL" SDoc -> SDoc -> SDoc
<+>
        (Rational -> IfLclName -> SDoc)
-> Rational -> BooleanFormula IfLclName -> SDoc
forall a.
(Rational -> a -> SDoc) -> Rational -> BooleanFormula a -> SDoc
pprBooleanFormula
          (\_ def :: IfLclName
def -> Bool -> SDoc -> SDoc
cparen (IfLclName -> Bool
isLexSym IfLclName
def) (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
def)) 0 BooleanFormula IfLclName
minDef SDoc -> SDoc -> SDoc
<+>
        String -> SDoc
text "#-}"

pprIfaceDecl ss :: ShowSub
ss (IfaceSynonym { ifName :: IfaceDecl -> IfaceTopBndr
ifName    = IfaceTopBndr
tc
                              , ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders
                              , ifSynRhs :: IfaceDecl -> IfaceType
ifSynRhs  = IfaceType
mono_ty
                              , ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_kind})
  = SDoc -> BranchIndex -> SDoc -> SDoc
hang (String -> SDoc
text "type" SDoc -> SDoc -> SDoc
<+> IfaceContext
-> ShowSub
-> IfaceTopBndr
-> [IfaceTyConBinder]
-> Maybe IfaceType
-> SDoc
pprIfaceDeclHead [] ShowSub
ss IfaceTopBndr
tc [IfaceTyConBinder]
binders Maybe IfaceType
forall a. Maybe a
Nothing SDoc -> SDoc -> SDoc
<+> SDoc
equals)
       2 ([SDoc] -> SDoc
sep [ [IfaceForAllBndr] -> SDoc
pprIfaceForAll [IfaceForAllBndr]
tvs, IfaceContext -> SDoc
pprIfaceContextArr IfaceContext
theta, IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
tau
              , Bool -> SDoc -> SDoc
ppUnless (IfaceType -> Bool
isIfaceLiftedTypeKind IfaceType
res_kind) (SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
res_kind) ])
  where
    (tvs :: [IfaceForAllBndr]
tvs, theta :: IfaceContext
theta, tau :: IfaceType
tau) = IfaceType -> ([IfaceForAllBndr], IfaceContext, IfaceType)
splitIfaceSigmaTy IfaceType
mono_ty

pprIfaceDecl ss :: ShowSub
ss (IfaceFamily { ifName :: IfaceDecl -> IfaceTopBndr
ifName = IfaceTopBndr
tycon
                             , ifFamFlav :: IfaceDecl -> IfaceFamTyConFlav
ifFamFlav = IfaceFamTyConFlav
rhs, ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
binders
                             , ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_kind
                             , ifResVar :: IfaceDecl -> Maybe IfLclName
ifResVar = Maybe IfLclName
res_var, ifFamInj :: IfaceDecl -> Injectivity
ifFamInj = Injectivity
inj })
  | IfaceFamTyConFlav
IfaceDataFamilyTyCon <- IfaceFamTyConFlav
rhs
  = String -> SDoc
text "data family" SDoc -> SDoc -> SDoc
<+> IfaceContext
-> ShowSub
-> IfaceTopBndr
-> [IfaceTyConBinder]
-> Maybe IfaceType
-> SDoc
pprIfaceDeclHead [] ShowSub
ss IfaceTopBndr
tycon [IfaceTyConBinder]
binders Maybe IfaceType
forall a. Maybe a
Nothing

  | Bool
otherwise
  = SDoc -> BranchIndex -> SDoc -> SDoc
hang (String -> SDoc
text "type family"
            SDoc -> SDoc -> SDoc
<+> IfaceContext
-> ShowSub
-> IfaceTopBndr
-> [IfaceTyConBinder]
-> Maybe IfaceType
-> SDoc
pprIfaceDeclHead [] ShowSub
ss IfaceTopBndr
tycon [IfaceTyConBinder]
binders (IfaceType -> Maybe IfaceType
forall a. a -> Maybe a
Just IfaceType
res_kind)
            SDoc -> SDoc -> SDoc
<+> ShowSub -> SDoc -> SDoc
ppShowRhs ShowSub
ss (IfaceFamTyConFlav -> SDoc
pp_where IfaceFamTyConFlav
rhs))
       2 (Maybe IfLclName -> Injectivity -> SDoc
forall a. Outputable a => Maybe a -> Injectivity -> SDoc
pp_inj Maybe IfLclName
res_var Injectivity
inj SDoc -> SDoc -> SDoc
<+> ShowSub -> SDoc -> SDoc
ppShowRhs ShowSub
ss (IfaceFamTyConFlav -> SDoc
pp_rhs IfaceFamTyConFlav
rhs))
    SDoc -> SDoc -> SDoc
$$
    BranchIndex -> SDoc -> SDoc
nest 2 (ShowSub -> SDoc -> SDoc
ppShowRhs ShowSub
ss (IfaceFamTyConFlav -> SDoc
pp_branches IfaceFamTyConFlav
rhs))
  where
    pp_where :: IfaceFamTyConFlav -> SDoc
pp_where (IfaceClosedSynFamilyTyCon {}) = String -> SDoc
text "where"
    pp_where _                              = SDoc
empty

    pp_inj :: Maybe a -> Injectivity -> SDoc
pp_inj Nothing    _   = SDoc
empty
    pp_inj (Just res :: a
res) inj :: Injectivity
inj
       | Injective injectivity :: [Bool]
injectivity <- Injectivity
inj = [SDoc] -> SDoc
hsep [ SDoc
equals, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
res
                                             , a -> [Bool] -> SDoc
forall a. Outputable a => a -> [Bool] -> SDoc
pp_inj_cond a
res [Bool]
injectivity]
       | Bool
otherwise = [SDoc] -> SDoc
hsep [ SDoc
equals, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
res ]

    pp_inj_cond :: a -> [Bool] -> SDoc
pp_inj_cond res :: a
res inj :: [Bool]
inj = case [Bool] -> [IfaceTyConBinder] -> [IfaceTyConBinder]
forall a. [Bool] -> [a] -> [a]
filterByList [Bool]
inj [IfaceTyConBinder]
binders of
       []  -> SDoc
empty
       tvs :: [IfaceTyConBinder]
tvs -> [SDoc] -> SDoc
hsep [SDoc
vbar, a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
res, String -> SDoc
text "->", [IfLclName] -> SDoc
forall a. Outputable a => [a] -> SDoc
interppSP ((IfaceTyConBinder -> IfLclName)
-> [IfaceTyConBinder] -> [IfLclName]
forall a b. (a -> b) -> [a] -> [b]
map IfaceTyConBinder -> IfLclName
ifTyConBinderName [IfaceTyConBinder]
tvs)]

    pp_rhs :: IfaceFamTyConFlav -> SDoc
pp_rhs IfaceDataFamilyTyCon
      = ShowSub -> SDoc -> SDoc
ppShowIface ShowSub
ss (String -> SDoc
text "data")
    pp_rhs IfaceOpenSynFamilyTyCon
      = ShowSub -> SDoc -> SDoc
ppShowIface ShowSub
ss (String -> SDoc
text "open")
    pp_rhs IfaceAbstractClosedSynFamilyTyCon
      = ShowSub -> SDoc -> SDoc
ppShowIface ShowSub
ss (String -> SDoc
text "closed, abstract")
    pp_rhs (IfaceClosedSynFamilyTyCon {})
      = SDoc
empty  -- see pp_branches
    pp_rhs IfaceBuiltInSynFamTyCon
      = ShowSub -> SDoc -> SDoc
ppShowIface ShowSub
ss (String -> SDoc
text "built-in")

    pp_branches :: IfaceFamTyConFlav -> SDoc
pp_branches (IfaceClosedSynFamilyTyCon (Just (ax :: IfaceTopBndr
ax, brs :: [IfaceAxBranch]
brs)))
      = [SDoc] -> SDoc
vcat ((IfaceAxBranch -> SDoc) -> [IfaceAxBranch] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> IfaceAxBranch -> SDoc
pprAxBranch
                     (ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr
                       (ShowSub -> ShowHowMuch
ss_how_much ShowSub
ss)
                       (IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
tycon))
                  ) [IfaceAxBranch]
brs)
        SDoc -> SDoc -> SDoc
$$ ShowSub -> SDoc -> SDoc
ppShowIface ShowSub
ss (String -> SDoc
text "axiom" SDoc -> SDoc -> SDoc
<+> IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
ax)
    pp_branches _ = SDoc
Outputable.empty

pprIfaceDecl _ (IfacePatSyn { ifName :: IfaceDecl -> IfaceTopBndr
ifName = IfaceTopBndr
name,
                              ifPatUnivBndrs :: IfaceDecl -> [IfaceForAllBndr]
ifPatUnivBndrs = [IfaceForAllBndr]
univ_bndrs, ifPatExBndrs :: IfaceDecl -> [IfaceForAllBndr]
ifPatExBndrs = [IfaceForAllBndr]
ex_bndrs,
                              ifPatProvCtxt :: IfaceDecl -> IfaceContext
ifPatProvCtxt = IfaceContext
prov_ctxt, ifPatReqCtxt :: IfaceDecl -> IfaceContext
ifPatReqCtxt = IfaceContext
req_ctxt,
                              ifPatArgs :: IfaceDecl -> IfaceContext
ifPatArgs = IfaceContext
arg_tys,
                              ifPatTy :: IfaceDecl -> IfaceType
ifPatTy = IfaceType
pat_ty} )
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags DynFlags -> SDoc
mk_msg
  where
    mk_msg :: DynFlags -> SDoc
mk_msg dflags :: DynFlags
dflags
      = SDoc -> BranchIndex -> SDoc -> SDoc
hang (String -> SDoc
text "pattern" SDoc -> SDoc -> SDoc
<+> IfaceTopBndr -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IfaceTopBndr
name)
           2 (SDoc
dcolon SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep [SDoc
univ_msg
                             , IfaceContext -> SDoc
pprIfaceContextArr IfaceContext
req_ctxt
                             , Bool -> SDoc -> SDoc
ppWhen Bool
insert_empty_ctxt (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
parens SDoc
empty SDoc -> SDoc -> SDoc
<+> SDoc
darrow
                             , SDoc
ex_msg
                             , IfaceContext -> SDoc
pprIfaceContextArr IfaceContext
prov_ctxt
                             , IfaceType -> SDoc
pprIfaceType (IfaceType -> SDoc) -> IfaceType -> SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceType -> IfaceType -> IfaceType)
-> IfaceType -> IfaceContext -> IfaceType
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr IfaceType -> IfaceType -> IfaceType
IfaceFunTy IfaceType
pat_ty IfaceContext
arg_tys ])
      where
        univ_msg :: SDoc
univ_msg = [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
univ_bndrs
        ex_msg :: SDoc
ex_msg   = [IfaceForAllBndr] -> SDoc
pprUserIfaceForAll [IfaceForAllBndr]
ex_bndrs

        insert_empty_ctxt :: Bool
insert_empty_ctxt = IfaceContext -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null IfaceContext
req_ctxt
            Bool -> Bool -> Bool
&& Bool -> Bool
not (IfaceContext -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null IfaceContext
prov_ctxt Bool -> Bool -> Bool
&& DynFlags -> SDoc -> Bool
isEmpty DynFlags
dflags SDoc
ex_msg)

pprIfaceDecl ss :: ShowSub
ss (IfaceId { ifName :: IfaceDecl -> IfaceTopBndr
ifName = IfaceTopBndr
var, ifType :: IfaceDecl -> IfaceType
ifType = IfaceType
ty,
                              ifIdDetails :: IfaceDecl -> IfaceIdDetails
ifIdDetails = IfaceIdDetails
details, ifIdInfo :: IfaceDecl -> IfaceIdInfo
ifIdInfo = IfaceIdInfo
info })
  = [SDoc] -> SDoc
vcat [ SDoc -> BranchIndex -> SDoc -> SDoc
hang (ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr (ShowSub -> ShowHowMuch
ss_how_much ShowSub
ss) (IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
var) SDoc -> SDoc -> SDoc
<+> SDoc
dcolon)
              2 (ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType (ShowSub -> ShowForAllFlag
ss_forall ShowSub
ss) IfaceType
ty)
         , ShowSub -> SDoc -> SDoc
ppShowIface ShowSub
ss (IfaceIdDetails -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceIdDetails
details)
         , ShowSub -> SDoc -> SDoc
ppShowIface ShowSub
ss (IfaceIdInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceIdInfo
info) ]

pprIfaceDecl _ (IfaceAxiom { ifName :: IfaceDecl -> IfaceTopBndr
ifName = IfaceTopBndr
name, ifTyCon :: IfaceDecl -> IfaceTyCon
ifTyCon = IfaceTyCon
tycon
                           , ifAxBranches :: IfaceDecl -> [IfaceAxBranch]
ifAxBranches = [IfaceAxBranch]
branches })
  = SDoc -> BranchIndex -> SDoc -> SDoc
hang (String -> SDoc
text "axiom" SDoc -> SDoc -> SDoc
<+> IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
name SDoc -> SDoc -> SDoc
<+> SDoc
dcolon)
       2 ([SDoc] -> SDoc
vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ (IfaceAxBranch -> SDoc) -> [IfaceAxBranch] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc -> IfaceAxBranch -> SDoc
pprAxBranch (IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tycon)) [IfaceAxBranch]
branches)

pprCType :: Maybe CType -> SDoc
pprCType :: Maybe CType -> SDoc
pprCType Nothing      = SDoc
Outputable.empty
pprCType (Just cType :: CType
cType) = String -> SDoc
text "C type:" SDoc -> SDoc -> SDoc
<+> CType -> SDoc
forall a. Outputable a => a -> SDoc
ppr CType
cType

-- if, for each role, suppress_if role is True, then suppress the role
-- output
pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTyConBinder]
         -> [Role] -> SDoc
pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTyConBinder] -> [Role] -> SDoc
pprRoles suppress_if :: Role -> Bool
suppress_if tyCon :: SDoc
tyCon bndrs :: [IfaceTyConBinder]
bndrs roles :: [Role]
roles
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \dflags :: DynFlags
dflags ->
      let froles :: [Role]
froles = DynFlags -> [IfaceTyConBinder] -> [Role] -> [Role]
forall a. DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles DynFlags
dflags [IfaceTyConBinder]
bndrs [Role]
roles
      in Bool -> SDoc -> SDoc
ppUnless ((Role -> Bool) -> [Role] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Role -> Bool
suppress_if [Role]
froles Bool -> Bool -> Bool
|| [Role] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Role]
froles) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
         String -> SDoc
text "type role" SDoc -> SDoc -> SDoc
<+> SDoc
tyCon SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep ((Role -> SDoc) -> [Role] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Role -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Role]
froles)

pprInfixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
pprInfixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
pprInfixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr :: OccName -> SDoc
ppr_bndr))) name :: OccName
name
  = Bool -> SDoc -> SDoc
pprInfixVar (OccName -> Bool
isSymOcc OccName
name) (OccName -> SDoc
ppr_bndr OccName
name)
pprInfixIfDeclBndr _ name :: OccName
name
  = Bool -> SDoc -> SDoc
pprInfixVar (OccName -> Bool
isSymOcc OccName
name) (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name)

pprPrefixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr :: ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr (ShowHeader (AltPpr (Just ppr_bndr :: OccName -> SDoc
ppr_bndr))) name :: OccName
name
  = OccName -> SDoc -> SDoc
parenSymOcc OccName
name (OccName -> SDoc
ppr_bndr OccName
name)
pprPrefixIfDeclBndr (ShowSome _ (AltPpr (Just ppr_bndr :: OccName -> SDoc
ppr_bndr))) name :: OccName
name
  = OccName -> SDoc -> SDoc
parenSymOcc OccName
name (OccName -> SDoc
ppr_bndr OccName
name)
pprPrefixIfDeclBndr _ name :: OccName
name
  = OccName -> SDoc -> SDoc
parenSymOcc OccName
name (OccName -> SDoc
forall a. Outputable a => a -> SDoc
ppr OccName
name)

instance Outputable IfaceClassOp where
   ppr :: IfaceClassOp -> SDoc
ppr = ShowSub -> IfaceClassOp -> SDoc
pprIfaceClassOp ShowSub
showToIface

pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
pprIfaceClassOp ss :: ShowSub
ss (IfaceClassOp n :: IfaceTopBndr
n ty :: IfaceType
ty dm :: Maybe (DefMethSpec IfaceType)
dm)
  = IfaceTopBndr -> IfaceType -> SDoc
forall name. HasOccName name => name -> IfaceType -> SDoc
pp_sig IfaceTopBndr
n IfaceType
ty SDoc -> SDoc -> SDoc
$$ SDoc
generic_dm
  where
   generic_dm :: SDoc
generic_dm | Just (GenericDM dm_ty :: IfaceType
dm_ty) <- Maybe (DefMethSpec IfaceType)
dm
              =  String -> SDoc
text "default" SDoc -> SDoc -> SDoc
<+> IfaceTopBndr -> IfaceType -> SDoc
forall name. HasOccName name => name -> IfaceType -> SDoc
pp_sig IfaceTopBndr
n IfaceType
dm_ty
              | Bool
otherwise
              = SDoc
empty
   pp_sig :: name -> IfaceType -> SDoc
pp_sig n :: name
n ty :: IfaceType
ty
     = ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr (ShowSub -> ShowHowMuch
ss_how_much ShowSub
ss) (name -> OccName
forall name. HasOccName name => name -> OccName
occName name
n)
     SDoc -> SDoc -> SDoc
<+> SDoc
dcolon
     SDoc -> SDoc -> SDoc
<+> ShowForAllFlag -> IfaceType -> SDoc
pprIfaceSigmaType ShowForAllFlag
ShowForAllWhen IfaceType
ty

instance Outputable IfaceAT where
   ppr :: IfaceAT -> SDoc
ppr = ShowSub -> IfaceAT -> SDoc
pprIfaceAT ShowSub
showToIface

pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
pprIfaceAT ss :: ShowSub
ss (IfaceAT d :: IfaceDecl
d mb_def :: Maybe IfaceType
mb_def)
  = [SDoc] -> SDoc
vcat [ ShowSub -> IfaceDecl -> SDoc
pprIfaceDecl ShowSub
ss IfaceDecl
d
         , case Maybe IfaceType
mb_def of
              Nothing  -> SDoc
Outputable.empty
              Just rhs :: IfaceType
rhs -> BranchIndex -> SDoc -> SDoc
nest 2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$
                          String -> SDoc
text "Default:" SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
rhs ]

instance Outputable IfaceTyConParent where
  ppr :: IfaceTyConParent -> SDoc
ppr p :: IfaceTyConParent
p = IfaceTyConParent -> SDoc
pprIfaceTyConParent IfaceTyConParent
p

pprIfaceTyConParent :: IfaceTyConParent -> SDoc
pprIfaceTyConParent :: IfaceTyConParent -> SDoc
pprIfaceTyConParent IfNoParent
  = SDoc
Outputable.empty
pprIfaceTyConParent (IfDataInstance _ tc :: IfaceTyCon
tc tys :: IfaceAppArgs
tys)
  = PprPrec -> IfaceTyCon -> IfaceAppArgs -> SDoc
pprIfaceTypeApp PprPrec
topPrec IfaceTyCon
tc IfaceAppArgs
tys

pprIfaceDeclHead :: IfaceContext -> ShowSub -> Name
                 -> [IfaceTyConBinder]   -- of the tycon, for invisible-suppression
                 -> Maybe IfaceKind
                 -> SDoc
pprIfaceDeclHead :: IfaceContext
-> ShowSub
-> IfaceTopBndr
-> [IfaceTyConBinder]
-> Maybe IfaceType
-> SDoc
pprIfaceDeclHead context :: IfaceContext
context ss :: ShowSub
ss tc_occ :: IfaceTopBndr
tc_occ bndrs :: [IfaceTyConBinder]
bndrs m_res_kind :: Maybe IfaceType
m_res_kind
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ dflags :: DynFlags
dflags ->
    [SDoc] -> SDoc
sep [ IfaceContext -> SDoc
pprIfaceContextArr IfaceContext
context
        , ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr (ShowSub -> ShowHowMuch
ss_how_much ShowSub
ss) (IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
tc_occ)
          SDoc -> SDoc -> SDoc
<+> [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders (DynFlags
-> [IfaceTyConBinder] -> [IfaceTyConBinder] -> [IfaceTyConBinder]
forall a. DynFlags -> [IfaceTyConBinder] -> [a] -> [a]
suppressIfaceInvisibles DynFlags
dflags [IfaceTyConBinder]
bndrs [IfaceTyConBinder]
bndrs)
        , SDoc -> (IfaceType -> SDoc) -> Maybe IfaceType -> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
empty (\res_kind :: IfaceType
res_kind -> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
pprIfaceType IfaceType
res_kind) Maybe IfaceType
m_res_kind ]

pprIfaceConDecl :: ShowSub -> Bool
                -> IfaceTopBndr
                -> [IfaceTyConBinder]
                -> IfaceTyConParent
                -> IfaceConDecl -> SDoc
pprIfaceConDecl :: ShowSub
-> Bool
-> IfaceTopBndr
-> [IfaceTyConBinder]
-> IfaceTyConParent
-> IfaceConDecl
-> SDoc
pprIfaceConDecl ss :: ShowSub
ss gadt_style :: Bool
gadt_style tycon :: IfaceTopBndr
tycon tc_binders :: [IfaceTyConBinder]
tc_binders parent :: IfaceTyConParent
parent
        (IfCon { ifConName :: IfaceConDecl -> IfaceTopBndr
ifConName = IfaceTopBndr
name, ifConInfix :: IfaceConDecl -> Bool
ifConInfix = Bool
is_infix,
                 ifConUserTvBinders :: IfaceConDecl -> [IfaceForAllBndr]
ifConUserTvBinders = [IfaceForAllBndr]
user_tvbs,
                 ifConEqSpec :: IfaceConDecl -> [IfaceTvBndr]
ifConEqSpec = [IfaceTvBndr]
eq_spec, ifConCtxt :: IfaceConDecl -> IfaceContext
ifConCtxt = IfaceContext
ctxt, ifConArgTys :: IfaceConDecl -> IfaceContext
ifConArgTys = IfaceContext
arg_tys,
                 ifConStricts :: IfaceConDecl -> [IfaceBang]
ifConStricts = [IfaceBang]
stricts, ifConFields :: IfaceConDecl -> [FieldLabel]
ifConFields = [FieldLabel]
fields })
  | Bool
gadt_style = SDoc
pp_prefix_con SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> SDoc
ppr_gadt_ty
  | Bool
otherwise  = SDoc -> SDoc
ppr_ex_quant SDoc
pp_h98_con
  where
    pp_h98_con :: SDoc
pp_h98_con
      | Bool -> Bool
not ([FieldLabel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldLabel]
fields) = SDoc
pp_prefix_con SDoc -> SDoc -> SDoc
<+> SDoc
pp_field_args
      | Bool
is_infix
      , [ty1 :: SDoc
ty1, ty2 :: SDoc
ty2] <- [SDoc]
pp_args
      = [SDoc] -> SDoc
sep [ SDoc
ty1
            , ShowHowMuch -> OccName -> SDoc
pprInfixIfDeclBndr ShowHowMuch
how_much (IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
name)
            , SDoc
ty2]
      | Bool
otherwise = SDoc
pp_prefix_con SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep [SDoc]
pp_args

    how_much :: ShowHowMuch
how_much = ShowSub -> ShowHowMuch
ss_how_much ShowSub
ss
    tys_w_strs :: [(IfaceBang, IfaceType)]
    tys_w_strs :: [(IfaceBang, IfaceType)]
tys_w_strs = [IfaceBang] -> IfaceContext -> [(IfaceBang, IfaceType)]
forall a b. [a] -> [b] -> [(a, b)]
zip [IfaceBang]
stricts IfaceContext
arg_tys
    pp_prefix_con :: SDoc
pp_prefix_con = ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr ShowHowMuch
how_much (IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
name)

    -- If we're pretty-printing a H98-style declaration with existential
    -- quantification, then user_tvbs will always consist of the universal
    -- tyvar binders followed by the existential tyvar binders. So to recover
    -- the visibilities of the existential tyvar binders, we can simply drop
    -- the universal tyvar binders from user_tvbs.
    ex_tvbs :: [IfaceForAllBndr]
ex_tvbs = [IfaceTyConBinder] -> [IfaceForAllBndr] -> [IfaceForAllBndr]
forall b a. [b] -> [a] -> [a]
dropList [IfaceTyConBinder]
tc_binders [IfaceForAllBndr]
user_tvbs
    ppr_ex_quant :: SDoc -> SDoc
ppr_ex_quant = [IfaceForAllBndr] -> IfaceContext -> SDoc -> SDoc
pprIfaceForAllPartMust [IfaceForAllBndr]
ex_tvbs IfaceContext
ctxt
    pp_gadt_res_ty :: SDoc
pp_gadt_res_ty = [IfaceTvBndr] -> SDoc
mk_user_con_res_ty [IfaceTvBndr]
eq_spec
    ppr_gadt_ty :: SDoc
ppr_gadt_ty = [IfaceForAllBndr] -> IfaceContext -> SDoc -> SDoc
pprIfaceForAllPart [IfaceForAllBndr]
user_tvbs IfaceContext
ctxt SDoc
pp_tau

        -- A bit gruesome this, but we can't form the full con_tau, and ppr it,
        -- because we don't have a Name for the tycon, only an OccName
    pp_tau :: SDoc
pp_tau | [FieldLabel] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FieldLabel]
fields
           = case [SDoc]
pp_args [SDoc] -> [SDoc] -> [SDoc]
forall a. [a] -> [a] -> [a]
++ [SDoc
pp_gadt_res_ty] of
                (t :: SDoc
t:ts :: [SDoc]
ts) -> [SDoc] -> SDoc
fsep (SDoc
t SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (SDoc -> SDoc) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SDoc
arrow SDoc -> SDoc -> SDoc
<+>) [SDoc]
ts)
                []     -> String -> SDoc
forall a. String -> a
panic "pp_con_taus"
           | Bool
otherwise
           = [SDoc] -> SDoc
sep [SDoc
pp_field_args, SDoc
arrow SDoc -> SDoc -> SDoc
<+> SDoc
pp_gadt_res_ty]

    ppr_bang :: IfaceBang -> SDoc
ppr_bang IfNoBang = SDoc -> SDoc
whenPprDebug (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ Char -> SDoc
char '_'
    ppr_bang IfStrict = Char -> SDoc
char '!'
    ppr_bang IfUnpack = String -> SDoc
text "{-# UNPACK #-}"
    ppr_bang (IfUnpackCo co :: IfaceCoercion
co) = String -> SDoc
text "! {-# UNPACK #-}" SDoc -> SDoc -> SDoc
<>
                               IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co

    pprFieldArgTy, pprArgTy :: (IfaceBang, IfaceType) -> SDoc
    -- If using record syntax, the only reason one would need to parenthesize
    -- a compound field type is if it's preceded by a bang pattern.
    pprFieldArgTy :: (IfaceBang, IfaceType) -> SDoc
pprFieldArgTy (bang :: IfaceBang
bang, ty :: IfaceType
ty) = PprPrec -> IfaceBang -> IfaceType -> SDoc
ppr_arg_ty (IfaceBang -> PprPrec
bang_prec IfaceBang
bang) IfaceBang
bang IfaceType
ty
    -- If not using record syntax, a compound field type might need to be
    -- parenthesized if one of the following holds:
    --
    -- 1. We're using Haskell98 syntax.
    -- 2. The field type is preceded with a bang pattern.
    pprArgTy :: (IfaceBang, IfaceType) -> SDoc
pprArgTy (bang :: IfaceBang
bang, ty :: IfaceType
ty) = PprPrec -> IfaceBang -> IfaceType -> SDoc
ppr_arg_ty (PprPrec -> PprPrec -> PprPrec
forall a. Ord a => a -> a -> a
max PprPrec
gadt_prec (IfaceBang -> PprPrec
bang_prec IfaceBang
bang)) IfaceBang
bang IfaceType
ty

    ppr_arg_ty :: PprPrec -> IfaceBang -> IfaceType -> SDoc
    ppr_arg_ty :: PprPrec -> IfaceBang -> IfaceType -> SDoc
ppr_arg_ty prec :: PprPrec
prec bang :: IfaceBang
bang ty :: IfaceType
ty = IfaceBang -> SDoc
ppr_bang IfaceBang
bang SDoc -> SDoc -> SDoc
<> PprPrec -> IfaceType -> SDoc
pprPrecIfaceType PprPrec
prec IfaceType
ty

    -- If we're displaying the fields GADT-style, e.g.,
    --
    --   data Foo a where
    --     MkFoo :: (Int -> Int) -> Maybe a -> Foo
    --
    -- Then we use `funPrec`, since that will ensure `Int -> Int` gets the
    -- parentheses that it requires, but simple compound types like `Maybe a`
    -- (which don't require parentheses in a function argument position) won't
    -- get them, assuming that there are no bang patterns (see bang_prec).
    --
    -- If we're displaying the fields Haskell98-style, e.g.,
    --
    --   data Foo a = MkFoo (Int -> Int) (Maybe a)
    --
    -- Then not only must we parenthesize `Int -> Int`, we must also
    -- parenthesize compound fields like (Maybe a). Therefore, we pick
    -- `appPrec`, which has higher precedence than `funPrec`.
    gadt_prec :: PprPrec
    gadt_prec :: PprPrec
gadt_prec
      | Bool
gadt_style = PprPrec
funPrec
      | Bool
otherwise  = PprPrec
appPrec

    -- The presence of bang patterns or UNPACK annotations requires
    -- surrounding the type with parentheses, if needed (#13699)
    bang_prec :: IfaceBang -> PprPrec
    bang_prec :: IfaceBang -> PprPrec
bang_prec IfNoBang     = PprPrec
topPrec
    bang_prec IfStrict     = PprPrec
appPrec
    bang_prec IfUnpack     = PprPrec
appPrec
    bang_prec IfUnpackCo{} = PprPrec
appPrec

    pp_args :: [SDoc] -- No records, e.g., `  Maybe a  ->  Int -> ...` or
                      --                   `!(Maybe a) -> !Int -> ...`
    pp_args :: [SDoc]
pp_args = ((IfaceBang, IfaceType) -> SDoc)
-> [(IfaceBang, IfaceType)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (IfaceBang, IfaceType) -> SDoc
pprArgTy [(IfaceBang, IfaceType)]
tys_w_strs

    pp_field_args :: SDoc -- Records, e.g., { x ::   Maybe a,  y ::  Int } or
                          --                { x :: !(Maybe a), y :: !Int }
    pp_field_args :: SDoc
pp_field_args = SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
sep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ([SDoc] -> [SDoc]) -> [SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$ [Maybe SDoc] -> [SDoc]
ppr_trim ([Maybe SDoc] -> [SDoc]) -> [Maybe SDoc] -> [SDoc]
forall a b. (a -> b) -> a -> b
$
                    (FieldLabel -> (IfaceBang, IfaceType) -> Maybe SDoc)
-> [FieldLabel] -> [(IfaceBang, IfaceType)] -> [Maybe SDoc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith FieldLabel -> (IfaceBang, IfaceType) -> Maybe SDoc
maybe_show_label [FieldLabel]
fields [(IfaceBang, IfaceType)]
tys_w_strs

    maybe_show_label :: FieldLabel -> (IfaceBang, IfaceType) -> Maybe SDoc
    maybe_show_label :: FieldLabel -> (IfaceBang, IfaceType) -> Maybe SDoc
maybe_show_label lbl :: FieldLabel
lbl bty :: (IfaceBang, IfaceType)
bty
      | ShowSub -> IfaceTopBndr -> Bool
forall n. HasOccName n => ShowSub -> n -> Bool
showSub ShowSub
ss IfaceTopBndr
sel = SDoc -> Maybe SDoc
forall a. a -> Maybe a
Just (ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr ShowHowMuch
how_much OccName
occ
                                SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> (IfaceBang, IfaceType) -> SDoc
pprFieldArgTy (IfaceBang, IfaceType)
bty)
      | Bool
otherwise      = Maybe SDoc
forall a. Maybe a
Nothing
      where
        sel :: IfaceTopBndr
sel = FieldLabel -> IfaceTopBndr
forall a. FieldLbl a -> a
flSelector FieldLabel
lbl
        occ :: OccName
occ = IfLclName -> OccName
mkVarOccFS (FieldLabel -> IfLclName
forall a. FieldLbl a -> IfLclName
flLabel FieldLabel
lbl)

    mk_user_con_res_ty :: IfaceEqSpec -> SDoc
    -- See Note [Result type of a data family GADT]
    mk_user_con_res_ty :: [IfaceTvBndr] -> SDoc
mk_user_con_res_ty eq_spec :: [IfaceTvBndr]
eq_spec
      | IfDataInstance _ tc :: IfaceTyCon
tc tys :: IfaceAppArgs
tys <- IfaceTyConParent
parent
      = IfaceType -> SDoc
pprIfaceType (IfaceTyCon -> IfaceAppArgs -> IfaceType
IfaceTyConApp IfaceTyCon
tc (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
gadt_subst IfaceAppArgs
tys))
      | Bool
otherwise
      = IfaceTySubst -> SDoc
ppr_tc_app IfaceTySubst
gadt_subst
      where
        gadt_subst :: IfaceTySubst
gadt_subst = [IfaceTvBndr] -> IfaceTySubst
mkIfaceTySubst [IfaceTvBndr]
eq_spec

    -- When pretty-printing a GADT return type, we:
    --
    -- 1. Take the data tycon binders, extract their variable names and
    --    visibilities, and construct suitable arguments from them. (This is
    --    the role of mk_tc_app_args.)
    -- 2. Apply the GADT substitution constructed from the eq_spec.
    --    (See Note [Result type of a data family GADT].)
    -- 3. Pretty-print the data type constructor applied to its arguments.
    --    This process will omit any invisible arguments, such as coercion
    --    variables, if necessary. (See Note
    --    [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.)
    ppr_tc_app :: IfaceTySubst -> SDoc
ppr_tc_app gadt_subst :: IfaceTySubst
gadt_subst =
      ShowHowMuch -> OccName -> SDoc
pprPrefixIfDeclBndr ShowHowMuch
how_much (IfaceTopBndr -> OccName
forall name. HasOccName name => name -> OccName
occName IfaceTopBndr
tycon)
      SDoc -> SDoc -> SDoc
<+> IfaceAppArgs -> SDoc
pprIfaceAppArgs
            (IfaceTySubst -> IfaceAppArgs -> IfaceAppArgs
substIfaceAppArgs IfaceTySubst
gadt_subst ([IfaceTyConBinder] -> IfaceAppArgs
mk_tc_app_args [IfaceTyConBinder]
tc_binders))

    mk_tc_app_args :: [IfaceTyConBinder] -> IfaceAppArgs
    mk_tc_app_args :: [IfaceTyConBinder] -> IfaceAppArgs
mk_tc_app_args [] = IfaceAppArgs
IA_Nil
    mk_tc_app_args (Bndr bndr :: IfaceBndr
bndr vis :: TyConBndrVis
vis:tc_bndrs :: [IfaceTyConBinder]
tc_bndrs) =
      IfaceType -> ArgFlag -> IfaceAppArgs -> IfaceAppArgs
IA_Arg (IfLclName -> IfaceType
IfaceTyVar (IfaceBndr -> IfLclName
ifaceBndrName IfaceBndr
bndr)) (TyConBndrVis -> ArgFlag
tyConBndrVisArgFlag TyConBndrVis
vis)
             ([IfaceTyConBinder] -> IfaceAppArgs
mk_tc_app_args [IfaceTyConBinder]
tc_bndrs)

instance Outputable IfaceRule where
  ppr :: IfaceRule -> SDoc
ppr (IfaceRule { ifRuleName :: IfaceRule -> IfLclName
ifRuleName = IfLclName
name, ifActivation :: IfaceRule -> Activation
ifActivation = Activation
act, ifRuleBndrs :: IfaceRule -> [IfaceBndr]
ifRuleBndrs = [IfaceBndr]
bndrs,
                   ifRuleHead :: IfaceRule -> IfaceTopBndr
ifRuleHead = IfaceTopBndr
fn, ifRuleArgs :: IfaceRule -> [IfaceExpr]
ifRuleArgs = [IfaceExpr]
args, ifRuleRhs :: IfaceRule -> IfaceExpr
ifRuleRhs = IfaceExpr
rhs,
                   ifRuleOrph :: IfaceRule -> IsOrphan
ifRuleOrph = IsOrphan
orph })
    = [SDoc] -> SDoc
sep [ [SDoc] -> SDoc
hsep [ IfLclName -> SDoc
pprRuleName IfLclName
name
                 , if IsOrphan -> Bool
isOrphan IsOrphan
orph then String -> SDoc
text "[orphan]" else SDoc
Outputable.empty
                 , Activation -> SDoc
forall a. Outputable a => a -> SDoc
ppr Activation
act
                 , SDoc
pp_foralls ]
          , BranchIndex -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
sep [IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
fn SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep ((IfaceExpr -> SDoc) -> [IfaceExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceExpr -> SDoc
pprParendIfaceExpr [IfaceExpr]
args),
                        String -> SDoc
text "=" SDoc -> SDoc -> SDoc
<+> IfaceExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceExpr
rhs]) ]
    where
      pp_foralls :: SDoc
pp_foralls = Bool -> SDoc -> SDoc
ppUnless ([IfaceBndr] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [IfaceBndr]
bndrs) (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
forAllLit SDoc -> SDoc -> SDoc
<+> [IfaceBndr] -> SDoc
pprIfaceBndrs [IfaceBndr]
bndrs SDoc -> SDoc -> SDoc
<> SDoc
dot

instance Outputable IfaceClsInst where
  ppr :: IfaceClsInst -> SDoc
ppr (IfaceClsInst { ifDFun :: IfaceClsInst -> IfaceTopBndr
ifDFun = IfaceTopBndr
dfun_id, ifOFlag :: IfaceClsInst -> OverlapFlag
ifOFlag = OverlapFlag
flag
                    , ifInstCls :: IfaceClsInst -> IfaceTopBndr
ifInstCls = IfaceTopBndr
cls, ifInstTys :: IfaceClsInst -> [Maybe IfaceTyCon]
ifInstTys = [Maybe IfaceTyCon]
mb_tcs
                    , ifInstOrph :: IfaceClsInst -> IsOrphan
ifInstOrph = IsOrphan
orph })
    = SDoc -> BranchIndex -> SDoc -> SDoc
hang (String -> SDoc
text "instance" SDoc -> SDoc -> SDoc
<+> OverlapFlag -> SDoc
forall a. Outputable a => a -> SDoc
ppr OverlapFlag
flag
              SDoc -> SDoc -> SDoc
<+> (if IsOrphan -> Bool
isOrphan IsOrphan
orph then String -> SDoc
text "[orphan]" else SDoc
Outputable.empty)
              SDoc -> SDoc -> SDoc
<+> IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
cls SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
brackets ((Maybe IfaceTyCon -> SDoc) -> [Maybe IfaceTyCon] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas Maybe IfaceTyCon -> SDoc
ppr_rough [Maybe IfaceTyCon]
mb_tcs))
         2 (SDoc
equals SDoc -> SDoc -> SDoc
<+> IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
dfun_id)

instance Outputable IfaceFamInst where
  ppr :: IfaceFamInst -> SDoc
ppr (IfaceFamInst { ifFamInstFam :: IfaceFamInst -> IfaceTopBndr
ifFamInstFam = IfaceTopBndr
fam, ifFamInstTys :: IfaceFamInst -> [Maybe IfaceTyCon]
ifFamInstTys = [Maybe IfaceTyCon]
mb_tcs
                    , ifFamInstAxiom :: IfaceFamInst -> IfaceTopBndr
ifFamInstAxiom = IfaceTopBndr
tycon_ax, ifFamInstOrph :: IfaceFamInst -> IsOrphan
ifFamInstOrph = IsOrphan
orph })
    = SDoc -> BranchIndex -> SDoc -> SDoc
hang (String -> SDoc
text "family instance"
              SDoc -> SDoc -> SDoc
<+> (if IsOrphan -> Bool
isOrphan IsOrphan
orph then String -> SDoc
text "[orphan]" else SDoc
Outputable.empty)
              SDoc -> SDoc -> SDoc
<+> IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
fam SDoc -> SDoc -> SDoc
<+> (Maybe IfaceTyCon -> SDoc) -> [Maybe IfaceTyCon] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas (SDoc -> SDoc
brackets (SDoc -> SDoc)
-> (Maybe IfaceTyCon -> SDoc) -> Maybe IfaceTyCon -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe IfaceTyCon -> SDoc
ppr_rough) [Maybe IfaceTyCon]
mb_tcs)
         2 (SDoc
equals SDoc -> SDoc -> SDoc
<+> IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
tycon_ax)

ppr_rough :: Maybe IfaceTyCon -> SDoc
ppr_rough :: Maybe IfaceTyCon -> SDoc
ppr_rough Nothing   = SDoc
dot
ppr_rough (Just tc :: IfaceTyCon
tc) = IfaceTyCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTyCon
tc

{-
Note [Result type of a data family GADT]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
   data family T a
   data instance T (p,q) where
      T1 :: T (Int, Maybe c)
      T2 :: T (Bool, q)

The IfaceDecl actually looks like

   data TPr p q where
      T1 :: forall p q. forall c. (p~Int,q~Maybe c) => TPr p q
      T2 :: forall p q. (p~Bool) => TPr p q

To reconstruct the result types for T1 and T2 that we
want to pretty print, we substitute the eq-spec
[p->Int, q->Maybe c] in the arg pattern (p,q) to give
   T (Int, Maybe c)
Remember that in IfaceSyn, the TyCon and DataCon share the same
universal type variables.

----------------------------- Printing IfaceExpr ------------------------------------
-}

instance Outputable IfaceExpr where
    ppr :: IfaceExpr -> SDoc
ppr e :: IfaceExpr
e = (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
e

noParens :: SDoc -> SDoc
noParens :: SDoc -> SDoc
noParens pp :: SDoc
pp = SDoc
pp

pprParendIfaceExpr :: IfaceExpr -> SDoc
pprParendIfaceExpr :: IfaceExpr -> SDoc
pprParendIfaceExpr = (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
parens

-- | Pretty Print an IfaceExpre
--
-- The first argument should be a function that adds parens in context that need
-- an atomic value (e.g. function args)
pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc

pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr _       (IfaceLcl v :: IfLclName
v)       = IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
v
pprIfaceExpr _       (IfaceExt v :: IfaceTopBndr
v)       = IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
v
pprIfaceExpr _       (IfaceLit l :: Literal
l)       = Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l
pprIfaceExpr _       (IfaceFCall cc :: ForeignCall
cc ty :: IfaceType
ty) = SDoc -> SDoc
braces (ForeignCall -> SDoc
forall a. Outputable a => a -> SDoc
ppr ForeignCall
cc SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty)
pprIfaceExpr _       (IfaceType ty :: IfaceType
ty)     = Char -> SDoc
char '@' SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
pprParendIfaceType IfaceType
ty
pprIfaceExpr _       (IfaceCo co :: IfaceCoercion
co)       = String -> SDoc
text "@~" SDoc -> SDoc -> SDoc
<+> IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co

pprIfaceExpr add_par :: SDoc -> SDoc
add_par app :: IfaceExpr
app@(IfaceApp _ _) = SDoc -> SDoc
add_par (IfaceExpr -> [SDoc] -> SDoc
pprIfaceApp IfaceExpr
app [])
pprIfaceExpr _       (IfaceTuple c :: TupleSort
c as :: [IfaceExpr]
as)  = TupleSort -> SDoc -> SDoc
tupleParens TupleSort
c ((IfaceExpr -> SDoc) -> [IfaceExpr] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceExpr]
as)

pprIfaceExpr add_par :: SDoc -> SDoc
add_par i :: IfaceExpr
i@(IfaceLam _ _)
  = SDoc -> SDoc
add_par ([SDoc] -> SDoc
sep [Char -> SDoc
char '\\' SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep ((IfaceLamBndr -> SDoc) -> [IfaceLamBndr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceLamBndr -> SDoc
pprIfaceLamBndr [IfaceLamBndr]
bndrs) SDoc -> SDoc -> SDoc
<+> SDoc
arrow,
                  (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
body])
  where
    (bndrs :: [IfaceLamBndr]
bndrs,body :: IfaceExpr
body) = [IfaceLamBndr] -> IfaceExpr -> ([IfaceLamBndr], IfaceExpr)
collect [] IfaceExpr
i
    collect :: [IfaceLamBndr] -> IfaceExpr -> ([IfaceLamBndr], IfaceExpr)
collect bs :: [IfaceLamBndr]
bs (IfaceLam b :: IfaceLamBndr
b e :: IfaceExpr
e) = [IfaceLamBndr] -> IfaceExpr -> ([IfaceLamBndr], IfaceExpr)
collect (IfaceLamBndr
bIfaceLamBndr -> [IfaceLamBndr] -> [IfaceLamBndr]
forall a. a -> [a] -> [a]
:[IfaceLamBndr]
bs) IfaceExpr
e
    collect bs :: [IfaceLamBndr]
bs e :: IfaceExpr
e              = ([IfaceLamBndr] -> [IfaceLamBndr]
forall a. [a] -> [a]
reverse [IfaceLamBndr]
bs, IfaceExpr
e)

pprIfaceExpr add_par :: SDoc -> SDoc
add_par (IfaceECase scrut :: IfaceExpr
scrut ty :: IfaceType
ty)
  = SDoc -> SDoc
add_par ([SDoc] -> SDoc
sep [ String -> SDoc
text "case" SDoc -> SDoc -> SDoc
<+> (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
scrut
                 , String -> SDoc
text "ret_ty" SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
pprParendIfaceType IfaceType
ty
                 , String -> SDoc
text "of {}" ])

pprIfaceExpr add_par :: SDoc -> SDoc
add_par (IfaceCase scrut :: IfaceExpr
scrut bndr :: IfLclName
bndr [(con :: IfaceConAlt
con, bs :: [IfLclName]
bs, rhs :: IfaceExpr
rhs)])
  = SDoc -> SDoc
add_par ([SDoc] -> SDoc
sep [String -> SDoc
text "case"
                        SDoc -> SDoc -> SDoc
<+> (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
scrut SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "of"
                        SDoc -> SDoc -> SDoc
<+> IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
bndr SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char '{' SDoc -> SDoc -> SDoc
<+> IfaceConAlt -> [IfLclName] -> SDoc
ppr_con_bs IfaceConAlt
con [IfLclName]
bs SDoc -> SDoc -> SDoc
<+> SDoc
arrow,
                  (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
rhs SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char '}'])

pprIfaceExpr add_par :: SDoc -> SDoc
add_par (IfaceCase scrut :: IfaceExpr
scrut bndr :: IfLclName
bndr alts :: [IfaceAlt]
alts)
  = SDoc -> SDoc
add_par ([SDoc] -> SDoc
sep [String -> SDoc
text "case"
                        SDoc -> SDoc -> SDoc
<+> (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
scrut SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "of"
                        SDoc -> SDoc -> SDoc
<+> IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
bndr SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char '{',
                  BranchIndex -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
sep ((IfaceAlt -> SDoc) -> [IfaceAlt] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceAlt -> SDoc
ppr_alt [IfaceAlt]
alts)) SDoc -> SDoc -> SDoc
<+> Char -> SDoc
char '}'])

pprIfaceExpr _       (IfaceCast expr :: IfaceExpr
expr co :: IfaceCoercion
co)
  = [SDoc] -> SDoc
sep [IfaceExpr -> SDoc
pprParendIfaceExpr IfaceExpr
expr,
         BranchIndex -> SDoc -> SDoc
nest 2 (String -> SDoc
text "`cast`"),
         IfaceCoercion -> SDoc
pprParendIfaceCoercion IfaceCoercion
co]

pprIfaceExpr add_par :: SDoc -> SDoc
add_par (IfaceLet (IfaceNonRec b :: IfaceLetBndr
b rhs :: IfaceExpr
rhs) body :: IfaceExpr
body)
  = SDoc -> SDoc
add_par ([SDoc] -> SDoc
sep [String -> SDoc
text "let {",
                  BranchIndex -> SDoc -> SDoc
nest 2 ((IfaceLetBndr, IfaceExpr) -> SDoc
ppr_bind (IfaceLetBndr
b, IfaceExpr
rhs)),
                  String -> SDoc
text "} in",
                  (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
body])

pprIfaceExpr add_par :: SDoc -> SDoc
add_par (IfaceLet (IfaceRec pairs :: [(IfaceLetBndr, IfaceExpr)]
pairs) body :: IfaceExpr
body)
  = SDoc -> SDoc
add_par ([SDoc] -> SDoc
sep [String -> SDoc
text "letrec {",
                  BranchIndex -> SDoc -> SDoc
nest 2 ([SDoc] -> SDoc
sep (((IfaceLetBndr, IfaceExpr) -> SDoc)
-> [(IfaceLetBndr, IfaceExpr)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (IfaceLetBndr, IfaceExpr) -> SDoc
ppr_bind [(IfaceLetBndr, IfaceExpr)]
pairs)),
                  String -> SDoc
text "} in",
                  (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
body])

pprIfaceExpr add_par :: SDoc -> SDoc
add_par (IfaceTick tickish :: IfaceTickish
tickish e :: IfaceExpr
e)
  = SDoc -> SDoc
add_par (IfaceTickish -> SDoc
pprIfaceTickish IfaceTickish
tickish SDoc -> SDoc -> SDoc
<+> (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
e)

ppr_alt :: (IfaceConAlt, [IfLclName], IfaceExpr) -> SDoc
ppr_alt :: IfaceAlt -> SDoc
ppr_alt (con :: IfaceConAlt
con, bs :: [IfLclName]
bs, rhs :: IfaceExpr
rhs) = [SDoc] -> SDoc
sep [IfaceConAlt -> [IfLclName] -> SDoc
ppr_con_bs IfaceConAlt
con [IfLclName]
bs,
                         SDoc
arrow SDoc -> SDoc -> SDoc
<+> (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
rhs]

ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
ppr_con_bs :: IfaceConAlt -> [IfLclName] -> SDoc
ppr_con_bs con :: IfaceConAlt
con bs :: [IfLclName]
bs = IfaceConAlt -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceConAlt
con SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
hsep ((IfLclName -> SDoc) -> [IfLclName] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfLclName]
bs)

ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
ppr_bind :: (IfaceLetBndr, IfaceExpr) -> SDoc
ppr_bind (IfLetBndr b :: IfLclName
b ty :: IfaceType
ty info :: IfaceIdInfo
info ji :: IfaceJoinInfo
ji, rhs :: IfaceExpr
rhs)
  = [SDoc] -> SDoc
sep [SDoc -> BranchIndex -> SDoc -> SDoc
hang (IfLclName -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfLclName
b SDoc -> SDoc -> SDoc
<+> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IfaceType -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceType
ty) 2 (IfaceJoinInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceJoinInfo
ji SDoc -> SDoc -> SDoc
<+> IfaceIdInfo -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceIdInfo
info),
         SDoc
equals SDoc -> SDoc -> SDoc
<+> (SDoc -> SDoc) -> IfaceExpr -> SDoc
pprIfaceExpr SDoc -> SDoc
noParens IfaceExpr
rhs]

------------------
pprIfaceTickish :: IfaceTickish -> SDoc
pprIfaceTickish :: IfaceTickish -> SDoc
pprIfaceTickish (IfaceHpcTick m :: Module
m ix :: BranchIndex
ix)
  = SDoc -> SDoc
braces (String -> SDoc
text "tick" SDoc -> SDoc -> SDoc
<+> Module -> SDoc
forall a. Outputable a => a -> SDoc
ppr Module
m SDoc -> SDoc -> SDoc
<+> BranchIndex -> SDoc
forall a. Outputable a => a -> SDoc
ppr BranchIndex
ix)
pprIfaceTickish (IfaceSCC cc :: CostCentre
cc tick :: Bool
tick scope :: Bool
scope)
  = SDoc -> SDoc
braces (CostCentre -> SDoc
pprCostCentreCore CostCentre
cc SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
tick SDoc -> SDoc -> SDoc
<+> Bool -> SDoc
forall a. Outputable a => a -> SDoc
ppr Bool
scope)
pprIfaceTickish (IfaceSource src :: RealSrcSpan
src _names :: String
_names)
  = SDoc -> SDoc
braces (Bool -> RealSrcSpan -> SDoc
pprUserRealSpan Bool
True RealSrcSpan
src)

------------------
pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
pprIfaceApp :: IfaceExpr -> [SDoc] -> SDoc
pprIfaceApp (IfaceApp fun :: IfaceExpr
fun arg :: IfaceExpr
arg) args :: [SDoc]
args = IfaceExpr -> [SDoc] -> SDoc
pprIfaceApp IfaceExpr
fun ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$
                                          BranchIndex -> SDoc -> SDoc
nest 2 (IfaceExpr -> SDoc
pprParendIfaceExpr IfaceExpr
arg) SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc]
args
pprIfaceApp fun :: IfaceExpr
fun                args :: [SDoc]
args = [SDoc] -> SDoc
sep (IfaceExpr -> SDoc
pprParendIfaceExpr IfaceExpr
fun SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: [SDoc]
args)

------------------
instance Outputable IfaceConAlt where
    ppr :: IfaceConAlt -> SDoc
ppr IfaceDefault      = String -> SDoc
text "DEFAULT"
    ppr (IfaceLitAlt l :: Literal
l)   = Literal -> SDoc
forall a. Outputable a => a -> SDoc
ppr Literal
l
    ppr (IfaceDataAlt d :: IfaceTopBndr
d)  = IfaceTopBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceTopBndr
d

------------------
instance Outputable IfaceIdDetails where
  ppr :: IfaceIdDetails -> SDoc
ppr IfVanillaId       = SDoc
Outputable.empty
  ppr (IfRecSelId tc :: Either IfaceTyCon IfaceDecl
tc b :: Bool
b) = String -> SDoc
text "RecSel" SDoc -> SDoc -> SDoc
<+> Either IfaceTyCon IfaceDecl -> SDoc
forall a. Outputable a => a -> SDoc
ppr Either IfaceTyCon IfaceDecl
tc
                          SDoc -> SDoc -> SDoc
<+> if Bool
b
                                then String -> SDoc
text "<naughty>"
                                else SDoc
Outputable.empty
  ppr IfDFunId          = String -> SDoc
text "DFunId"

instance Outputable IfaceIdInfo where
  ppr :: IfaceIdInfo -> SDoc
ppr NoInfo       = SDoc
Outputable.empty
  ppr (HasInfo is :: [IfaceInfoItem]
is) = String -> SDoc
text "{-" SDoc -> SDoc -> SDoc
<+> (IfaceInfoItem -> SDoc) -> [IfaceInfoItem] -> SDoc
forall a. (a -> SDoc) -> [a] -> SDoc
pprWithCommas IfaceInfoItem -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceInfoItem]
is
                     SDoc -> SDoc -> SDoc
<+> String -> SDoc
text "-}"

instance Outputable IfaceInfoItem where
  ppr :: IfaceInfoItem -> SDoc
ppr (HsUnfold lb :: Bool
lb unf :: IfaceUnfolding
unf)     = String -> SDoc
text "Unfolding"
                              SDoc -> SDoc -> SDoc
<> Bool -> SDoc -> SDoc
ppWhen Bool
lb (String -> SDoc
text "(loop-breaker)")
                              SDoc -> SDoc -> SDoc
<> SDoc
colon SDoc -> SDoc -> SDoc
<+> IfaceUnfolding -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceUnfolding
unf
  ppr (HsInline prag :: InlinePragma
prag)       = String -> SDoc
text "Inline:" SDoc -> SDoc -> SDoc
<+> InlinePragma -> SDoc
forall a. Outputable a => a -> SDoc
ppr InlinePragma
prag
  ppr (HsArity arity :: BranchIndex
arity)       = String -> SDoc
text "Arity:" SDoc -> SDoc -> SDoc
<+> BranchIndex -> SDoc
int BranchIndex
arity
  ppr (HsStrictness str :: StrictSig
str) = String -> SDoc
text "Strictness:" SDoc -> SDoc -> SDoc
<+> StrictSig -> SDoc
pprIfaceStrictSig StrictSig
str
  ppr HsNoCafRefs           = String -> SDoc
text "HasNoCafRefs"
  ppr HsLevity              = String -> SDoc
text "Never levity-polymorphic"

instance Outputable IfaceJoinInfo where
  ppr :: IfaceJoinInfo -> SDoc
ppr IfaceNotJoinPoint   = SDoc
empty
  ppr (IfaceJoinPoint ar :: BranchIndex
ar) = SDoc -> SDoc
angleBrackets (String -> SDoc
text "join" SDoc -> SDoc -> SDoc
<+> BranchIndex -> SDoc
forall a. Outputable a => a -> SDoc
ppr BranchIndex
ar)

instance Outputable IfaceUnfolding where
  ppr :: IfaceUnfolding -> SDoc
ppr (IfCompulsory e :: IfaceExpr
e)     = String -> SDoc
text "<compulsory>" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (IfaceExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceExpr
e)
  ppr (IfCoreUnfold s :: Bool
s e :: IfaceExpr
e)   = (if Bool
s
                                then String -> SDoc
text "<stable>"
                                else SDoc
Outputable.empty)
                              SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
parens (IfaceExpr -> SDoc
forall a. Outputable a => a -> SDoc
ppr IfaceExpr
e)
  ppr (IfInlineRule a :: BranchIndex
a uok :: Bool
uok bok :: Bool
bok e :: IfaceExpr
e) = [SDoc] -> SDoc
sep [String -> SDoc
text "InlineRule"
                                            SDoc -> SDoc -> SDoc
<+> (BranchIndex, Bool, Bool) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (BranchIndex
a,Bool
uok,Bool
bok),
                                        IfaceExpr -> SDoc
pprParendIfaceExpr IfaceExpr
e]
  ppr (IfDFunUnfold bs :: [IfaceBndr]
bs es :: [IfaceExpr]
es) = SDoc -> BranchIndex -> SDoc -> SDoc
hang (String -> SDoc
text "DFun:" SDoc -> SDoc -> SDoc
<+> [SDoc] -> SDoc
sep ((IfaceBndr -> SDoc) -> [IfaceBndr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceBndr -> SDoc
forall a. Outputable a => a -> SDoc
ppr [IfaceBndr]
bs) SDoc -> SDoc -> SDoc
<> SDoc
dot)
                                2 ([SDoc] -> SDoc
sep ((IfaceExpr -> SDoc) -> [IfaceExpr] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map IfaceExpr -> SDoc
pprParendIfaceExpr [IfaceExpr]
es))

{-
************************************************************************
*                                                                      *
              Finding the Names in IfaceSyn
*                                                                      *
************************************************************************

This is used for dependency analysis in MkIface, so that we
fingerprint a declaration before the things that depend on it.  It
is specific to interface-file fingerprinting in the sense that we
don't collect *all* Names: for example, the DFun of an instance is
recorded textually rather than by its fingerprint when
fingerprinting the instance, so DFuns are not dependencies.
-}

freeNamesIfDecl :: IfaceDecl -> NameSet
freeNamesIfDecl :: IfaceDecl -> NameSet
freeNamesIfDecl (IfaceId { ifType :: IfaceDecl -> IfaceType
ifType = IfaceType
t, ifIdDetails :: IfaceDecl -> IfaceIdDetails
ifIdDetails = IfaceIdDetails
d, ifIdInfo :: IfaceDecl -> IfaceIdInfo
ifIdInfo = IfaceIdInfo
i})
  = IfaceType -> NameSet
freeNamesIfType IfaceType
t NameSet -> NameSet -> NameSet
&&&
    IfaceIdInfo -> NameSet
freeNamesIfIdInfo IfaceIdInfo
i NameSet -> NameSet -> NameSet
&&&
    IfaceIdDetails -> NameSet
freeNamesIfIdDetails IfaceIdDetails
d

freeNamesIfDecl (IfaceData { ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
bndrs, ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_k
                           , ifParent :: IfaceDecl -> IfaceTyConParent
ifParent = IfaceTyConParent
p, ifCtxt :: IfaceDecl -> IfaceContext
ifCtxt = IfaceContext
ctxt, ifCons :: IfaceDecl -> IfaceConDecls
ifCons = IfaceConDecls
cons })
  = [IfaceTyConBinder] -> NameSet
forall vis. [VarBndr IfaceBndr vis] -> NameSet
freeNamesIfVarBndrs [IfaceTyConBinder]
bndrs NameSet -> NameSet -> NameSet
&&&
    IfaceType -> NameSet
freeNamesIfType IfaceType
res_k NameSet -> NameSet -> NameSet
&&&
    IfaceTyConParent -> NameSet
freeNamesIfaceTyConParent IfaceTyConParent
p NameSet -> NameSet -> NameSet
&&&
    IfaceContext -> NameSet
freeNamesIfContext IfaceContext
ctxt NameSet -> NameSet -> NameSet
&&&
    IfaceConDecls -> NameSet
freeNamesIfConDecls IfaceConDecls
cons

freeNamesIfDecl (IfaceSynonym { ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
bndrs, ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_k
                              , ifSynRhs :: IfaceDecl -> IfaceType
ifSynRhs = IfaceType
rhs })
  = [IfaceTyConBinder] -> NameSet
forall vis. [VarBndr IfaceBndr vis] -> NameSet
freeNamesIfVarBndrs [IfaceTyConBinder]
bndrs NameSet -> NameSet -> NameSet
&&&
    IfaceType -> NameSet
freeNamesIfKind IfaceType
res_k NameSet -> NameSet -> NameSet
&&&
    IfaceType -> NameSet
freeNamesIfType IfaceType
rhs

freeNamesIfDecl (IfaceFamily { ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
bndrs, ifResKind :: IfaceDecl -> IfaceType
ifResKind = IfaceType
res_k
                             , ifFamFlav :: IfaceDecl -> IfaceFamTyConFlav
ifFamFlav = IfaceFamTyConFlav
flav })
  = [IfaceTyConBinder] -> NameSet
forall vis. [VarBndr IfaceBndr vis] -> NameSet
freeNamesIfVarBndrs [IfaceTyConBinder]
bndrs NameSet -> NameSet -> NameSet
&&&
    IfaceType -> NameSet
freeNamesIfKind IfaceType
res_k NameSet -> NameSet -> NameSet
&&&
    IfaceFamTyConFlav -> NameSet
freeNamesIfFamFlav IfaceFamTyConFlav
flav

freeNamesIfDecl (IfaceClass{ ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
bndrs, ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfaceClassBody
cls_body })
  = [IfaceTyConBinder] -> NameSet
forall vis. [VarBndr IfaceBndr vis] -> NameSet
freeNamesIfVarBndrs [IfaceTyConBinder]
bndrs NameSet -> NameSet -> NameSet
&&&
    IfaceClassBody -> NameSet
freeNamesIfClassBody IfaceClassBody
cls_body

freeNamesIfDecl (IfaceAxiom { ifTyCon :: IfaceDecl -> IfaceTyCon
ifTyCon = IfaceTyCon
tc, ifAxBranches :: IfaceDecl -> [IfaceAxBranch]
ifAxBranches = [IfaceAxBranch]
branches })
  = IfaceTyCon -> NameSet
freeNamesIfTc IfaceTyCon
tc NameSet -> NameSet -> NameSet
&&&
    (IfaceAxBranch -> NameSet) -> [IfaceAxBranch] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceAxBranch -> NameSet
freeNamesIfAxBranch [IfaceAxBranch]
branches

freeNamesIfDecl (IfacePatSyn { ifPatMatcher :: IfaceDecl -> (IfaceTopBndr, Bool)
ifPatMatcher = (matcher :: IfaceTopBndr
matcher, _)
                             , ifPatBuilder :: IfaceDecl -> Maybe (IfaceTopBndr, Bool)
ifPatBuilder = Maybe (IfaceTopBndr, Bool)
mb_builder
                             , ifPatUnivBndrs :: IfaceDecl -> [IfaceForAllBndr]
ifPatUnivBndrs = [IfaceForAllBndr]
univ_bndrs
                             , ifPatExBndrs :: IfaceDecl -> [IfaceForAllBndr]
ifPatExBndrs = [IfaceForAllBndr]
ex_bndrs
                             , ifPatProvCtxt :: IfaceDecl -> IfaceContext
ifPatProvCtxt = IfaceContext
prov_ctxt
                             , ifPatReqCtxt :: IfaceDecl -> IfaceContext
ifPatReqCtxt = IfaceContext
req_ctxt
                             , ifPatArgs :: IfaceDecl -> IfaceContext
ifPatArgs = IfaceContext
args
                             , ifPatTy :: IfaceDecl -> IfaceType
ifPatTy = IfaceType
pat_ty
                             , ifFieldLabels :: IfaceDecl -> [FieldLabel]
ifFieldLabels = [FieldLabel]
lbls })
  = IfaceTopBndr -> NameSet
unitNameSet IfaceTopBndr
matcher NameSet -> NameSet -> NameSet
&&&
    NameSet
-> ((IfaceTopBndr, Bool) -> NameSet)
-> Maybe (IfaceTopBndr, Bool)
-> NameSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NameSet
emptyNameSet (IfaceTopBndr -> NameSet
unitNameSet (IfaceTopBndr -> NameSet)
-> ((IfaceTopBndr, Bool) -> IfaceTopBndr)
-> (IfaceTopBndr, Bool)
-> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IfaceTopBndr, Bool) -> IfaceTopBndr
forall a b. (a, b) -> a
fst) Maybe (IfaceTopBndr, Bool)
mb_builder NameSet -> NameSet -> NameSet
&&&
    [IfaceForAllBndr] -> NameSet
forall vis. [VarBndr IfaceBndr vis] -> NameSet
freeNamesIfVarBndrs [IfaceForAllBndr]
univ_bndrs NameSet -> NameSet -> NameSet
&&&
    [IfaceForAllBndr] -> NameSet
forall vis. [VarBndr IfaceBndr vis] -> NameSet
freeNamesIfVarBndrs [IfaceForAllBndr]
ex_bndrs NameSet -> NameSet -> NameSet
&&&
    IfaceContext -> NameSet
freeNamesIfContext IfaceContext
prov_ctxt NameSet -> NameSet -> NameSet
&&&
    IfaceContext -> NameSet
freeNamesIfContext IfaceContext
req_ctxt NameSet -> NameSet -> NameSet
&&&
    (IfaceType -> NameSet) -> IfaceContext -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceType -> NameSet
freeNamesIfType IfaceContext
args NameSet -> NameSet -> NameSet
&&&
    IfaceType -> NameSet
freeNamesIfType IfaceType
pat_ty NameSet -> NameSet -> NameSet
&&&
    [IfaceTopBndr] -> NameSet
mkNameSet ((FieldLabel -> IfaceTopBndr) -> [FieldLabel] -> [IfaceTopBndr]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> IfaceTopBndr
forall a. FieldLbl a -> a
flSelector [FieldLabel]
lbls)

freeNamesIfClassBody :: IfaceClassBody -> NameSet
freeNamesIfClassBody :: IfaceClassBody -> NameSet
freeNamesIfClassBody IfAbstractClass
  = NameSet
emptyNameSet
freeNamesIfClassBody (IfConcreteClass{ ifClassCtxt :: IfaceClassBody -> IfaceContext
ifClassCtxt = IfaceContext
ctxt, ifATs :: IfaceClassBody -> [IfaceAT]
ifATs = [IfaceAT]
ats, ifSigs :: IfaceClassBody -> [IfaceClassOp]
ifSigs = [IfaceClassOp]
sigs })
  = IfaceContext -> NameSet
freeNamesIfContext IfaceContext
ctxt  NameSet -> NameSet -> NameSet
&&&
    (IfaceAT -> NameSet) -> [IfaceAT] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceAT -> NameSet
freeNamesIfAT [IfaceAT]
ats NameSet -> NameSet -> NameSet
&&&
    (IfaceClassOp -> NameSet) -> [IfaceClassOp] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceClassOp -> NameSet
freeNamesIfClsSig [IfaceClassOp]
sigs

freeNamesIfAxBranch :: IfaceAxBranch -> NameSet
freeNamesIfAxBranch :: IfaceAxBranch -> NameSet
freeNamesIfAxBranch (IfaceAxBranch { ifaxbTyVars :: IfaceAxBranch -> [IfaceTvBndr]
ifaxbTyVars   = [IfaceTvBndr]
tyvars
                                   , ifaxbCoVars :: IfaceAxBranch -> [IfaceTvBndr]
ifaxbCoVars   = [IfaceTvBndr]
covars
                                   , ifaxbLHS :: IfaceAxBranch -> IfaceAppArgs
ifaxbLHS      = IfaceAppArgs
lhs
                                   , ifaxbRHS :: IfaceAxBranch -> IfaceType
ifaxbRHS      = IfaceType
rhs })
  = (IfaceTvBndr -> NameSet) -> [IfaceTvBndr] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceTvBndr -> NameSet
freeNamesIfTvBndr [IfaceTvBndr]
tyvars NameSet -> NameSet -> NameSet
&&&
    (IfaceTvBndr -> NameSet) -> [IfaceTvBndr] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceTvBndr -> NameSet
freeNamesIfIdBndr [IfaceTvBndr]
covars NameSet -> NameSet -> NameSet
&&&
    IfaceAppArgs -> NameSet
freeNamesIfAppArgs IfaceAppArgs
lhs NameSet -> NameSet -> NameSet
&&&
    IfaceType -> NameSet
freeNamesIfType IfaceType
rhs

freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
freeNamesIfIdDetails (IfRecSelId tc :: Either IfaceTyCon IfaceDecl
tc _) =
  (IfaceTyCon -> NameSet)
-> (IfaceDecl -> NameSet) -> Either IfaceTyCon IfaceDecl -> NameSet
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either IfaceTyCon -> NameSet
freeNamesIfTc IfaceDecl -> NameSet
freeNamesIfDecl Either IfaceTyCon IfaceDecl
tc
freeNamesIfIdDetails _                 = NameSet
emptyNameSet

-- All other changes are handled via the version info on the tycon
freeNamesIfFamFlav :: IfaceFamTyConFlav -> NameSet
freeNamesIfFamFlav :: IfaceFamTyConFlav -> NameSet
freeNamesIfFamFlav IfaceOpenSynFamilyTyCon             = NameSet
emptyNameSet
freeNamesIfFamFlav IfaceDataFamilyTyCon                = NameSet
emptyNameSet
freeNamesIfFamFlav (IfaceClosedSynFamilyTyCon (Just (ax :: IfaceTopBndr
ax, br :: [IfaceAxBranch]
br)))
  = IfaceTopBndr -> NameSet
unitNameSet IfaceTopBndr
ax NameSet -> NameSet -> NameSet
&&& (IfaceAxBranch -> NameSet) -> [IfaceAxBranch] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceAxBranch -> NameSet
freeNamesIfAxBranch [IfaceAxBranch]
br
freeNamesIfFamFlav (IfaceClosedSynFamilyTyCon Nothing) = NameSet
emptyNameSet
freeNamesIfFamFlav IfaceAbstractClosedSynFamilyTyCon   = NameSet
emptyNameSet
freeNamesIfFamFlav IfaceBuiltInSynFamTyCon             = NameSet
emptyNameSet

freeNamesIfContext :: IfaceContext -> NameSet
freeNamesIfContext :: IfaceContext -> NameSet
freeNamesIfContext = (IfaceType -> NameSet) -> IfaceContext -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceType -> NameSet
freeNamesIfType

freeNamesIfAT :: IfaceAT -> NameSet
freeNamesIfAT :: IfaceAT -> NameSet
freeNamesIfAT (IfaceAT decl :: IfaceDecl
decl mb_def :: Maybe IfaceType
mb_def)
  = IfaceDecl -> NameSet
freeNamesIfDecl IfaceDecl
decl NameSet -> NameSet -> NameSet
&&&
    case Maybe IfaceType
mb_def of
      Nothing  -> NameSet
emptyNameSet
      Just rhs :: IfaceType
rhs -> IfaceType -> NameSet
freeNamesIfType IfaceType
rhs

freeNamesIfClsSig :: IfaceClassOp -> NameSet
freeNamesIfClsSig :: IfaceClassOp -> NameSet
freeNamesIfClsSig (IfaceClassOp _n :: IfaceTopBndr
_n ty :: IfaceType
ty dm :: Maybe (DefMethSpec IfaceType)
dm) = IfaceType -> NameSet
freeNamesIfType IfaceType
ty NameSet -> NameSet -> NameSet
&&& Maybe (DefMethSpec IfaceType) -> NameSet
freeNamesDM Maybe (DefMethSpec IfaceType)
dm

freeNamesDM :: Maybe (DefMethSpec IfaceType) -> NameSet
freeNamesDM :: Maybe (DefMethSpec IfaceType) -> NameSet
freeNamesDM (Just (GenericDM ty :: IfaceType
ty)) = IfaceType -> NameSet
freeNamesIfType IfaceType
ty
freeNamesDM _                     = NameSet
emptyNameSet

freeNamesIfConDecls :: IfaceConDecls -> NameSet
freeNamesIfConDecls :: IfaceConDecls -> NameSet
freeNamesIfConDecls (IfDataTyCon c :: [IfaceConDecl]
c) = (IfaceConDecl -> NameSet) -> [IfaceConDecl] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceConDecl -> NameSet
freeNamesIfConDecl [IfaceConDecl]
c
freeNamesIfConDecls (IfNewTyCon  c :: IfaceConDecl
c) = IfaceConDecl -> NameSet
freeNamesIfConDecl IfaceConDecl
c
freeNamesIfConDecls _                   = NameSet
emptyNameSet

freeNamesIfConDecl :: IfaceConDecl -> NameSet
freeNamesIfConDecl :: IfaceConDecl -> NameSet
freeNamesIfConDecl (IfCon { ifConExTCvs :: IfaceConDecl -> [IfaceBndr]
ifConExTCvs  = [IfaceBndr]
ex_tvs, ifConCtxt :: IfaceConDecl -> IfaceContext
ifConCtxt = IfaceContext
ctxt
                          , ifConArgTys :: IfaceConDecl -> IfaceContext
ifConArgTys  = IfaceContext
arg_tys
                          , ifConFields :: IfaceConDecl -> [FieldLabel]
ifConFields  = [FieldLabel]
flds
                          , ifConEqSpec :: IfaceConDecl -> [IfaceTvBndr]
ifConEqSpec  = [IfaceTvBndr]
eq_spec
                          , ifConStricts :: IfaceConDecl -> [IfaceBang]
ifConStricts = [IfaceBang]
bangs })
  = (IfaceBndr -> NameSet) -> [IfaceBndr] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceBndr -> NameSet
freeNamesIfBndr [IfaceBndr]
ex_tvs NameSet -> NameSet -> NameSet
&&&
    IfaceContext -> NameSet
freeNamesIfContext IfaceContext
ctxt NameSet -> NameSet -> NameSet
&&&
    (IfaceType -> NameSet) -> IfaceContext -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceType -> NameSet
freeNamesIfType IfaceContext
arg_tys NameSet -> NameSet -> NameSet
&&&
    [IfaceTopBndr] -> NameSet
mkNameSet ((FieldLabel -> IfaceTopBndr) -> [FieldLabel] -> [IfaceTopBndr]
forall a b. (a -> b) -> [a] -> [b]
map FieldLabel -> IfaceTopBndr
forall a. FieldLbl a -> a
flSelector [FieldLabel]
flds) NameSet -> NameSet -> NameSet
&&&
    (IfaceType -> NameSet) -> IfaceContext -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceType -> NameSet
freeNamesIfType ((IfaceTvBndr -> IfaceType) -> [IfaceTvBndr] -> IfaceContext
forall a b. (a -> b) -> [a] -> [b]
map IfaceTvBndr -> IfaceType
forall a b. (a, b) -> b
snd [IfaceTvBndr]
eq_spec) NameSet -> NameSet -> NameSet
&&& -- equality constraints
    (IfaceBang -> NameSet) -> [IfaceBang] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceBang -> NameSet
freeNamesIfBang [IfaceBang]
bangs

freeNamesIfBang :: IfaceBang -> NameSet
freeNamesIfBang :: IfaceBang -> NameSet
freeNamesIfBang (IfUnpackCo co :: IfaceCoercion
co) = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co
freeNamesIfBang _               = NameSet
emptyNameSet

freeNamesIfKind :: IfaceType -> NameSet
freeNamesIfKind :: IfaceType -> NameSet
freeNamesIfKind = IfaceType -> NameSet
freeNamesIfType

freeNamesIfAppArgs :: IfaceAppArgs -> NameSet
freeNamesIfAppArgs :: IfaceAppArgs -> NameSet
freeNamesIfAppArgs (IA_Arg t :: IfaceType
t _ ts :: IfaceAppArgs
ts) = IfaceType -> NameSet
freeNamesIfType IfaceType
t NameSet -> NameSet -> NameSet
&&& IfaceAppArgs -> NameSet
freeNamesIfAppArgs IfaceAppArgs
ts
freeNamesIfAppArgs IA_Nil          = NameSet
emptyNameSet

freeNamesIfType :: IfaceType -> NameSet
freeNamesIfType :: IfaceType -> NameSet
freeNamesIfType (IfaceFreeTyVar _)    = NameSet
emptyNameSet
freeNamesIfType (IfaceTyVar _)        = NameSet
emptyNameSet
freeNamesIfType (IfaceAppTy s :: IfaceType
s t :: IfaceAppArgs
t)      = IfaceType -> NameSet
freeNamesIfType IfaceType
s NameSet -> NameSet -> NameSet
&&& IfaceAppArgs -> NameSet
freeNamesIfAppArgs IfaceAppArgs
t
freeNamesIfType (IfaceTyConApp tc :: IfaceTyCon
tc ts :: IfaceAppArgs
ts) = IfaceTyCon -> NameSet
freeNamesIfTc IfaceTyCon
tc NameSet -> NameSet -> NameSet
&&& IfaceAppArgs -> NameSet
freeNamesIfAppArgs IfaceAppArgs
ts
freeNamesIfType (IfaceTupleTy _ _ ts :: IfaceAppArgs
ts) = IfaceAppArgs -> NameSet
freeNamesIfAppArgs IfaceAppArgs
ts
freeNamesIfType (IfaceLitTy _)        = NameSet
emptyNameSet
freeNamesIfType (IfaceForAllTy tv :: IfaceForAllBndr
tv t :: IfaceType
t)  = IfaceForAllBndr -> NameSet
forall vis. VarBndr IfaceBndr vis -> NameSet
freeNamesIfVarBndr IfaceForAllBndr
tv NameSet -> NameSet -> NameSet
&&& IfaceType -> NameSet
freeNamesIfType IfaceType
t
freeNamesIfType (IfaceFunTy s :: IfaceType
s t :: IfaceType
t)      = IfaceType -> NameSet
freeNamesIfType IfaceType
s NameSet -> NameSet -> NameSet
&&& IfaceType -> NameSet
freeNamesIfType IfaceType
t
freeNamesIfType (IfaceDFunTy s :: IfaceType
s t :: IfaceType
t)     = IfaceType -> NameSet
freeNamesIfType IfaceType
s NameSet -> NameSet -> NameSet
&&& IfaceType -> NameSet
freeNamesIfType IfaceType
t
freeNamesIfType (IfaceCastTy t :: IfaceType
t c :: IfaceCoercion
c)     = IfaceType -> NameSet
freeNamesIfType IfaceType
t NameSet -> NameSet -> NameSet
&&& IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c
freeNamesIfType (IfaceCoercionTy c :: IfaceCoercion
c)   = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c

freeNamesIfMCoercion :: IfaceMCoercion -> NameSet
freeNamesIfMCoercion :: IfaceMCoercion -> NameSet
freeNamesIfMCoercion IfaceMRefl    = NameSet
emptyNameSet
freeNamesIfMCoercion (IfaceMCo co :: IfaceCoercion
co) = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co

freeNamesIfCoercion :: IfaceCoercion -> NameSet
freeNamesIfCoercion :: IfaceCoercion -> NameSet
freeNamesIfCoercion (IfaceReflCo t :: IfaceType
t) = IfaceType -> NameSet
freeNamesIfType IfaceType
t
freeNamesIfCoercion (IfaceGReflCo _ t :: IfaceType
t mco :: IfaceMCoercion
mco)
  = IfaceType -> NameSet
freeNamesIfType IfaceType
t NameSet -> NameSet -> NameSet
&&& IfaceMCoercion -> NameSet
freeNamesIfMCoercion IfaceMCoercion
mco
freeNamesIfCoercion (IfaceFunCo _ c1 :: IfaceCoercion
c1 c2 :: IfaceCoercion
c2)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c1 NameSet -> NameSet -> NameSet
&&& IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c2
freeNamesIfCoercion (IfaceTyConAppCo _ tc :: IfaceTyCon
tc cos :: [IfaceCoercion]
cos)
  = IfaceTyCon -> NameSet
freeNamesIfTc IfaceTyCon
tc NameSet -> NameSet -> NameSet
&&& (IfaceCoercion -> NameSet) -> [IfaceCoercion] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceCoercion -> NameSet
freeNamesIfCoercion [IfaceCoercion]
cos
freeNamesIfCoercion (IfaceAppCo c1 :: IfaceCoercion
c1 c2 :: IfaceCoercion
c2)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c1 NameSet -> NameSet -> NameSet
&&& IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c2
freeNamesIfCoercion (IfaceForAllCo _ kind_co :: IfaceCoercion
kind_co co :: IfaceCoercion
co)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
kind_co NameSet -> NameSet -> NameSet
&&& IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co
freeNamesIfCoercion (IfaceFreeCoVar _) = NameSet
emptyNameSet
freeNamesIfCoercion (IfaceCoVarCo _)   = NameSet
emptyNameSet
freeNamesIfCoercion (IfaceHoleCo _)    = NameSet
emptyNameSet
freeNamesIfCoercion (IfaceAxiomInstCo ax :: IfaceTopBndr
ax _ cos :: [IfaceCoercion]
cos)
  = IfaceTopBndr -> NameSet
unitNameSet IfaceTopBndr
ax NameSet -> NameSet -> NameSet
&&& (IfaceCoercion -> NameSet) -> [IfaceCoercion] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceCoercion -> NameSet
freeNamesIfCoercion [IfaceCoercion]
cos
freeNamesIfCoercion (IfaceUnivCo p :: IfaceUnivCoProv
p _ t1 :: IfaceType
t1 t2 :: IfaceType
t2)
  = IfaceUnivCoProv -> NameSet
freeNamesIfProv IfaceUnivCoProv
p NameSet -> NameSet -> NameSet
&&& IfaceType -> NameSet
freeNamesIfType IfaceType
t1 NameSet -> NameSet -> NameSet
&&& IfaceType -> NameSet
freeNamesIfType IfaceType
t2
freeNamesIfCoercion (IfaceSymCo c :: IfaceCoercion
c)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c
freeNamesIfCoercion (IfaceTransCo c1 :: IfaceCoercion
c1 c2 :: IfaceCoercion
c2)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c1 NameSet -> NameSet -> NameSet
&&& IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c2
freeNamesIfCoercion (IfaceNthCo _ co :: IfaceCoercion
co)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co
freeNamesIfCoercion (IfaceLRCo _ co :: IfaceCoercion
co)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co
freeNamesIfCoercion (IfaceInstCo co :: IfaceCoercion
co co2 :: IfaceCoercion
co2)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co NameSet -> NameSet -> NameSet
&&& IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co2
freeNamesIfCoercion (IfaceKindCo c :: IfaceCoercion
c)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
c
freeNamesIfCoercion (IfaceSubCo co :: IfaceCoercion
co)
  = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co
freeNamesIfCoercion (IfaceAxiomRuleCo _ax :: IfLclName
_ax cos :: [IfaceCoercion]
cos)
  -- the axiom is just a string, so we don't count it as a name.
  = (IfaceCoercion -> NameSet) -> [IfaceCoercion] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceCoercion -> NameSet
freeNamesIfCoercion [IfaceCoercion]
cos

freeNamesIfProv :: IfaceUnivCoProv -> NameSet
freeNamesIfProv :: IfaceUnivCoProv -> NameSet
freeNamesIfProv IfaceUnsafeCoerceProv    = NameSet
emptyNameSet
freeNamesIfProv (IfacePhantomProv co :: IfaceCoercion
co)    = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co
freeNamesIfProv (IfaceProofIrrelProv co :: IfaceCoercion
co) = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co
freeNamesIfProv (IfacePluginProv _)      = NameSet
emptyNameSet

freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet
freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet
freeNamesIfVarBndr (Bndr bndr :: IfaceBndr
bndr _) = IfaceBndr -> NameSet
freeNamesIfBndr IfaceBndr
bndr

freeNamesIfVarBndrs :: [VarBndr IfaceBndr vis] -> NameSet
freeNamesIfVarBndrs :: [VarBndr IfaceBndr vis] -> NameSet
freeNamesIfVarBndrs = (VarBndr IfaceBndr vis -> NameSet)
-> [VarBndr IfaceBndr vis] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList VarBndr IfaceBndr vis -> NameSet
forall vis. VarBndr IfaceBndr vis -> NameSet
freeNamesIfVarBndr

freeNamesIfBndr :: IfaceBndr -> NameSet
freeNamesIfBndr :: IfaceBndr -> NameSet
freeNamesIfBndr (IfaceIdBndr b :: IfaceTvBndr
b) = IfaceTvBndr -> NameSet
freeNamesIfIdBndr IfaceTvBndr
b
freeNamesIfBndr (IfaceTvBndr b :: IfaceTvBndr
b) = IfaceTvBndr -> NameSet
freeNamesIfTvBndr IfaceTvBndr
b

freeNamesIfBndrs :: [IfaceBndr] -> NameSet
freeNamesIfBndrs :: [IfaceBndr] -> NameSet
freeNamesIfBndrs = (IfaceBndr -> NameSet) -> [IfaceBndr] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceBndr -> NameSet
freeNamesIfBndr

freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
-- Remember IfaceLetBndr is used only for *nested* bindings
-- The IdInfo can contain an unfolding (in the case of
-- local INLINE pragmas), so look there too
freeNamesIfLetBndr :: IfaceLetBndr -> NameSet
freeNamesIfLetBndr (IfLetBndr _name :: IfLclName
_name ty :: IfaceType
ty info :: IfaceIdInfo
info _ji :: IfaceJoinInfo
_ji) = IfaceType -> NameSet
freeNamesIfType IfaceType
ty
                                                 NameSet -> NameSet -> NameSet
&&& IfaceIdInfo -> NameSet
freeNamesIfIdInfo IfaceIdInfo
info

freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
freeNamesIfTvBndr :: IfaceTvBndr -> NameSet
freeNamesIfTvBndr (_fs :: IfLclName
_fs,k :: IfaceType
k) = IfaceType -> NameSet
freeNamesIfKind IfaceType
k
    -- kinds can have Names inside, because of promotion

freeNamesIfIdBndr :: IfaceIdBndr -> NameSet
freeNamesIfIdBndr :: IfaceTvBndr -> NameSet
freeNamesIfIdBndr (_fs :: IfLclName
_fs,k :: IfaceType
k) = IfaceType -> NameSet
freeNamesIfKind IfaceType
k

freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
freeNamesIfIdInfo :: IfaceIdInfo -> NameSet
freeNamesIfIdInfo NoInfo      = NameSet
emptyNameSet
freeNamesIfIdInfo (HasInfo i :: [IfaceInfoItem]
i) = (IfaceInfoItem -> NameSet) -> [IfaceInfoItem] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceInfoItem -> NameSet
freeNamesItem [IfaceInfoItem]
i

freeNamesItem :: IfaceInfoItem -> NameSet
freeNamesItem :: IfaceInfoItem -> NameSet
freeNamesItem (HsUnfold _ u :: IfaceUnfolding
u) = IfaceUnfolding -> NameSet
freeNamesIfUnfold IfaceUnfolding
u
freeNamesItem _              = NameSet
emptyNameSet

freeNamesIfUnfold :: IfaceUnfolding -> NameSet
freeNamesIfUnfold :: IfaceUnfolding -> NameSet
freeNamesIfUnfold (IfCoreUnfold _ e :: IfaceExpr
e)     = IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
e
freeNamesIfUnfold (IfCompulsory e :: IfaceExpr
e)       = IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
e
freeNamesIfUnfold (IfInlineRule _ _ _ e :: IfaceExpr
e) = IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
e
freeNamesIfUnfold (IfDFunUnfold bs :: [IfaceBndr]
bs es :: [IfaceExpr]
es)   = [IfaceBndr] -> NameSet
freeNamesIfBndrs [IfaceBndr]
bs NameSet -> NameSet -> NameSet
&&& (IfaceExpr -> NameSet) -> [IfaceExpr] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceExpr -> NameSet
freeNamesIfExpr [IfaceExpr]
es

freeNamesIfExpr :: IfaceExpr -> NameSet
freeNamesIfExpr :: IfaceExpr -> NameSet
freeNamesIfExpr (IfaceExt v :: IfaceTopBndr
v)          = IfaceTopBndr -> NameSet
unitNameSet IfaceTopBndr
v
freeNamesIfExpr (IfaceFCall _ ty :: IfaceType
ty)     = IfaceType -> NameSet
freeNamesIfType IfaceType
ty
freeNamesIfExpr (IfaceType ty :: IfaceType
ty)        = IfaceType -> NameSet
freeNamesIfType IfaceType
ty
freeNamesIfExpr (IfaceCo co :: IfaceCoercion
co)          = IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co
freeNamesIfExpr (IfaceTuple _ as :: [IfaceExpr]
as)     = (IfaceExpr -> NameSet) -> [IfaceExpr] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceExpr -> NameSet
freeNamesIfExpr [IfaceExpr]
as
freeNamesIfExpr (IfaceLam (b :: IfaceBndr
b,_) body :: IfaceExpr
body) = IfaceBndr -> NameSet
freeNamesIfBndr IfaceBndr
b NameSet -> NameSet -> NameSet
&&& IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
body
freeNamesIfExpr (IfaceApp f :: IfaceExpr
f a :: IfaceExpr
a)        = IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
f NameSet -> NameSet -> NameSet
&&& IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
a
freeNamesIfExpr (IfaceCast e :: IfaceExpr
e co :: IfaceCoercion
co)      = IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
e NameSet -> NameSet -> NameSet
&&& IfaceCoercion -> NameSet
freeNamesIfCoercion IfaceCoercion
co
freeNamesIfExpr (IfaceTick _ e :: IfaceExpr
e)       = IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
e
freeNamesIfExpr (IfaceECase e :: IfaceExpr
e ty :: IfaceType
ty)     = IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
e NameSet -> NameSet -> NameSet
&&& IfaceType -> NameSet
freeNamesIfType IfaceType
ty
freeNamesIfExpr (IfaceCase s :: IfaceExpr
s _ alts :: [IfaceAlt]
alts)
  = IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
s NameSet -> NameSet -> NameSet
&&& (IfaceAlt -> NameSet) -> [IfaceAlt] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceAlt -> NameSet
forall a b. (a, b, IfaceExpr) -> NameSet
fn_alt [IfaceAlt]
alts NameSet -> NameSet -> NameSet
&&& [IfaceAlt] -> NameSet
forall b c. [(IfaceConAlt, b, c)] -> NameSet
fn_cons [IfaceAlt]
alts
  where
    fn_alt :: (a, b, IfaceExpr) -> NameSet
fn_alt (_con :: a
_con,_bs :: b
_bs,r :: IfaceExpr
r) = IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
r

    -- Depend on the data constructors.  Just one will do!
    -- Note [Tracking data constructors]
    fn_cons :: [(IfaceConAlt, b, c)] -> NameSet
fn_cons []                            = NameSet
emptyNameSet
    fn_cons ((IfaceDefault    ,_,_) : xs :: [(IfaceConAlt, b, c)]
xs) = [(IfaceConAlt, b, c)] -> NameSet
fn_cons [(IfaceConAlt, b, c)]
xs
    fn_cons ((IfaceDataAlt con :: IfaceTopBndr
con,_,_) : _ ) = IfaceTopBndr -> NameSet
unitNameSet IfaceTopBndr
con
    fn_cons (_                      : _ ) = NameSet
emptyNameSet

freeNamesIfExpr (IfaceLet (IfaceNonRec bndr :: IfaceLetBndr
bndr rhs :: IfaceExpr
rhs) body :: IfaceExpr
body)
  = IfaceLetBndr -> NameSet
freeNamesIfLetBndr IfaceLetBndr
bndr NameSet -> NameSet -> NameSet
&&& IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
rhs NameSet -> NameSet -> NameSet
&&& IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
body

freeNamesIfExpr (IfaceLet (IfaceRec as :: [(IfaceLetBndr, IfaceExpr)]
as) x :: IfaceExpr
x)
  = ((IfaceLetBndr, IfaceExpr) -> NameSet)
-> [(IfaceLetBndr, IfaceExpr)] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList (IfaceLetBndr, IfaceExpr) -> NameSet
fn_pair [(IfaceLetBndr, IfaceExpr)]
as NameSet -> NameSet -> NameSet
&&& IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
x
  where
    fn_pair :: (IfaceLetBndr, IfaceExpr) -> NameSet
fn_pair (bndr :: IfaceLetBndr
bndr, rhs :: IfaceExpr
rhs) = IfaceLetBndr -> NameSet
freeNamesIfLetBndr IfaceLetBndr
bndr NameSet -> NameSet -> NameSet
&&& IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
rhs

freeNamesIfExpr _ = NameSet
emptyNameSet

freeNamesIfTc :: IfaceTyCon -> NameSet
freeNamesIfTc :: IfaceTyCon -> NameSet
freeNamesIfTc tc :: IfaceTyCon
tc = IfaceTopBndr -> NameSet
unitNameSet (IfaceTyCon -> IfaceTopBndr
ifaceTyConName IfaceTyCon
tc)
-- ToDo: shouldn't we include IfaceIntTc & co.?

freeNamesIfRule :: IfaceRule -> NameSet
freeNamesIfRule :: IfaceRule -> NameSet
freeNamesIfRule (IfaceRule { ifRuleBndrs :: IfaceRule -> [IfaceBndr]
ifRuleBndrs = [IfaceBndr]
bs, ifRuleHead :: IfaceRule -> IfaceTopBndr
ifRuleHead = IfaceTopBndr
f
                           , ifRuleArgs :: IfaceRule -> [IfaceExpr]
ifRuleArgs = [IfaceExpr]
es, ifRuleRhs :: IfaceRule -> IfaceExpr
ifRuleRhs = IfaceExpr
rhs })
  = IfaceTopBndr -> NameSet
unitNameSet IfaceTopBndr
f NameSet -> NameSet -> NameSet
&&&
    (IfaceBndr -> NameSet) -> [IfaceBndr] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceBndr -> NameSet
freeNamesIfBndr [IfaceBndr]
bs NameSet -> NameSet -> NameSet
&&&
    (IfaceExpr -> NameSet) -> [IfaceExpr] -> NameSet
forall a. (a -> NameSet) -> [a] -> NameSet
fnList IfaceExpr -> NameSet
freeNamesIfExpr [IfaceExpr]
es NameSet -> NameSet -> NameSet
&&&
    IfaceExpr -> NameSet
freeNamesIfExpr IfaceExpr
rhs

freeNamesIfFamInst :: IfaceFamInst -> NameSet
freeNamesIfFamInst :: IfaceFamInst -> NameSet
freeNamesIfFamInst (IfaceFamInst { ifFamInstFam :: IfaceFamInst -> IfaceTopBndr
ifFamInstFam = IfaceTopBndr
famName
                                 , ifFamInstAxiom :: IfaceFamInst -> IfaceTopBndr
ifFamInstAxiom = IfaceTopBndr
axName })
  = IfaceTopBndr -> NameSet
unitNameSet IfaceTopBndr
famName NameSet -> NameSet -> NameSet
&&&
    IfaceTopBndr -> NameSet
unitNameSet IfaceTopBndr
axName

freeNamesIfaceTyConParent :: IfaceTyConParent -> NameSet
freeNamesIfaceTyConParent :: IfaceTyConParent -> NameSet
freeNamesIfaceTyConParent IfNoParent = NameSet
emptyNameSet
freeNamesIfaceTyConParent (IfDataInstance ax :: IfaceTopBndr
ax tc :: IfaceTyCon
tc tys :: IfaceAppArgs
tys)
  = IfaceTopBndr -> NameSet
unitNameSet IfaceTopBndr
ax NameSet -> NameSet -> NameSet
&&& IfaceTyCon -> NameSet
freeNamesIfTc IfaceTyCon
tc NameSet -> NameSet -> NameSet
&&& IfaceAppArgs -> NameSet
freeNamesIfAppArgs IfaceAppArgs
tys

-- helpers
(&&&) :: NameSet -> NameSet -> NameSet
&&& :: NameSet -> NameSet -> NameSet
(&&&) = NameSet -> NameSet -> NameSet
unionNameSet

fnList :: (a -> NameSet) -> [a] -> NameSet
fnList :: (a -> NameSet) -> [a] -> NameSet
fnList f :: a -> NameSet
f = (NameSet -> NameSet -> NameSet) -> NameSet -> [NameSet] -> NameSet
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NameSet -> NameSet -> NameSet
(&&&) NameSet
emptyNameSet ([NameSet] -> NameSet) -> ([a] -> [NameSet]) -> [a] -> NameSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> NameSet) -> [a] -> [NameSet]
forall a b. (a -> b) -> [a] -> [b]
map a -> NameSet
f

{-
Note [Tracking data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In a case expression
   case e of { C a -> ...; ... }
You might think that we don't need to include the datacon C
in the free names, because its type will probably show up in
the free names of 'e'.  But in rare circumstances this may
not happen.   Here's the one that bit me:

   module DynFlags where
     import {-# SOURCE #-} Packages( PackageState )
     data DynFlags = DF ... PackageState ...

   module Packages where
     import DynFlags
     data PackageState = PS ...
     lookupModule (df :: DynFlags)
        = case df of
              DF ...p... -> case p of
                               PS ... -> ...

Now, lookupModule depends on DynFlags, but the transitive dependency
on the *locally-defined* type PackageState is not visible. We need
to take account of the use of the data constructor PS in the pattern match.


************************************************************************
*                                                                      *
                Binary instances
*                                                                      *
************************************************************************

Note that there is a bit of subtlety here when we encode names. While
IfaceTopBndrs is really just a synonym for Name, we need to take care to
encode them with {get,put}IfaceTopBndr. The difference becomes important when
we go to fingerprint an IfaceDecl. See Note [Fingerprinting IfaceDecls] for
details.

-}

instance Binary IfaceDecl where
    put_ :: BinHandle -> IfaceDecl -> IO ()
put_ bh :: BinHandle
bh (IfaceId name :: IfaceTopBndr
name ty :: IfaceType
ty details :: IfaceIdDetails
details idinfo :: IfaceIdInfo
idinfo) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
name
        BinHandle -> (IfaceType, IfaceIdDetails, IfaceIdInfo) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh (IfaceType
ty, IfaceIdDetails
details, IfaceIdInfo
idinfo)
        -- See Note [Lazy deserialization of IfaceId]

    put_ bh :: BinHandle
bh (IfaceData a1 :: IfaceTopBndr
a1 a2 :: [IfaceTyConBinder]
a2 a3 :: IfaceType
a3 a4 :: Maybe CType
a4 a5 :: [Role]
a5 a6 :: IfaceContext
a6 a7 :: IfaceConDecls
a7 a8 :: Bool
a8 a9 :: IfaceTyConParent
a9) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
a1
        BinHandle -> [IfaceTyConBinder] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTyConBinder]
a2
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a3
        BinHandle -> Maybe CType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe CType
a4
        BinHandle -> [Role] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Role]
a5
        BinHandle -> IfaceContext -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceContext
a6
        BinHandle -> IfaceConDecls -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceConDecls
a7
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
a8
        BinHandle -> IfaceTyConParent -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyConParent
a9

    put_ bh :: BinHandle
bh (IfaceSynonym a1 :: IfaceTopBndr
a1 a2 :: [Role]
a2 a3 :: [IfaceTyConBinder]
a3 a4 :: IfaceType
a4 a5 :: IfaceType
a5) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
a1
        BinHandle -> [Role] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Role]
a2
        BinHandle -> [IfaceTyConBinder] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTyConBinder]
a3
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a4
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a5

    put_ bh :: BinHandle
bh (IfaceFamily a1 :: IfaceTopBndr
a1 a2 :: Maybe IfLclName
a2 a3 :: [IfaceTyConBinder]
a3 a4 :: IfaceType
a4 a5 :: IfaceFamTyConFlav
a5 a6 :: Injectivity
a6) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 4
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
a1
        BinHandle -> Maybe IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe IfLclName
a2
        BinHandle -> [IfaceTyConBinder] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTyConBinder]
a3
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a4
        BinHandle -> IfaceFamTyConFlav -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceFamTyConFlav
a5
        BinHandle -> Injectivity -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Injectivity
a6

    -- NB: Written in a funny way to avoid an interface change
    put_ bh :: BinHandle
bh (IfaceClass {
                ifName :: IfaceDecl -> IfaceTopBndr
ifName    = IfaceTopBndr
a2,
                ifRoles :: IfaceDecl -> [Role]
ifRoles   = [Role]
a3,
                ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
a4,
                ifFDs :: IfaceDecl -> [FunDep IfLclName]
ifFDs     = [FunDep IfLclName]
a5,
                ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfConcreteClass {
                    ifClassCtxt :: IfaceClassBody -> IfaceContext
ifClassCtxt = IfaceContext
a1,
                    ifATs :: IfaceClassBody -> [IfaceAT]
ifATs  = [IfaceAT]
a6,
                    ifSigs :: IfaceClassBody -> [IfaceClassOp]
ifSigs = [IfaceClassOp]
a7,
                    ifMinDef :: IfaceClassBody -> BooleanFormula IfLclName
ifMinDef  = BooleanFormula IfLclName
a8
                }}) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 5
        BinHandle -> IfaceContext -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceContext
a1
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
a2
        BinHandle -> [Role] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Role]
a3
        BinHandle -> [IfaceTyConBinder] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTyConBinder]
a4
        BinHandle -> [FunDep IfLclName] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FunDep IfLclName]
a5
        BinHandle -> [IfaceAT] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceAT]
a6
        BinHandle -> [IfaceClassOp] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceClassOp]
a7
        BinHandle -> BooleanFormula IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BooleanFormula IfLclName
a8

    put_ bh :: BinHandle
bh (IfaceAxiom a1 :: IfaceTopBndr
a1 a2 :: IfaceTyCon
a2 a3 :: Role
a3 a4 :: [IfaceAxBranch]
a4) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 6
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
a1
        BinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
a2
        BinHandle -> Role -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Role
a3
        BinHandle -> [IfaceAxBranch] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceAxBranch]
a4

    put_ bh :: BinHandle
bh (IfacePatSyn a1 :: IfaceTopBndr
a1 a2 :: Bool
a2 a3 :: (IfaceTopBndr, Bool)
a3 a4 :: Maybe (IfaceTopBndr, Bool)
a4 a5 :: [IfaceForAllBndr]
a5 a6 :: [IfaceForAllBndr]
a6 a7 :: IfaceContext
a7 a8 :: IfaceContext
a8 a9 :: IfaceContext
a9 a10 :: IfaceType
a10 a11 :: [FieldLabel]
a11) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 7
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
a1
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
a2
        BinHandle -> (IfaceTopBndr, Bool) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (IfaceTopBndr, Bool)
a3
        BinHandle -> Maybe (IfaceTopBndr, Bool) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe (IfaceTopBndr, Bool)
a4
        BinHandle -> [IfaceForAllBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceForAllBndr]
a5
        BinHandle -> [IfaceForAllBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceForAllBndr]
a6
        BinHandle -> IfaceContext -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceContext
a7
        BinHandle -> IfaceContext -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceContext
a8
        BinHandle -> IfaceContext -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceContext
a9
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a10
        BinHandle -> [FieldLabel] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FieldLabel]
a11

    put_ bh :: BinHandle
bh (IfaceClass {
                ifName :: IfaceDecl -> IfaceTopBndr
ifName    = IfaceTopBndr
a1,
                ifRoles :: IfaceDecl -> [Role]
ifRoles   = [Role]
a2,
                ifBinders :: IfaceDecl -> [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
a3,
                ifFDs :: IfaceDecl -> [FunDep IfLclName]
ifFDs     = [FunDep IfLclName]
a4,
                ifBody :: IfaceDecl -> IfaceClassBody
ifBody = IfaceClassBody
IfAbstractClass }) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 8
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
a1
        BinHandle -> [Role] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Role]
a2
        BinHandle -> [IfaceTyConBinder] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTyConBinder]
a3
        BinHandle -> [FunDep IfLclName] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [FunDep IfLclName]
a4

    get :: BinHandle -> IO IfaceDecl
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> do IfaceTopBndr
name    <- BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    ~(ty :: IfaceType
ty, details :: IfaceIdDetails
details, idinfo :: IfaceIdInfo
idinfo) <- BinHandle -> IO (IfaceType, IfaceIdDetails, IfaceIdInfo)
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh
                    -- See Note [Lazy deserialization of IfaceId]
                    IfaceDecl -> IO IfaceDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr
-> IfaceType -> IfaceIdDetails -> IfaceIdInfo -> IfaceDecl
IfaceId IfaceTopBndr
name IfaceType
ty IfaceIdDetails
details IfaceIdInfo
idinfo)
            1 -> String -> IO IfaceDecl
forall a. HasCallStack => String -> a
error "Binary.get(TyClDecl): ForeignType"
            2 -> do IfaceTopBndr
a1  <- BinHandle -> IO IfaceTopBndr
getIfaceTopBndr BinHandle
bh
                    [IfaceTyConBinder]
a2  <- BinHandle -> IO [IfaceTyConBinder]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceType
a3  <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Maybe CType
a4  <- BinHandle -> IO (Maybe CType)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [Role]
a5  <- BinHandle -> IO [Role]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceContext
a6  <- BinHandle -> IO IfaceContext
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceConDecls
a7  <- BinHandle -> IO IfaceConDecls
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Bool
a8  <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceTyConParent
a9  <- BinHandle -> IO IfaceTyConParent
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceDecl -> IO IfaceDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr
-> [IfaceTyConBinder]
-> IfaceType
-> Maybe CType
-> [Role]
-> IfaceContext
-> IfaceConDecls
-> Bool
-> IfaceTyConParent
-> IfaceDecl
IfaceData IfaceTopBndr
a1 [IfaceTyConBinder]
a2 IfaceType
a3 Maybe CType
a4 [Role]
a5 IfaceContext
a6 IfaceConDecls
a7 Bool
a8 IfaceTyConParent
a9)
            3 -> do IfaceTopBndr
a1 <- BinHandle -> IO IfaceTopBndr
getIfaceTopBndr BinHandle
bh
                    [Role]
a2 <- BinHandle -> IO [Role]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceTyConBinder]
a3 <- BinHandle -> IO [IfaceTyConBinder]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceType
a4 <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceType
a5 <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceDecl -> IO IfaceDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr
-> [Role]
-> [IfaceTyConBinder]
-> IfaceType
-> IfaceType
-> IfaceDecl
IfaceSynonym IfaceTopBndr
a1 [Role]
a2 [IfaceTyConBinder]
a3 IfaceType
a4 IfaceType
a5)
            4 -> do IfaceTopBndr
a1 <- BinHandle -> IO IfaceTopBndr
getIfaceTopBndr BinHandle
bh
                    Maybe IfLclName
a2 <- BinHandle -> IO (Maybe IfLclName)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceTyConBinder]
a3 <- BinHandle -> IO [IfaceTyConBinder]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceType
a4 <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceFamTyConFlav
a5 <- BinHandle -> IO IfaceFamTyConFlav
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Injectivity
a6 <- BinHandle -> IO Injectivity
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceDecl -> IO IfaceDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr
-> Maybe IfLclName
-> [IfaceTyConBinder]
-> IfaceType
-> IfaceFamTyConFlav
-> Injectivity
-> IfaceDecl
IfaceFamily IfaceTopBndr
a1 Maybe IfLclName
a2 [IfaceTyConBinder]
a3 IfaceType
a4 IfaceFamTyConFlav
a5 Injectivity
a6)
            5 -> do IfaceContext
a1 <- BinHandle -> IO IfaceContext
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceTopBndr
a2 <- BinHandle -> IO IfaceTopBndr
getIfaceTopBndr BinHandle
bh
                    [Role]
a3 <- BinHandle -> IO [Role]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceTyConBinder]
a4 <- BinHandle -> IO [IfaceTyConBinder]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [FunDep IfLclName]
a5 <- BinHandle -> IO [FunDep IfLclName]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceAT]
a6 <- BinHandle -> IO [IfaceAT]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceClassOp]
a7 <- BinHandle -> IO [IfaceClassOp]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    BooleanFormula IfLclName
a8 <- BinHandle -> IO (BooleanFormula IfLclName)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceDecl -> IO IfaceDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceClass :: IfaceTopBndr
-> [Role]
-> [IfaceTyConBinder]
-> [FunDep IfLclName]
-> IfaceClassBody
-> IfaceDecl
IfaceClass {
                        ifName :: IfaceTopBndr
ifName    = IfaceTopBndr
a2,
                        ifRoles :: [Role]
ifRoles   = [Role]
a3,
                        ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
a4,
                        ifFDs :: [FunDep IfLclName]
ifFDs     = [FunDep IfLclName]
a5,
                        ifBody :: IfaceClassBody
ifBody = IfConcreteClass :: IfaceContext
-> [IfaceAT]
-> [IfaceClassOp]
-> BooleanFormula IfLclName
-> IfaceClassBody
IfConcreteClass {
                            ifClassCtxt :: IfaceContext
ifClassCtxt = IfaceContext
a1,
                            ifATs :: [IfaceAT]
ifATs  = [IfaceAT]
a6,
                            ifSigs :: [IfaceClassOp]
ifSigs = [IfaceClassOp]
a7,
                            ifMinDef :: BooleanFormula IfLclName
ifMinDef  = BooleanFormula IfLclName
a8
                        }})
            6 -> do IfaceTopBndr
a1 <- BinHandle -> IO IfaceTopBndr
getIfaceTopBndr BinHandle
bh
                    IfaceTyCon
a2 <- BinHandle -> IO IfaceTyCon
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Role
a3 <- BinHandle -> IO Role
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceAxBranch]
a4 <- BinHandle -> IO [IfaceAxBranch]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceDecl -> IO IfaceDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr -> IfaceTyCon -> Role -> [IfaceAxBranch] -> IfaceDecl
IfaceAxiom IfaceTopBndr
a1 IfaceTyCon
a2 Role
a3 [IfaceAxBranch]
a4)
            7 -> do IfaceTopBndr
a1 <- BinHandle -> IO IfaceTopBndr
getIfaceTopBndr BinHandle
bh
                    Bool
a2 <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    (IfaceTopBndr, Bool)
a3 <- BinHandle -> IO (IfaceTopBndr, Bool)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Maybe (IfaceTopBndr, Bool)
a4 <- BinHandle -> IO (Maybe (IfaceTopBndr, Bool))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceForAllBndr]
a5 <- BinHandle -> IO [IfaceForAllBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceForAllBndr]
a6 <- BinHandle -> IO [IfaceForAllBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceContext
a7 <- BinHandle -> IO IfaceContext
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceContext
a8 <- BinHandle -> IO IfaceContext
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceContext
a9 <- BinHandle -> IO IfaceContext
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceType
a10 <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [FieldLabel]
a11 <- BinHandle -> IO [FieldLabel]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceDecl -> IO IfaceDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr
-> Bool
-> (IfaceTopBndr, Bool)
-> Maybe (IfaceTopBndr, Bool)
-> [IfaceForAllBndr]
-> [IfaceForAllBndr]
-> IfaceContext
-> IfaceContext
-> IfaceContext
-> IfaceType
-> [FieldLabel]
-> IfaceDecl
IfacePatSyn IfaceTopBndr
a1 Bool
a2 (IfaceTopBndr, Bool)
a3 Maybe (IfaceTopBndr, Bool)
a4 [IfaceForAllBndr]
a5 [IfaceForAllBndr]
a6 IfaceContext
a7 IfaceContext
a8 IfaceContext
a9 IfaceType
a10 [FieldLabel]
a11)
            8 -> do IfaceTopBndr
a1 <- BinHandle -> IO IfaceTopBndr
getIfaceTopBndr BinHandle
bh
                    [Role]
a2 <- BinHandle -> IO [Role]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceTyConBinder]
a3 <- BinHandle -> IO [IfaceTyConBinder]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [FunDep IfLclName]
a4 <- BinHandle -> IO [FunDep IfLclName]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceDecl -> IO IfaceDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceClass :: IfaceTopBndr
-> [Role]
-> [IfaceTyConBinder]
-> [FunDep IfLclName]
-> IfaceClassBody
-> IfaceDecl
IfaceClass {
                        ifName :: IfaceTopBndr
ifName    = IfaceTopBndr
a1,
                        ifRoles :: [Role]
ifRoles   = [Role]
a2,
                        ifBinders :: [IfaceTyConBinder]
ifBinders = [IfaceTyConBinder]
a3,
                        ifFDs :: [FunDep IfLclName]
ifFDs     = [FunDep IfLclName]
a4,
                        ifBody :: IfaceClassBody
ifBody = IfaceClassBody
IfAbstractClass })
            _ -> String -> IO IfaceDecl
forall a. String -> a
panic ([String] -> String
unwords ["Unknown IfaceDecl tag:", Word8 -> String
forall a. Show a => a -> String
show Word8
h])

{- Note [Lazy deserialization of IfaceId]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The use of lazyPut and lazyGet in the IfaceId Binary instance is
purely for performance reasons, to avoid deserializing details about
identifiers that will never be used. It's not involved in tying the
knot in the type checker. It saved ~1% of the total build time of GHC.

When we read an interface file, we extend the PTE, a mapping of Names
to TyThings, with the declarations we have read. The extension of the
PTE is strict in the Names, but not in the TyThings themselves.
LoadIface.loadDecl calculates the list of (Name, TyThing) bindings to
add to the PTE. For an IfaceId, there's just one binding to add; and
the ty, details, and idinfo fields of an IfaceId are used only in the
TyThing. So by reading those fields lazily we may be able to save the
work of ever having to deserialize them (into IfaceType, etc.).

For IfaceData and IfaceClass, loadDecl creates extra implicit bindings
(the constructors and field selectors of the data declaration, or the
methods of the class), whose Names depend on more than just the Name
of the type constructor or class itself. So deserializing them lazily
would be more involved. Similar comments apply to the other
constructors of IfaceDecl with the additional point that they probably
represent a small proportion of all declarations.
-}

instance Binary IfaceFamTyConFlav where
    put_ :: BinHandle -> IfaceFamTyConFlav -> IO ()
put_ bh :: BinHandle
bh IfaceDataFamilyTyCon              = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh IfaceOpenSynFamilyTyCon           = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
    put_ bh :: BinHandle
bh (IfaceClosedSynFamilyTyCon mb :: Maybe (IfaceTopBndr, [IfaceAxBranch])
mb)    = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Maybe (IfaceTopBndr, [IfaceAxBranch]) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe (IfaceTopBndr, [IfaceAxBranch])
mb
    put_ bh :: BinHandle
bh IfaceAbstractClosedSynFamilyTyCon = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3
    put_ _ IfaceBuiltInSynFamTyCon
        = String -> SDoc -> IO ()
forall a. HasCallStack => String -> SDoc -> a
pprPanic "Cannot serialize IfaceBuiltInSynFamTyCon, used for pretty-printing only" SDoc
Outputable.empty

    get :: BinHandle -> IO IfaceFamTyConFlav
get bh :: BinHandle
bh = do { Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
                ; case Word8
h of
                    0 -> IfaceFamTyConFlav -> IO IfaceFamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceFamTyConFlav
IfaceDataFamilyTyCon
                    1 -> IfaceFamTyConFlav -> IO IfaceFamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceFamTyConFlav
IfaceOpenSynFamilyTyCon
                    2 -> do { Maybe (IfaceTopBndr, [IfaceAxBranch])
mb <- BinHandle -> IO (Maybe (IfaceTopBndr, [IfaceAxBranch]))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                            ; IfaceFamTyConFlav -> IO IfaceFamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (IfaceTopBndr, [IfaceAxBranch]) -> IfaceFamTyConFlav
IfaceClosedSynFamilyTyCon Maybe (IfaceTopBndr, [IfaceAxBranch])
mb) }
                    3 -> IfaceFamTyConFlav -> IO IfaceFamTyConFlav
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceFamTyConFlav
IfaceAbstractClosedSynFamilyTyCon
                    _ -> String -> SDoc -> IO IfaceFamTyConFlav
forall a. HasCallStack => String -> SDoc -> a
pprPanic "Binary.get(IfaceFamTyConFlav): Invalid tag"
                                  (BranchIndex -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Word8 -> BranchIndex
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
h :: Int)) }

instance Binary IfaceClassOp where
    put_ :: BinHandle -> IfaceClassOp -> IO ()
put_ bh :: BinHandle
bh (IfaceClassOp n :: IfaceTopBndr
n ty :: IfaceType
ty def :: Maybe (DefMethSpec IfaceType)
def) = do
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
n
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ty
        BinHandle -> Maybe (DefMethSpec IfaceType) -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe (DefMethSpec IfaceType)
def
    get :: BinHandle -> IO IfaceClassOp
get bh :: BinHandle
bh = do
        IfaceTopBndr
n   <- BinHandle -> IO IfaceTopBndr
getIfaceTopBndr BinHandle
bh
        IfaceType
ty  <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Maybe (DefMethSpec IfaceType)
def <- BinHandle -> IO (Maybe (DefMethSpec IfaceType))
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceClassOp -> IO IfaceClassOp
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr
-> IfaceType -> Maybe (DefMethSpec IfaceType) -> IfaceClassOp
IfaceClassOp IfaceTopBndr
n IfaceType
ty Maybe (DefMethSpec IfaceType)
def)

instance Binary IfaceAT where
    put_ :: BinHandle -> IfaceAT -> IO ()
put_ bh :: BinHandle
bh (IfaceAT dec :: IfaceDecl
dec defs :: Maybe IfaceType
defs) = do
        BinHandle -> IfaceDecl -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceDecl
dec
        BinHandle -> Maybe IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Maybe IfaceType
defs
    get :: BinHandle -> IO IfaceAT
get bh :: BinHandle
bh = do
        IfaceDecl
dec  <- BinHandle -> IO IfaceDecl
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Maybe IfaceType
defs <- BinHandle -> IO (Maybe IfaceType)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceAT -> IO IfaceAT
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceDecl -> Maybe IfaceType -> IfaceAT
IfaceAT IfaceDecl
dec Maybe IfaceType
defs)

instance Binary IfaceAxBranch where
    put_ :: BinHandle -> IfaceAxBranch -> IO ()
put_ bh :: BinHandle
bh (IfaceAxBranch a1 :: [IfaceTvBndr]
a1 a2 :: [IfaceTvBndr]
a2 a3 :: [IfaceTvBndr]
a3 a4 :: IfaceAppArgs
a4 a5 :: [Role]
a5 a6 :: IfaceType
a6 a7 :: [BranchIndex]
a7) = do
        BinHandle -> [IfaceTvBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTvBndr]
a1
        BinHandle -> [IfaceTvBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTvBndr]
a2
        BinHandle -> [IfaceTvBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTvBndr]
a3
        BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
a4
        BinHandle -> [Role] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Role]
a5
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
a6
        BinHandle -> [BranchIndex] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [BranchIndex]
a7
    get :: BinHandle -> IO IfaceAxBranch
get bh :: BinHandle
bh = do
        [IfaceTvBndr]
a1 <- BinHandle -> IO [IfaceTvBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceTvBndr]
a2 <- BinHandle -> IO [IfaceTvBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceTvBndr]
a3 <- BinHandle -> IO [IfaceTvBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceAppArgs
a4 <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [Role]
a5 <- BinHandle -> IO [Role]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceType
a6 <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [BranchIndex]
a7 <- BinHandle -> IO [BranchIndex]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceAxBranch -> IO IfaceAxBranch
forall (m :: * -> *) a. Monad m => a -> m a
return ([IfaceTvBndr]
-> [IfaceTvBndr]
-> [IfaceTvBndr]
-> IfaceAppArgs
-> [Role]
-> IfaceType
-> [BranchIndex]
-> IfaceAxBranch
IfaceAxBranch [IfaceTvBndr]
a1 [IfaceTvBndr]
a2 [IfaceTvBndr]
a3 IfaceAppArgs
a4 [Role]
a5 IfaceType
a6 [BranchIndex]
a7)

instance Binary IfaceConDecls where
    put_ :: BinHandle -> IfaceConDecls -> IO ()
put_ bh :: BinHandle
bh IfAbstractTyCon  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh (IfDataTyCon cs :: [IfaceConDecl]
cs) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [IfaceConDecl] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceConDecl]
cs
    put_ bh :: BinHandle
bh (IfNewTyCon c :: IfaceConDecl
c)   = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceConDecl -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceConDecl
c
    get :: BinHandle -> IO IfaceConDecls
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> IfaceConDecls -> IO IfaceConDecls
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceConDecls
IfAbstractTyCon
            1 -> ([IfaceConDecl] -> IfaceConDecls)
-> IO [IfaceConDecl] -> IO IfaceConDecls
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [IfaceConDecl] -> IfaceConDecls
IfDataTyCon (BinHandle -> IO [IfaceConDecl]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
            2 -> (IfaceConDecl -> IfaceConDecls)
-> IO IfaceConDecl -> IO IfaceConDecls
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IfaceConDecl -> IfaceConDecls
IfNewTyCon (BinHandle -> IO IfaceConDecl
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
            _ -> String -> IO IfaceConDecls
forall a. HasCallStack => String -> a
error "Binary(IfaceConDecls).get: Invalid IfaceConDecls"

instance Binary IfaceConDecl where
    put_ :: BinHandle -> IfaceConDecl -> IO ()
put_ bh :: BinHandle
bh (IfCon a1 :: IfaceTopBndr
a1 a2 :: Bool
a2 a3 :: Bool
a3 a4 :: [IfaceBndr]
a4 a5 :: [IfaceForAllBndr]
a5 a6 :: [IfaceTvBndr]
a6 a7 :: IfaceContext
a7 a8 :: IfaceContext
a8 a9 :: [FieldLabel]
a9 a10 :: [IfaceBang]
a10 a11 :: [IfaceSrcBang]
a11) = do
        BinHandle -> IfaceTopBndr -> IO ()
putIfaceTopBndr BinHandle
bh IfaceTopBndr
a1
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
a2
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
a3
        BinHandle -> [IfaceBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceBndr]
a4
        BinHandle -> [IfaceForAllBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceForAllBndr]
a5
        BinHandle -> [IfaceTvBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTvBndr]
a6
        BinHandle -> IfaceContext -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceContext
a7
        BinHandle -> IfaceContext -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceContext
a8
        BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ([FieldLabel] -> BranchIndex
forall (t :: * -> *) a. Foldable t => t a -> BranchIndex
length [FieldLabel]
a9)
        (FieldLabel -> IO ()) -> [FieldLabel] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (BinHandle -> FieldLabel -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh) [FieldLabel]
a9
        BinHandle -> [IfaceBang] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceBang]
a10
        BinHandle -> [IfaceSrcBang] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceSrcBang]
a11
    get :: BinHandle -> IO IfaceConDecl
get bh :: BinHandle
bh = do
        IfaceTopBndr
a1 <- BinHandle -> IO IfaceTopBndr
getIfaceTopBndr BinHandle
bh
        Bool
a2 <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Bool
a3 <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceBndr]
a4 <- BinHandle -> IO [IfaceBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceForAllBndr]
a5 <- BinHandle -> IO [IfaceForAllBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceTvBndr]
a6 <- BinHandle -> IO [IfaceTvBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceContext
a7 <- BinHandle -> IO IfaceContext
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceContext
a8 <- BinHandle -> IO IfaceContext
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        BranchIndex
n_fields <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [FieldLabel]
a9 <- BranchIndex -> IO FieldLabel -> IO [FieldLabel]
forall (m :: * -> *) a.
Applicative m =>
BranchIndex -> m a -> m [a]
replicateM BranchIndex
n_fields (BinHandle -> IO FieldLabel
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh)
        [IfaceBang]
a10 <- BinHandle -> IO [IfaceBang]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceSrcBang]
a11 <- BinHandle -> IO [IfaceSrcBang]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceConDecl -> IO IfaceConDecl
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr
-> Bool
-> Bool
-> [IfaceBndr]
-> [IfaceForAllBndr]
-> [IfaceTvBndr]
-> IfaceContext
-> IfaceContext
-> [FieldLabel]
-> [IfaceBang]
-> [IfaceSrcBang]
-> IfaceConDecl
IfCon IfaceTopBndr
a1 Bool
a2 Bool
a3 [IfaceBndr]
a4 [IfaceForAllBndr]
a5 [IfaceTvBndr]
a6 IfaceContext
a7 IfaceContext
a8 [FieldLabel]
a9 [IfaceBang]
a10 [IfaceSrcBang]
a11)

instance Binary IfaceBang where
    put_ :: BinHandle -> IfaceBang -> IO ()
put_ bh :: BinHandle
bh IfNoBang        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh IfStrict        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
    put_ bh :: BinHandle
bh IfUnpack        = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
    put_ bh :: BinHandle
bh (IfUnpackCo co :: IfaceCoercion
co) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
co

    get :: BinHandle -> IO IfaceBang
get bh :: BinHandle
bh = do
            Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
            case Word8
h of
              0 -> do IfaceBang -> IO IfaceBang
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceBang
IfNoBang
              1 -> do IfaceBang -> IO IfaceBang
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceBang
IfStrict
              2 -> do IfaceBang -> IO IfaceBang
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceBang
IfUnpack
              _ -> do { IfaceCoercion
a <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceBang -> IO IfaceBang
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IfaceBang
IfUnpackCo IfaceCoercion
a) }

instance Binary IfaceSrcBang where
    put_ :: BinHandle -> IfaceSrcBang -> IO ()
put_ bh :: BinHandle
bh (IfSrcBang a1 :: SrcUnpackedness
a1 a2 :: SrcStrictness
a2) =
      do BinHandle -> SrcUnpackedness -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SrcUnpackedness
a1
         BinHandle -> SrcStrictness -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh SrcStrictness
a2

    get :: BinHandle -> IO IfaceSrcBang
get bh :: BinHandle
bh =
      do SrcUnpackedness
a1 <- BinHandle -> IO SrcUnpackedness
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
         SrcStrictness
a2 <- BinHandle -> IO SrcStrictness
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
         IfaceSrcBang -> IO IfaceSrcBang
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcUnpackedness -> SrcStrictness -> IfaceSrcBang
IfSrcBang SrcUnpackedness
a1 SrcStrictness
a2)

instance Binary IfaceClsInst where
    put_ :: BinHandle -> IfaceClsInst -> IO ()
put_ bh :: BinHandle
bh (IfaceClsInst cls :: IfaceTopBndr
cls tys :: [Maybe IfaceTyCon]
tys dfun :: IfaceTopBndr
dfun flag :: OverlapFlag
flag orph :: IsOrphan
orph) = do
        BinHandle -> IfaceTopBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTopBndr
cls
        BinHandle -> [Maybe IfaceTyCon] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Maybe IfaceTyCon]
tys
        BinHandle -> IfaceTopBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTopBndr
dfun
        BinHandle -> OverlapFlag -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh OverlapFlag
flag
        BinHandle -> IsOrphan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IsOrphan
orph
    get :: BinHandle -> IO IfaceClsInst
get bh :: BinHandle
bh = do
        IfaceTopBndr
cls  <- BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [Maybe IfaceTyCon]
tys  <- BinHandle -> IO [Maybe IfaceTyCon]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceTopBndr
dfun <- BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        OverlapFlag
flag <- BinHandle -> IO OverlapFlag
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IsOrphan
orph <- BinHandle -> IO IsOrphan
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceClsInst -> IO IfaceClsInst
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr
-> [Maybe IfaceTyCon]
-> IfaceTopBndr
-> OverlapFlag
-> IsOrphan
-> IfaceClsInst
IfaceClsInst IfaceTopBndr
cls [Maybe IfaceTyCon]
tys IfaceTopBndr
dfun OverlapFlag
flag IsOrphan
orph)

instance Binary IfaceFamInst where
    put_ :: BinHandle -> IfaceFamInst -> IO ()
put_ bh :: BinHandle
bh (IfaceFamInst fam :: IfaceTopBndr
fam tys :: [Maybe IfaceTyCon]
tys name :: IfaceTopBndr
name orph :: IsOrphan
orph) = do
        BinHandle -> IfaceTopBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTopBndr
fam
        BinHandle -> [Maybe IfaceTyCon] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [Maybe IfaceTyCon]
tys
        BinHandle -> IfaceTopBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTopBndr
name
        BinHandle -> IsOrphan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IsOrphan
orph
    get :: BinHandle -> IO IfaceFamInst
get bh :: BinHandle
bh = do
        IfaceTopBndr
fam      <- BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [Maybe IfaceTyCon]
tys      <- BinHandle -> IO [Maybe IfaceTyCon]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceTopBndr
name     <- BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IsOrphan
orph     <- BinHandle -> IO IsOrphan
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceFamInst -> IO IfaceFamInst
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr
-> [Maybe IfaceTyCon] -> IfaceTopBndr -> IsOrphan -> IfaceFamInst
IfaceFamInst IfaceTopBndr
fam [Maybe IfaceTyCon]
tys IfaceTopBndr
name IsOrphan
orph)

instance Binary IfaceRule where
    put_ :: BinHandle -> IfaceRule -> IO ()
put_ bh :: BinHandle
bh (IfaceRule a1 :: IfLclName
a1 a2 :: Activation
a2 a3 :: [IfaceBndr]
a3 a4 :: IfaceTopBndr
a4 a5 :: [IfaceExpr]
a5 a6 :: IfaceExpr
a6 a7 :: Bool
a7 a8 :: IsOrphan
a8) = do
        BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
a1
        BinHandle -> Activation -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Activation
a2
        BinHandle -> [IfaceBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceBndr]
a3
        BinHandle -> IfaceTopBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTopBndr
a4
        BinHandle -> [IfaceExpr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceExpr]
a5
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
a6
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
a7
        BinHandle -> IsOrphan -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IsOrphan
a8
    get :: BinHandle -> IO IfaceRule
get bh :: BinHandle
bh = do
        IfLclName
a1 <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Activation
a2 <- BinHandle -> IO Activation
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceBndr]
a3 <- BinHandle -> IO [IfaceBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceTopBndr
a4 <- BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        [IfaceExpr]
a5 <- BinHandle -> IO [IfaceExpr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceExpr
a6 <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        Bool
a7 <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IsOrphan
a8 <- BinHandle -> IO IsOrphan
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceRule -> IO IfaceRule
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName
-> Activation
-> [IfaceBndr]
-> IfaceTopBndr
-> [IfaceExpr]
-> IfaceExpr
-> Bool
-> IsOrphan
-> IfaceRule
IfaceRule IfLclName
a1 Activation
a2 [IfaceBndr]
a3 IfaceTopBndr
a4 [IfaceExpr]
a5 IfaceExpr
a6 Bool
a7 IsOrphan
a8)

instance Binary IfaceAnnotation where
    put_ :: BinHandle -> IfaceAnnotation -> IO ()
put_ bh :: BinHandle
bh (IfaceAnnotation a1 :: IfaceAnnTarget
a1 a2 :: AnnPayload
a2) = do
        BinHandle -> IfaceAnnTarget -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAnnTarget
a1
        BinHandle -> AnnPayload -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh AnnPayload
a2
    get :: BinHandle -> IO IfaceAnnotation
get bh :: BinHandle
bh = do
        IfaceAnnTarget
a1 <- BinHandle -> IO IfaceAnnTarget
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        AnnPayload
a2 <- BinHandle -> IO AnnPayload
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
        IfaceAnnotation -> IO IfaceAnnotation
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceAnnTarget -> AnnPayload -> IfaceAnnotation
IfaceAnnotation IfaceAnnTarget
a1 AnnPayload
a2)

instance Binary IfaceIdDetails where
    put_ :: BinHandle -> IfaceIdDetails -> IO ()
put_ bh :: BinHandle
bh IfVanillaId      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh (IfRecSelId a :: Either IfaceTyCon IfaceDecl
a b :: Bool
b) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Either IfaceTyCon IfaceDecl -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Either IfaceTyCon IfaceDecl
a IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b
    put_ bh :: BinHandle
bh IfDFunId         = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
    get :: BinHandle -> IO IfaceIdDetails
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> IfaceIdDetails -> IO IfaceIdDetails
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceIdDetails
IfVanillaId
            1 -> do { Either IfaceTyCon IfaceDecl
a <- BinHandle -> IO (Either IfaceTyCon IfaceDecl)
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; Bool
b <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceIdDetails -> IO IfaceIdDetails
forall (m :: * -> *) a. Monad m => a -> m a
return (Either IfaceTyCon IfaceDecl -> Bool -> IfaceIdDetails
IfRecSelId Either IfaceTyCon IfaceDecl
a Bool
b) }
            _ -> IfaceIdDetails -> IO IfaceIdDetails
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceIdDetails
IfDFunId

instance Binary IfaceIdInfo where
    put_ :: BinHandle -> IfaceIdInfo -> IO ()
put_ bh :: BinHandle
bh NoInfo      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh (HasInfo i :: [IfaceInfoItem]
i) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [IfaceInfoItem] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
lazyPut BinHandle
bh [IfaceInfoItem]
i -- NB lazyPut

    get :: BinHandle -> IO IfaceIdInfo
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> IfaceIdInfo -> IO IfaceIdInfo
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceIdInfo
NoInfo
            _ -> ([IfaceInfoItem] -> IfaceIdInfo)
-> IO [IfaceInfoItem] -> IO IfaceIdInfo
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [IfaceInfoItem] -> IfaceIdInfo
HasInfo (IO [IfaceInfoItem] -> IO IfaceIdInfo)
-> IO [IfaceInfoItem] -> IO IfaceIdInfo
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO [IfaceInfoItem]
forall a. Binary a => BinHandle -> IO a
lazyGet BinHandle
bh    -- NB lazyGet

instance Binary IfaceInfoItem where
    put_ :: BinHandle -> IfaceInfoItem -> IO ()
put_ bh :: BinHandle
bh (HsArity aa :: BranchIndex
aa)          = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
aa
    put_ bh :: BinHandle
bh (HsStrictness ab :: StrictSig
ab)     = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> StrictSig -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh StrictSig
ab
    put_ bh :: BinHandle
bh (HsUnfold lb :: Bool
lb ad :: IfaceUnfolding
ad)      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
lb IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceUnfolding -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceUnfolding
ad
    put_ bh :: BinHandle
bh (HsInline ad :: InlinePragma
ad)         = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> InlinePragma -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh InlinePragma
ad
    put_ bh :: BinHandle
bh HsNoCafRefs           = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 4
    put_ bh :: BinHandle
bh HsLevity              = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 5
    get :: BinHandle -> IO IfaceInfoItem
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> (BranchIndex -> IfaceInfoItem)
-> IO BranchIndex -> IO IfaceInfoItem
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM BranchIndex -> IfaceInfoItem
HsArity (IO BranchIndex -> IO IfaceInfoItem)
-> IO BranchIndex -> IO IfaceInfoItem
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
            1 -> (StrictSig -> IfaceInfoItem) -> IO StrictSig -> IO IfaceInfoItem
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM StrictSig -> IfaceInfoItem
HsStrictness (IO StrictSig -> IO IfaceInfoItem)
-> IO StrictSig -> IO IfaceInfoItem
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO StrictSig
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
            2 -> do Bool
lb <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceUnfolding
ad <- BinHandle -> IO IfaceUnfolding
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceInfoItem -> IO IfaceInfoItem
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IfaceUnfolding -> IfaceInfoItem
HsUnfold Bool
lb IfaceUnfolding
ad)
            3 -> (InlinePragma -> IfaceInfoItem)
-> IO InlinePragma -> IO IfaceInfoItem
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM InlinePragma -> IfaceInfoItem
HsInline (IO InlinePragma -> IO IfaceInfoItem)
-> IO InlinePragma -> IO IfaceInfoItem
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO InlinePragma
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
            4 -> IfaceInfoItem -> IO IfaceInfoItem
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceInfoItem
HsNoCafRefs
            _ -> IfaceInfoItem -> IO IfaceInfoItem
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceInfoItem
HsLevity

instance Binary IfaceUnfolding where
    put_ :: BinHandle -> IfaceUnfolding -> IO ()
put_ bh :: BinHandle
bh (IfCoreUnfold s :: Bool
s e :: IfaceExpr
e) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
s
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
e
    put_ bh :: BinHandle
bh (IfInlineRule a :: BranchIndex
a b :: Bool
b c :: Bool
c d :: IfaceExpr
d) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
        BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
a
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
b
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
c
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
d
    put_ bh :: BinHandle
bh (IfDFunUnfold as :: [IfaceBndr]
as bs :: [IfaceExpr]
bs) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
        BinHandle -> [IfaceBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceBndr]
as
        BinHandle -> [IfaceExpr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceExpr]
bs
    put_ bh :: BinHandle
bh (IfCompulsory e :: IfaceExpr
e) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
e
    get :: BinHandle -> IO IfaceUnfolding
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> do Bool
s <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr
e <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceUnfolding -> IO IfaceUnfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IfaceExpr -> IfaceUnfolding
IfCoreUnfold Bool
s IfaceExpr
e)
            1 -> do BranchIndex
a <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Bool
b <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Bool
c <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr
d <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceUnfolding -> IO IfaceUnfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (BranchIndex -> Bool -> Bool -> IfaceExpr -> IfaceUnfolding
IfInlineRule BranchIndex
a Bool
b Bool
c IfaceExpr
d)
            2 -> do [IfaceBndr]
as <- BinHandle -> IO [IfaceBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceExpr]
bs <- BinHandle -> IO [IfaceExpr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceUnfolding -> IO IfaceUnfolding
forall (m :: * -> *) a. Monad m => a -> m a
return ([IfaceBndr] -> [IfaceExpr] -> IfaceUnfolding
IfDFunUnfold [IfaceBndr]
as [IfaceExpr]
bs)
            _ -> do IfaceExpr
e <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceUnfolding -> IO IfaceUnfolding
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceExpr -> IfaceUnfolding
IfCompulsory IfaceExpr
e)


instance Binary IfaceExpr where
    put_ :: BinHandle -> IfaceExpr -> IO ()
put_ bh :: BinHandle
bh (IfaceLcl aa :: IfLclName
aa) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
        BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
aa
    put_ bh :: BinHandle
bh (IfaceType ab :: IfaceType
ab) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
ab
    put_ bh :: BinHandle
bh (IfaceCo ab :: IfaceCoercion
ab) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
        BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
ab
    put_ bh :: BinHandle
bh (IfaceTuple ac :: TupleSort
ac ad :: [IfaceExpr]
ad) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 3
        BinHandle -> TupleSort -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh TupleSort
ac
        BinHandle -> [IfaceExpr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceExpr]
ad
    put_ bh :: BinHandle
bh (IfaceLam (ae :: IfaceBndr
ae, os :: IfaceOneShot
os) af :: IfaceExpr
af) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 4
        BinHandle -> IfaceBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceBndr
ae
        BinHandle -> IfaceOneShot -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceOneShot
os
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
af
    put_ bh :: BinHandle
bh (IfaceApp ag :: IfaceExpr
ag ah :: IfaceExpr
ah) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 5
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
ag
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
ah
    put_ bh :: BinHandle
bh (IfaceCase ai :: IfaceExpr
ai aj :: IfLclName
aj ak :: [IfaceAlt]
ak) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 6
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
ai
        BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
aj
        BinHandle -> [IfaceAlt] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceAlt]
ak
    put_ bh :: BinHandle
bh (IfaceLet al :: IfaceBinding
al am :: IfaceExpr
am) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 7
        BinHandle -> IfaceBinding -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceBinding
al
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
am
    put_ bh :: BinHandle
bh (IfaceTick an :: IfaceTickish
an ao :: IfaceExpr
ao) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 8
        BinHandle -> IfaceTickish -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTickish
an
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
ao
    put_ bh :: BinHandle
bh (IfaceLit ap :: Literal
ap) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 9
        BinHandle -> Literal -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Literal
ap
    put_ bh :: BinHandle
bh (IfaceFCall as :: ForeignCall
as at :: IfaceType
at) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 10
        BinHandle -> ForeignCall -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh ForeignCall
as
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
at
    put_ bh :: BinHandle
bh (IfaceExt aa :: IfaceTopBndr
aa) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 11
        BinHandle -> IfaceTopBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTopBndr
aa
    put_ bh :: BinHandle
bh (IfaceCast ie :: IfaceExpr
ie ico :: IfaceCoercion
ico) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 12
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
ie
        BinHandle -> IfaceCoercion -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceCoercion
ico
    put_ bh :: BinHandle
bh (IfaceECase a :: IfaceExpr
a b :: IfaceType
b) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 13
        BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
a
        BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
b
    get :: BinHandle -> IO IfaceExpr
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> do IfLclName
aa <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName -> IfaceExpr
IfaceLcl IfLclName
aa)
            1 -> do IfaceType
ab <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceType -> IfaceExpr
IfaceType IfaceType
ab)
            2 -> do IfaceCoercion
ab <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceCoercion -> IfaceExpr
IfaceCo IfaceCoercion
ab)
            3 -> do TupleSort
ac <- BinHandle -> IO TupleSort
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceExpr]
ad <- BinHandle -> IO [IfaceExpr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (TupleSort -> [IfaceExpr] -> IfaceExpr
IfaceTuple TupleSort
ac [IfaceExpr]
ad)
            4 -> do IfaceBndr
ae <- BinHandle -> IO IfaceBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceOneShot
os <- BinHandle -> IO IfaceOneShot
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr
af <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceLamBndr -> IfaceExpr -> IfaceExpr
IfaceLam (IfaceBndr
ae, IfaceOneShot
os) IfaceExpr
af)
            5 -> do IfaceExpr
ag <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr
ah <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceExpr -> IfaceExpr -> IfaceExpr
IfaceApp IfaceExpr
ag IfaceExpr
ah)
            6 -> do IfaceExpr
ai <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfLclName
aj <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    [IfaceAlt]
ak <- BinHandle -> IO [IfaceAlt]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceExpr -> IfLclName -> [IfaceAlt] -> IfaceExpr
IfaceCase IfaceExpr
ai IfLclName
aj [IfaceAlt]
ak)
            7 -> do IfaceBinding
al <- BinHandle -> IO IfaceBinding
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr
am <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceBinding -> IfaceExpr -> IfaceExpr
IfaceLet IfaceBinding
al IfaceExpr
am)
            8 -> do IfaceTickish
an <- BinHandle -> IO IfaceTickish
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr
ao <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTickish -> IfaceExpr -> IfaceExpr
IfaceTick IfaceTickish
an IfaceExpr
ao)
            9 -> do Literal
ap <- BinHandle -> IO Literal
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (Literal -> IfaceExpr
IfaceLit Literal
ap)
            10 -> do ForeignCall
as <- BinHandle -> IO ForeignCall
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                     IfaceType
at <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                     IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignCall -> IfaceType -> IfaceExpr
IfaceFCall ForeignCall
as IfaceType
at)
            11 -> do IfaceTopBndr
aa <- BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                     IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTopBndr -> IfaceExpr
IfaceExt IfaceTopBndr
aa)
            12 -> do IfaceExpr
ie <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                     IfaceCoercion
ico <- BinHandle -> IO IfaceCoercion
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                     IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceExpr -> IfaceCoercion -> IfaceExpr
IfaceCast IfaceExpr
ie IfaceCoercion
ico)
            13 -> do IfaceExpr
a <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                     IfaceType
b <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                     IfaceExpr -> IO IfaceExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceExpr -> IfaceType -> IfaceExpr
IfaceECase IfaceExpr
a IfaceType
b)
            _ -> String -> IO IfaceExpr
forall a. String -> a
panic ("get IfaceExpr " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
h)

instance Binary IfaceTickish where
    put_ :: BinHandle -> IfaceTickish -> IO ()
put_ bh :: BinHandle
bh (IfaceHpcTick m :: Module
m ix :: BranchIndex
ix) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
        BinHandle -> Module -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Module
m
        BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
ix
    put_ bh :: BinHandle
bh (IfaceSCC cc :: CostCentre
cc tick :: Bool
tick push :: Bool
push) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
        BinHandle -> CostCentre -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CostCentre
cc
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
tick
        BinHandle -> Bool -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Bool
push
    put_ bh :: BinHandle
bh (IfaceSource src :: RealSrcSpan
src name :: String
name) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2
        BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> IfLclName
srcSpanFile RealSrcSpan
src)
        BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> BranchIndex
srcSpanStartLine RealSrcSpan
src)
        BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> BranchIndex
srcSpanStartCol RealSrcSpan
src)
        BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> BranchIndex
srcSpanEndLine RealSrcSpan
src)
        BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh (RealSrcSpan -> BranchIndex
srcSpanEndCol RealSrcSpan
src)
        BinHandle -> String -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh String
name

    get :: BinHandle -> IO IfaceTickish
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> do Module
m <- BinHandle -> IO Module
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    BranchIndex
ix <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceTickish -> IO IfaceTickish
forall (m :: * -> *) a. Monad m => a -> m a
return (Module -> BranchIndex -> IfaceTickish
IfaceHpcTick Module
m BranchIndex
ix)
            1 -> do CostCentre
cc <- BinHandle -> IO CostCentre
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Bool
tick <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    Bool
push <- BinHandle -> IO Bool
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceTickish -> IO IfaceTickish
forall (m :: * -> *) a. Monad m => a -> m a
return (CostCentre -> Bool -> Bool -> IfaceTickish
IfaceSCC CostCentre
cc Bool
tick Bool
push)
            2 -> do IfLclName
file <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    BranchIndex
sl <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    BranchIndex
sc <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    BranchIndex
el <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    BranchIndex
ec <- BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    let start :: RealSrcLoc
start = IfLclName -> BranchIndex -> BranchIndex -> RealSrcLoc
mkRealSrcLoc IfLclName
file BranchIndex
sl BranchIndex
sc
                        end :: RealSrcLoc
end = IfLclName -> BranchIndex -> BranchIndex -> RealSrcLoc
mkRealSrcLoc IfLclName
file BranchIndex
el BranchIndex
ec
                    String
name <- BinHandle -> IO String
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                    IfaceTickish -> IO IfaceTickish
forall (m :: * -> *) a. Monad m => a -> m a
return (RealSrcSpan -> String -> IfaceTickish
IfaceSource (RealSrcLoc -> RealSrcLoc -> RealSrcSpan
mkRealSrcSpan RealSrcLoc
start RealSrcLoc
end) String
name)
            _ -> String -> IO IfaceTickish
forall a. String -> a
panic ("get IfaceTickish " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
h)

instance Binary IfaceConAlt where
    put_ :: BinHandle -> IfaceConAlt -> IO ()
put_ bh :: BinHandle
bh IfaceDefault      = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh (IfaceDataAlt aa :: IfaceTopBndr
aa) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceTopBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTopBndr
aa
    put_ bh :: BinHandle
bh (IfaceLitAlt ac :: Literal
ac)  = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 2 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> Literal -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Literal
ac
    get :: BinHandle -> IO IfaceConAlt
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> IfaceConAlt -> IO IfaceConAlt
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceConAlt
IfaceDefault
            1 -> (IfaceTopBndr -> IfaceConAlt) -> IO IfaceTopBndr -> IO IfaceConAlt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM IfaceTopBndr -> IfaceConAlt
IfaceDataAlt (IO IfaceTopBndr -> IO IfaceConAlt)
-> IO IfaceTopBndr -> IO IfaceConAlt
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
            _ -> (Literal -> IfaceConAlt) -> IO Literal -> IO IfaceConAlt
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM Literal -> IfaceConAlt
IfaceLitAlt  (IO Literal -> IO IfaceConAlt) -> IO Literal -> IO IfaceConAlt
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO Literal
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary IfaceBinding where
    put_ :: BinHandle -> IfaceBinding -> IO ()
put_ bh :: BinHandle
bh (IfaceNonRec aa :: IfaceLetBndr
aa ab :: IfaceExpr
ab) = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceLetBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceLetBndr
aa IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceExpr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceExpr
ab
    put_ bh :: BinHandle
bh (IfaceRec ac :: [(IfaceLetBndr, IfaceExpr)]
ac)       = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1 IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> [(IfaceLetBndr, IfaceExpr)] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [(IfaceLetBndr, IfaceExpr)]
ac
    get :: BinHandle -> IO IfaceBinding
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> do { IfaceLetBndr
aa <- BinHandle -> IO IfaceLetBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceExpr
ab <- BinHandle -> IO IfaceExpr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceBinding -> IO IfaceBinding
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceLetBndr -> IfaceExpr -> IfaceBinding
IfaceNonRec IfaceLetBndr
aa IfaceExpr
ab) }
            _ -> do { [(IfaceLetBndr, IfaceExpr)]
ac <- BinHandle -> IO [(IfaceLetBndr, IfaceExpr)]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh; IfaceBinding -> IO IfaceBinding
forall (m :: * -> *) a. Monad m => a -> m a
return ([(IfaceLetBndr, IfaceExpr)] -> IfaceBinding
IfaceRec [(IfaceLetBndr, IfaceExpr)]
ac) }

instance Binary IfaceLetBndr where
    put_ :: BinHandle -> IfaceLetBndr -> IO ()
put_ bh :: BinHandle
bh (IfLetBndr a :: IfLclName
a b :: IfaceType
b c :: IfaceIdInfo
c d :: IfaceJoinInfo
d) = do
            BinHandle -> IfLclName -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfLclName
a
            BinHandle -> IfaceType -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceType
b
            BinHandle -> IfaceIdInfo -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceIdInfo
c
            BinHandle -> IfaceJoinInfo -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceJoinInfo
d
    get :: BinHandle -> IO IfaceLetBndr
get bh :: BinHandle
bh = do IfLclName
a <- BinHandle -> IO IfLclName
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                IfaceType
b <- BinHandle -> IO IfaceType
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                IfaceIdInfo
c <- BinHandle -> IO IfaceIdInfo
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                IfaceJoinInfo
d <- BinHandle -> IO IfaceJoinInfo
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                IfaceLetBndr -> IO IfaceLetBndr
forall (m :: * -> *) a. Monad m => a -> m a
return (IfLclName
-> IfaceType -> IfaceIdInfo -> IfaceJoinInfo -> IfaceLetBndr
IfLetBndr IfLclName
a IfaceType
b IfaceIdInfo
c IfaceJoinInfo
d)

instance Binary IfaceJoinInfo where
    put_ :: BinHandle -> IfaceJoinInfo -> IO ()
put_ bh :: BinHandle
bh IfaceNotJoinPoint = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh (IfaceJoinPoint ar :: BranchIndex
ar) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
        BinHandle -> BranchIndex -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh BranchIndex
ar
    get :: BinHandle -> IO IfaceJoinInfo
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> IfaceJoinInfo -> IO IfaceJoinInfo
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceJoinInfo
IfaceNotJoinPoint
            _ -> (BranchIndex -> IfaceJoinInfo)
-> IO BranchIndex -> IO IfaceJoinInfo
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM BranchIndex -> IfaceJoinInfo
IfaceJoinPoint (IO BranchIndex -> IO IfaceJoinInfo)
-> IO BranchIndex -> IO IfaceJoinInfo
forall a b. (a -> b) -> a -> b
$ BinHandle -> IO BranchIndex
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh

instance Binary IfaceTyConParent where
    put_ :: BinHandle -> IfaceTyConParent -> IO ()
put_ bh :: BinHandle
bh IfNoParent = BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 0
    put_ bh :: BinHandle
bh (IfDataInstance ax :: IfaceTopBndr
ax pr :: IfaceTyCon
pr ty :: IfaceAppArgs
ty) = do
        BinHandle -> Word8 -> IO ()
putByte BinHandle
bh 1
        BinHandle -> IfaceTopBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTopBndr
ax
        BinHandle -> IfaceTyCon -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTyCon
pr
        BinHandle -> IfaceAppArgs -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceAppArgs
ty
    get :: BinHandle -> IO IfaceTyConParent
get bh :: BinHandle
bh = do
        Word8
h <- BinHandle -> IO Word8
getByte BinHandle
bh
        case Word8
h of
            0 -> IfaceTyConParent -> IO IfaceTyConParent
forall (m :: * -> *) a. Monad m => a -> m a
return IfaceTyConParent
IfNoParent
            _ -> do
                IfaceTopBndr
ax <- BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                IfaceTyCon
pr <- BinHandle -> IO IfaceTyCon
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                IfaceAppArgs
ty <- BinHandle -> IO IfaceAppArgs
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
                IfaceTyConParent -> IO IfaceTyConParent
forall (m :: * -> *) a. Monad m => a -> m a
return (IfaceTyConParent -> IO IfaceTyConParent)
-> IfaceTyConParent -> IO IfaceTyConParent
forall a b. (a -> b) -> a -> b
$ IfaceTopBndr -> IfaceTyCon -> IfaceAppArgs -> IfaceTyConParent
IfDataInstance IfaceTopBndr
ax IfaceTyCon
pr IfaceAppArgs
ty

instance Binary IfaceCompleteMatch where
  put_ :: BinHandle -> IfaceCompleteMatch -> IO ()
put_ bh :: BinHandle
bh (IfaceCompleteMatch cs :: [IfaceTopBndr]
cs ts :: IfaceTopBndr
ts) = BinHandle -> [IfaceTopBndr] -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [IfaceTopBndr]
cs IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> BinHandle -> IfaceTopBndr -> IO ()
forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh IfaceTopBndr
ts
  get :: BinHandle -> IO IfaceCompleteMatch
get bh :: BinHandle
bh = [IfaceTopBndr] -> IfaceTopBndr -> IfaceCompleteMatch
IfaceCompleteMatch ([IfaceTopBndr] -> IfaceTopBndr -> IfaceCompleteMatch)
-> IO [IfaceTopBndr] -> IO (IfaceTopBndr -> IfaceCompleteMatch)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BinHandle -> IO [IfaceTopBndr]
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh IO (IfaceTopBndr -> IfaceCompleteMatch)
-> IO IfaceTopBndr -> IO IfaceCompleteMatch
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> BinHandle -> IO IfaceTopBndr
forall a. Binary a => BinHandle -> IO a
get BinHandle
bh