IfaceSyn.hs 72.7 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1993-1998
-}
5

6
{-# LANGUAGE CPP #-}
Ian Lynagh's avatar
Ian Lynagh committed
7

8
module IfaceSyn (
dterei's avatar
dterei committed
9
        module IfaceType,
10

11
        IfaceDecl(..), IfaceFamTyConFlav(..), IfaceClassOp(..), IfaceAT(..),
12
        IfaceConDecl(..), IfaceConDecls(..), IfaceEqSpec,
13
        IfaceExpr(..), IfaceAlt, IfaceLetBndr(..),
dterei's avatar
dterei committed
14 15 16
        IfaceBinding(..), IfaceConAlt(..),
        IfaceIdInfo(..), IfaceIdDetails(..), IfaceUnfolding(..),
        IfaceInfoItem(..), IfaceRule(..), IfaceAnnotation(..), IfaceAnnTarget,
17
        IfaceClsInst(..), IfaceFamInst(..), IfaceTickish(..),
18 19 20
        IfaceBang(..),
        IfaceSrcBang(..), SrcUnpackedness(..), SrcStrictness(..),
        IfaceAxBranch(..),
21
        IfaceTyConParent(..),
22

dterei's avatar
dterei committed
23
        -- Misc
24
        ifaceDeclImplicitBndrs, visibleIfConDecls,
25
        ifaceConDeclFields,
26
        ifaceDeclFingerprints,
27

28
        -- Free Names
29
        freeNamesIfDecl, freeNamesIfRule, freeNamesIfFamInst,
30

dterei's avatar
dterei committed
31
        -- Pretty printing
32 33 34
        pprIfaceExpr,
        pprIfaceDecl,
        ShowSub(..), ShowHowMuch(..)
35 36 37 38 39
    ) where

#include "HsVersions.h"

import IfaceType
40
import PprCore()            -- Printing DFunArgs
41
import Demand
Simon Marlow's avatar
Simon Marlow committed
42
import Class
43
import FieldLabel
dterei's avatar
dterei committed
44
import NameSet
45
import CoAxiom ( BranchIndex )
Simon Marlow's avatar
Simon Marlow committed
46 47 48 49
import Name
import CostCentre
import Literal
import ForeignCall
50
import Annotations( AnnPayload, AnnTarget )
51
import BasicTypes
52 53
import Outputable
import FastString
54
import Module
Peter Wortmann's avatar
Peter Wortmann committed
55
import SrcLoc
56 57
import Fingerprint
import Binary
58
import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
59
import HsBinds
Jan Stolarek's avatar
Jan Stolarek committed
60
import TyCon ( Role (..), Injectivity(..) )
61
import StaticFlags (opt_PprStyle_Debug)
Jan Stolarek's avatar
Jan Stolarek committed
62
import Util( filterOut, filterByList )
63
import InstEnv
64
import DataCon (SrcStrictness(..), SrcUnpackedness(..))
65
import Lexeme (isLexSym)
66

67
import Control.Monad
68
import System.IO.Unsafe
69
import Data.List (find)
70
import Data.Maybe (isJust)
71

72 73
infixl 3 &&&

Austin Seipp's avatar
Austin Seipp committed
74 75 76
{-
************************************************************************
*                                                                      *
77
                    Declarations
Austin Seipp's avatar
Austin Seipp committed
78 79 80
*                                                                      *
************************************************************************
-}
81

82 83 84 85
type IfaceTopBndr = OccName
  -- It's convenient to have an OccName in the IfaceSyn, altough in each
  -- case the namespace is implied by the context. However, having an
  -- OccNames makes things like ifaceDeclImplicitBndrs and ifaceDeclFingerprints
86 87 88
  -- very convenient.
  --
  -- We don't serialise the namespace onto the disk though; rather we
89 90
  -- drop it when serialising and add it back in when deserialising.

dterei's avatar
dterei committed
91
data IfaceDecl
92
  = IfaceId { ifName      :: IfaceTopBndr,
dterei's avatar
dterei committed
93 94 95 96
              ifType      :: IfaceType,
              ifIdDetails :: IfaceIdDetails,
              ifIdInfo    :: IfaceIdInfo }

97
  | IfaceData { ifName       :: IfaceTopBndr,        -- Type constructor
98
                ifCType      :: Maybe CType,    -- C type for CAPI FFI
dterei's avatar
dterei committed
99
                ifTyVars     :: [IfaceTvBndr],  -- Type variables
100
                ifRoles      :: [Role],         -- Roles
dterei's avatar
dterei committed
101
                ifCtxt       :: IfaceContext,   -- The "stupid theta"
102
                ifCons       :: IfaceConDecls,  -- Includes new/data/data family info
dterei's avatar
dterei committed
103
                ifRec        :: RecFlag,        -- Recursive or not?
104
                ifPromotable :: Bool,           -- Promotable to kind level?
dterei's avatar
dterei committed
105 106
                ifGadtSyntax :: Bool,           -- True <=> declared using
                                                -- GADT syntax
107 108
                ifParent     :: IfaceTyConParent -- The axiom, for a newtype,
                                                 -- or data/newtype family instance
109
    }
110

111 112 113 114 115 116 117 118 119
  | IfaceSynonym { ifName    :: IfaceTopBndr,      -- Type constructor
                   ifTyVars  :: [IfaceTvBndr],     -- Type variables
                   ifRoles   :: [Role],            -- Roles
                   ifSynKind :: IfaceKind,         -- Kind of the *rhs* (not of
                                                   -- the tycon)
                   ifSynRhs  :: IfaceType }

  | IfaceFamily  { ifName    :: IfaceTopBndr,      -- Type constructor
                   ifTyVars  :: [IfaceTvBndr],     -- Type variables
Jan Stolarek's avatar
Jan Stolarek committed
120 121 122
                   ifResVar  :: Maybe IfLclName,   -- Result variable name, used
                                                   -- only for pretty-printing
                                                   -- with --show-iface
123 124
                   ifFamKind :: IfaceKind,         -- Kind of the *rhs* (not of
                                                   -- the tycon)
Jan Stolarek's avatar
Jan Stolarek committed
125 126
                   ifFamFlav :: IfaceFamTyConFlav,
                   ifFamInj  :: Injectivity }      -- injectivity information
127

128
  | IfaceClass { ifCtxt    :: IfaceContext,             -- Superclasses
129 130 131 132
                 ifName    :: IfaceTopBndr,             -- Name of the class TyCon
                 ifTyVars  :: [IfaceTvBndr],            -- Type variables
                 ifRoles   :: [Role],                   -- Roles
                 ifFDs     :: [FunDep FastString],      -- Functional dependencies
133 134 135
                 ifATs     :: [IfaceAT],                -- Associated type families
                 ifSigs    :: [IfaceClassOp],           -- Method signatures
                 ifMinDef  :: BooleanFormula IfLclName, -- Minimal complete definition
136 137
                 ifRec     :: RecFlag                   -- Is newtype/datatype associated
                                                        --   with the class recursive?
138 139
    }

140
  | IfaceAxiom { ifName       :: IfaceTopBndr,        -- Axiom name
141
                 ifTyCon      :: IfaceTyCon,     -- LHS TyCon
142
                 ifRole       :: Role,           -- Role of axiom
143 144
                 ifAxBranches :: [IfaceAxBranch] -- Branches
    }
145

146
  | IfacePatSyn { ifName          :: IfaceTopBndr,           -- Name of the pattern synonym
cactus's avatar
cactus committed
147
                  ifPatIsInfix    :: Bool,
148 149
                  ifPatMatcher    :: (IfExtName, Bool),
                  ifPatBuilder    :: Maybe (IfExtName, Bool),
150 151
                  -- Everything below is redundant,
                  -- but needed to implement pprIfaceDecl
cactus's avatar
cactus committed
152 153 154 155
                  ifPatUnivTvs    :: [IfaceTvBndr],
                  ifPatExTvs      :: [IfaceTvBndr],
                  ifPatProvCtxt   :: IfaceContext,
                  ifPatReqCtxt    :: IfaceContext,
156
                  ifPatArgs       :: [IfaceType],
Matthew Pickering's avatar
Matthew Pickering committed
157 158
                  ifPatTy         :: IfaceType,
                  ifFieldLabels   :: [FieldLabel] }
cactus's avatar
cactus committed
159 160


161 162 163 164 165
data IfaceTyConParent
  = IfNoParent
  | IfDataInstance IfExtName
                   IfaceTyCon
                   IfaceTcArgs
166

167
data IfaceFamTyConFlav
168 169
  = IfaceDataFamilyTyCon                      -- Data family
  | IfaceOpenSynFamilyTyCon
170 171 172
  | IfaceClosedSynFamilyTyCon (Maybe (IfExtName, [IfaceAxBranch]))
    -- ^ Name of associated axiom and branches for pretty printing purposes,
    -- or 'Nothing' for an empty closed family without an axiom
173
  | IfaceAbstractClosedSynFamilyTyCon
174
  | IfaceBuiltInSynFamTyCon -- for pretty printing purposes only
175

176
data IfaceClassOp = IfaceClassOp IfaceTopBndr DefMethSpec IfaceType
dterei's avatar
dterei committed
177 178 179
        -- Nothing    => no default method
        -- Just False => ordinary polymorphic default method
        -- Just True  => generic default method
180

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

185

186
-- This is just like CoAxBranch
187
data IfaceAxBranch = IfaceAxBranch { ifaxbTyVars  :: [IfaceTvBndr]
188
                                   , ifaxbLHS     :: IfaceTcArgs
189
                                   , ifaxbRoles   :: [Role]
190 191 192
                                   , ifaxbRHS     :: IfaceType
                                   , ifaxbIncomps :: [BranchIndex] }
                                     -- See Note [Storing compatibility] in CoAxiom
193

194
data IfaceConDecls
195 196 197 198 199 200 201 202 203
  = IfAbstractTyCon Bool                          -- c.f TyCon.AbstractTyCon
  | IfDataTyCon [IfaceConDecl] Bool [FieldLabelString] -- Data type decls
  | IfNewTyCon  IfaceConDecl   Bool [FieldLabelString] -- Newtype decls

-- For IfDataTyCon and IfNewTyCon we store:
--  * the data constructor(s);
--  * a boolean indicating whether DuplicateRecordFields was enabled
--    at the definition site; and
--  * a list of field labels.
204

dterei's avatar
dterei committed
205
data IfaceConDecl
206
  = IfCon {
207
        ifConOcc     :: IfaceTopBndr,                -- Constructor name
dterei's avatar
dterei committed
208 209
        ifConWrapper :: Bool,                   -- True <=> has a wrapper
        ifConInfix   :: Bool,                   -- True <=> declared infix
210 211 212 213 214 215 216

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

217 218 219 220 221 222 223 224 225 226
        ifConExTvs   :: [IfaceTvBndr],      -- Existential tyvars
        ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints
        ifConCtxt    :: IfaceContext,       -- Non-stupid context
        ifConArgTys  :: [IfaceType],        -- Arg types
        ifConFields  :: [IfaceTopBndr],     -- ...ditto... (field labels)
        ifConStricts :: [IfaceBang],
          -- Empty (meaning all lazy),
          -- or 1-1 corresp with arg tys
          -- See Note [Bangs on imported data constructors] in MkId
        ifConSrcStricts :: [IfaceSrcBang] } -- empty meaning no src stricts
dterei's avatar
dterei committed
227

228
type IfaceEqSpec = [(IfLclName,IfaceType)]
229

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

235 236 237 238
-- | This corresponds to HsSrcBang
data IfaceSrcBang
  = IfSrcBang SrcUnpackedness SrcStrictness

239 240 241 242 243
data IfaceClsInst
  = IfaceClsInst { ifInstCls  :: IfExtName,                -- See comments with
                   ifInstTys  :: [Maybe IfaceTyCon],       -- the defn of ClsInst
                   ifDFun     :: IfExtName,                -- The dfun
                   ifOFlag    :: OverlapFlag,              -- Overlap flag
244
                   ifInstOrph :: IsOrphan }                -- See Note [Orphans] in InstEnv
dterei's avatar
dterei committed
245 246 247 248 249 250
        -- 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
251

252
-- The ifFamInstTys field of IfaceFamInst contains a list of the rough
253
-- match types
254
data IfaceFamInst
255
  = IfaceFamInst { ifFamInstFam      :: IfExtName            -- Family name
256
                 , ifFamInstTys      :: [Maybe IfaceTyCon]   -- See above
257
                 , ifFamInstAxiom    :: IfExtName            -- The axiom
258
                 , ifFamInstOrph     :: IsOrphan             -- Just like IfaceClsInst
dterei's avatar
dterei committed
259
                 }
260

261
data IfaceRule
dterei's avatar
dterei committed
262 263 264 265 266 267 268 269
  = IfaceRule {
        ifRuleName   :: RuleName,
        ifActivation :: Activation,
        ifRuleBndrs  :: [IfaceBndr],    -- Tyvars and term vars
        ifRuleHead   :: IfExtName,      -- Head of lhs
        ifRuleArgs   :: [IfaceExpr],    -- Args of LHS
        ifRuleRhs    :: IfaceExpr,
        ifRuleAuto   :: Bool,
270
        ifRuleOrph   :: IsOrphan   -- Just like IfaceClsInst
271 272
    }

273 274 275
data IfaceAnnotation
  = IfaceAnnotation {
        ifAnnotatedTarget :: IfaceAnnTarget,
276
        ifAnnotatedValue  :: AnnPayload
277 278 279 280
  }

type IfaceAnnTarget = AnnTarget OccName

281
-- Here's a tricky case:
282 283
--   * Compile with -O module A, and B which imports A.f
--   * Change function f in A, and recompile without -O
284
--   * When we read in old A.hi we read in its IdInfo (as a thunk)
dterei's avatar
dterei committed
285 286 287
--      (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.)
Gabor Greif's avatar
typo  
Gabor Greif committed
288
--   * The version comparison sees that new (=NoInfo) differs from old (=HasInfo *)
dterei's avatar
dterei committed
289
--      and so gives a new version.
290

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

295
data IfaceInfoItem
296 297 298 299 300
  = HsArity         Arity
  | HsStrictness    StrictSig
  | HsInline        InlinePragma
  | HsUnfold        Bool             -- True <=> isStrongLoopBreaker is true
                    IfaceUnfolding   -- See Note [Expose recursive functions]
301
  | HsNoCafRefs
302

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

dterei's avatar
dterei committed
306
data IfaceUnfolding
307
  = IfCoreUnfold Bool IfaceExpr -- True <=> INLINABLE, False <=> regular unfolding
308 309
                                -- Possibly could eliminate the Bool here, the information
                                -- is also in the InlinePragma.
310

dterei's avatar
dterei committed
311
  | IfCompulsory IfaceExpr      -- Only used for default methods, in fact
312

313
  | IfInlineRule Arity          -- INLINE pragmas
dterei's avatar
dterei committed
314 315 316
                 Bool           -- OK to inline even if *un*-saturated
                 Bool           -- OK to inline even if context is boring
                 IfaceExpr
317

318
  | IfDFunUnfold [IfaceBndr] [IfaceExpr]
319

320

321 322 323 324
-- 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
325

326 327
data IfaceIdDetails
  = IfVanillaId
Matthew Pickering's avatar
Matthew Pickering committed
328
  | IfRecSelId (Either IfaceTyCon IfaceDecl) Bool
329
  | IfDFunId
330

Austin Seipp's avatar
Austin Seipp committed
331
{-
332 333
Note [Versioning of instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
334
See [http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/RecompilationAvoidance#Instances]
335

336

Austin Seipp's avatar
Austin Seipp committed
337 338
************************************************************************
*                                                                      *
339
                Functions over declarations
Austin Seipp's avatar
Austin Seipp committed
340 341 342
*                                                                      *
************************************************************************
-}
343 344 345

visibleIfConDecls :: IfaceConDecls -> [IfaceConDecl]
visibleIfConDecls (IfAbstractTyCon {}) = []
346 347 348 349 350 351 352 353 354 355 356
visibleIfConDecls (IfDataTyCon cs _ _) = cs
visibleIfConDecls (IfNewTyCon c   _ _) = [c]

ifaceConDeclFields :: IfaceConDecls -> [FieldLbl OccName]
ifaceConDeclFields x = case x of
    IfAbstractTyCon {}              -> []
    IfDataTyCon cons is_over labels -> map (help cons  is_over) labels
    IfNewTyCon  con  is_over labels -> map (help [con] is_over) labels
  where
    help (dc:_) is_over lbl = mkFieldLabelOccs lbl (ifConOcc dc) is_over
    help [] _ _ = error "ifaceConDeclFields: data type has no constructors!"
357

358
ifaceDeclImplicitBndrs :: IfaceDecl -> [OccName]
359 360 361
--  *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
362
-- See Note [Implicit TyThings] in HscTypes
363

364 365 366 367 368
-- 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.
369 370 371 372 373 374 375 376 377

ifaceDeclImplicitBndrs (IfaceData {ifName = tc_occ, ifCons = cons })
  = case cons of
      IfAbstractTyCon {}  -> []
      IfNewTyCon  cd  _ _ -> mkNewTyCoOcc tc_occ : ifaceConDeclImplicitBndrs cd
      IfDataTyCon cds _ _ -> concatMap ifaceConDeclImplicitBndrs cds

ifaceDeclImplicitBndrs (IfaceClass { ifCtxt = sc_ctxt, ifName = cls_tc_occ
                                   , ifSigs = sigs, ifATs = ats })
batterseapower's avatar
batterseapower committed
378
  = --   (possibly) newtype coercion
379 380 381 382 383 384
    co_occs ++
    --    data constructor (DataCon namespace)
    --    data worker (Id namespace)
    --    no wrapper (class dictionaries never have a wrapper)
    [dc_occ, dcww_occ] ++
    -- associated types
385
    [ifName at | IfaceAT at _ <- ats ] ++
386
    -- superclass selectors
batterseapower's avatar
batterseapower committed
387
    [mkSuperDictSelOcc n cls_tc_occ | n <- [1..n_ctxt]] ++
388 389 390 391 392
    -- operation selectors
    [op | IfaceClassOp op  _ _ <- sigs]
  where
    n_ctxt = length sc_ctxt
    n_sigs = length sigs
batterseapower's avatar
batterseapower committed
393
    co_occs | is_newtype = [mkNewTyCoOcc cls_tc_occ]
dterei's avatar
dterei committed
394
            | otherwise  = []
395
    dcww_occ = mkDataConWorkerOcc dc_occ
batterseapower's avatar
batterseapower committed
396
    dc_occ = mkClassDataConOcc cls_tc_occ
dterei's avatar
dterei committed
397
    is_newtype = n_sigs + n_ctxt == 1 -- Sigh
398

399
ifaceDeclImplicitBndrs _ = []
400

401 402 403 404 405 406 407 408
ifaceConDeclImplicitBndrs :: IfaceConDecl -> [OccName]
ifaceConDeclImplicitBndrs (IfCon { ifConWrapper = has_wrapper, ifConOcc = con_occ })
  = [con_occ, work_occ] ++ wrap_occs
  where
    work_occ  = mkDataConWorkerOcc con_occ                   -- Id namespace
    wrap_occs | has_wrapper = [mkDataConWrapperOcc con_occ]  -- Id namespace
              | otherwise   = []

409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424
-- -----------------------------------------------------------------------------
-- 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 hash decl
  = (ifName decl, hash) :
    [ (occ, computeFingerprint' (hash,occ))
    | occ <- ifaceDeclImplicitBndrs decl ]
  where
     computeFingerprint' =
       unsafeDupablePerformIO
        . computeFingerprint (panic "ifaceDeclFingerprints")
425

Austin Seipp's avatar
Austin Seipp committed
426 427 428
{-
************************************************************************
*                                                                      *
429
                Expressions
Austin Seipp's avatar
Austin Seipp committed
430 431 432
*                                                                      *
************************************************************************
-}
433 434 435 436 437 438

data IfaceExpr
  = IfaceLcl    IfLclName
  | IfaceExt    IfExtName
  | IfaceType   IfaceType
  | IfaceCo     IfaceCoercion
439
  | IfaceTuple  TupleSort [IfaceExpr]   -- Saturated; type arguments omitted
440
  | IfaceLam    IfaceLamBndr IfaceExpr
441 442
  | IfaceApp    IfaceExpr IfaceExpr
  | IfaceCase   IfaceExpr IfLclName [IfaceAlt]
443
  | IfaceECase  IfaceExpr IfaceType     -- See Note [Empty case alternatives]
444
  | IfaceLet    IfaceBinding  IfaceExpr
445 446 447 448 449 450 451 452
  | 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
Peter Wortmann's avatar
Peter Wortmann committed
453
  | IfaceSource  RealSrcSpan String        -- from SourceNote
454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473
  -- 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

Austin Seipp's avatar
Austin Seipp committed
474
{-
475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498
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


Austin Seipp's avatar
Austin Seipp committed
499 500
************************************************************************
*                                                                      *
501
              Printing IfaceDecl
Austin Seipp's avatar
Austin Seipp committed
502 503 504
*                                                                      *
************************************************************************
-}
505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522 523 524 525 526 527

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
pprAxBranch pp_tc (IfaceAxBranch { ifaxbTyVars = tvs
                                  , ifaxbLHS = pat_tys
                                  , ifaxbRHS = rhs
                                  , ifaxbIncomps = incomps })
  = hang (pprUserIfaceForAll tvs)
       2 (hang pp_lhs 2 (equals <+> ppr rhs))
    $+$
    nest 2 maybe_incomps
  where
    pp_lhs = hang pp_tc 2 (pprParendIfaceTcArgs pat_tys)
    maybe_incomps = ppUnless (null incomps) $ parens $
                    ptext (sLit "incompatible indices:") <+> ppr incomps

instance Outputable IfaceAnnotation where
  ppr (IfaceAnnotation target value) = ppr target <+> colon <+> ppr value

instance HasOccName IfaceClassOp where
  occName (IfaceClassOp n _ _) = n
528

529 530
instance HasOccName IfaceConDecl where
  occName = ifConOcc
531

532 533 534
instance HasOccName IfaceDecl where
  occName = ifName

535
instance Outputable IfaceDecl where
536 537
  ppr = pprIfaceDecl showAll

538 539 540 541 542 543 544 545 546
{-
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.
-}

547 548 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565
data ShowSub
  = ShowSub
      { ss_ppr_bndr :: OccName -> SDoc  -- Pretty-printer for binders in IfaceDecl
                                        -- See Note [Printing IfaceDecl binders]
      , ss_how_much :: ShowHowMuch }

data ShowHowMuch
  = ShowHeader   -- Header information only, not rhs
  | ShowSome [OccName]    -- []     <=> 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)

showAll :: ShowSub
showAll = ShowSub { ss_how_much = ShowIface, ss_ppr_bndr = ppr }

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

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

574
ppShowRhs :: ShowSub -> SDoc -> SDoc
575
ppShowRhs (ShowSub { ss_how_much = ShowHeader }) _   = Outputable.empty
576 577 578 579 580 581
ppShowRhs _                                      doc = doc

showSub :: HasOccName n => ShowSub -> n -> Bool
showSub (ShowSub { ss_how_much = ShowHeader })     _     = False
showSub (ShowSub { ss_how_much = ShowSome (n:_) }) thing = n == occName thing
showSub (ShowSub { ss_how_much = _ })              _     = True
582

Austin Seipp's avatar
Austin Seipp committed
583
{-
584 585 586 587 588 589 590
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.
591

592 593
When printing an interface file (--show-iface), we want to print
everything unqualified, so we can just print the OccName directly.
Austin Seipp's avatar
Austin Seipp committed
594
-}
595 596 597 598 599 600 601 602 603 604 605 606 607 608 609

ppr_trim :: [Maybe SDoc] -> [SDoc]
-- Collapse a group of Nothings to a single "..."
ppr_trim xs
  = snd (foldr go (False, []) xs)
  where
    go (Just doc) (_,     so_far) = (False, doc : so_far)
    go Nothing    (True,  so_far) = (True, so_far)
    go Nothing    (False, so_far) = (True, ptext (sLit "...") : so_far)

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

pprIfaceDecl :: ShowSub -> IfaceDecl -> SDoc
610 611
-- NB: pprIfaceDecl is also used for pretty-printing TyThings in GHCi
--     See Note [Pretty-printing TyThings] in PprTyThing
612
pprIfaceDecl ss (IfaceData { ifName = tycon, ifCType = ctype,
613
                             ifCtxt = context, ifTyVars = tc_tyvars,
614 615 616 617 618 619 620 621 622 623 624 625 626 627 628 629 630 631 632 633 634
                             ifRoles = roles, ifCons = condecls,
                             ifParent = parent, ifRec = isrec,
                             ifGadtSyntax = gadt,
                             ifPromotable = is_prom })

  | gadt_style = vcat [ pp_roles
                      , pp_nd <+> pp_lhs <+> pp_where
                      , nest 2 (vcat pp_cons)
                      , nest 2 $ ppShowIface ss pp_extra ]
  | otherwise  = vcat [ pp_roles
                      , hang (pp_nd <+> pp_lhs) 2 (add_bars pp_cons)
                      , nest 2 $ ppShowIface ss pp_extra ]
  where
    is_data_instance = isIfaceDataInstance parent

    gadt_style = gadt || any (not . isVanillaIfaceConDecl) cons
    cons       = visibleIfConDecls condecls
    pp_where   = ppWhen (gadt_style && not (null cons)) $ ptext (sLit "where")
    pp_cons    = ppr_trim (map show_con cons) :: [SDoc]

    pp_lhs = case parent of
635
               IfNoParent -> pprIfaceDeclHead context ss tycon tc_tyvars
636 637 638
               _          -> ptext (sLit "instance") <+> pprIfaceTyConParent parent

    pp_roles
639
      | is_data_instance = Outputable.empty
640
      | otherwise        = pprRoles (== Representational) (pprPrefixIfDeclBndr ss tycon)
641
                                    tc_tyvars roles
642 643 644
            -- Don't display roles for data family instances (yet)
            -- See discussion on Trac #8672.

645
    add_bars []     = Outputable.empty
646
    add_bars (c:cs) = sep ((equals <+> c) : map (vbar <+>) cs)
647 648 649 650

    ok_con dc = showSub ss dc || any (showSub ss) (ifConFields dc)

    show_con dc
651
      | ok_con dc = Just $ pprIfaceConDecl ss gadt_style mk_user_con_res_ty fls dc
652
      | otherwise = Nothing
653
    fls = ifaceConDeclFields condecls
654

655 656 657 658 659 660 661
    mk_user_con_res_ty :: IfaceEqSpec -> ([IfaceTvBndr], SDoc)
    -- See Note [Result type of a data family GADT]
    mk_user_con_res_ty eq_spec
      | IfDataInstance _ tc tys <- parent
      = (con_univ_tvs, pprIfaceType (IfaceTyConApp tc (substIfaceTcArgs gadt_subst tys)))
      | otherwise
      = (con_univ_tvs, sdocWithDynFlags (ppr_tc_app gadt_subst))
662
      where
663 664 665
        gadt_subst = mkFsEnv eq_spec
        done_univ_tv (tv,_) = isJust (lookupFsEnv gadt_subst tv)
        con_univ_tvs = filterOut done_univ_tv tc_tyvars
666

667 668 669 670
    ppr_tc_app gadt_subst dflags
       = pprPrefixIfDeclBndr ss tycon
         <+> sep [ pprParendIfaceType (substIfaceTyVar gadt_subst tv)
                 | (tv,_kind) <- stripIfaceKindVars dflags tc_tyvars ]
671 672 673

    pp_nd = case condecls of
              IfAbstractTyCon d -> ptext (sLit "abstract") <> ppShowIface ss (parens (ppr d))
674 675
              IfDataTyCon{}     -> ptext (sLit "data")
              IfNewTyCon{}      -> ptext (sLit "newtype")
676

677 678 679
    pp_extra = vcat [pprCType ctype, pprRec isrec, pp_prom]

    pp_prom | is_prom   = ptext (sLit "Promotable")
680
            | otherwise = Outputable.empty
681

682

683 684 685
pprIfaceDecl ss (IfaceClass { ifATs = ats, ifSigs = sigs, ifRec = isrec
                            , ifCtxt   = context, ifName  = clas
                            , ifTyVars = tyvars,  ifRoles = roles
686
                            , ifFDs    = fds, ifMinDef = minDef })
687
  = vcat [ pprRoles (== Nominal) (pprPrefixIfDeclBndr ss clas) tyvars roles
688 689
         , ptext (sLit "class") <+> pprIfaceDeclHead context ss clas tyvars
                                <+> pprFundeps fds <+> pp_where
690 691
         , nest 2 (vcat [ vcat asocs, vcat dsigs, pprec
                        , ppShowAllSubs ss (pprMinDef minDef)])]
692 693 694 695 696 697 698 699 700 701 702 703 704 705 706 707 708
    where
      pp_where = ppShowRhs ss $ ppUnless (null sigs && null ats) (ptext (sLit "where"))

      asocs = ppr_trim $ map maybeShowAssoc ats
      dsigs = ppr_trim $ map maybeShowSig sigs
      pprec = ppShowIface ss (pprRec isrec)

      maybeShowAssoc :: IfaceAT -> Maybe SDoc
      maybeShowAssoc asc@(IfaceAT d _)
        | showSub ss d = Just $ pprIfaceAT ss asc
        | otherwise    = Nothing

      maybeShowSig :: IfaceClassOp -> Maybe SDoc
      maybeShowSig sg
        | showSub ss sg = Just $  pprIfaceClassOp ss sg
        | otherwise     = Nothing

709 710 711 712 713 714 715
      pprMinDef :: BooleanFormula IfLclName -> SDoc
      pprMinDef minDef = ppUnless (isTrue minDef) $ -- hide empty definitions
        ptext (sLit "{-# MINIMAL") <+>
        pprBooleanFormula
          (\_ def -> cparen (isLexSym def) (ppr def)) 0 minDef <+>
        ptext (sLit "#-}")

716 717 718
pprIfaceDecl ss (IfaceSynonym { ifName   = tc
                              , ifTyVars = tv
                              , ifSynRhs = mono_ty })
719 720
  = hang (ptext (sLit "type") <+> pprIfaceDeclHead [] ss tc tv <+> equals)
       2 (sep [pprIfaceForAll tvs, pprIfaceContextArr theta, ppr tau])
721
  where
722
    (tvs, theta, tau) = splitIfaceSigmaTy mono_ty
723

724
pprIfaceDecl ss (IfaceFamily { ifName = tycon, ifTyVars = tyvars
Jan Stolarek's avatar
Jan Stolarek committed
725 726
                             , ifFamFlav = rhs, ifFamKind = kind
                             , ifResVar = res_var, ifFamInj = inj })
727 728 729 730 731 732
  | IfaceDataFamilyTyCon <- rhs
  = ptext (sLit "data family") <+> pprIfaceDeclHead [] ss tycon tyvars

  | otherwise
  = vcat [ hang (ptext (sLit "type family")
                 <+> pprIfaceDeclHead [] ss tycon tyvars)
Jan Stolarek's avatar
Jan Stolarek committed
733
              2 (pp_inj res_var inj <+> ppShowRhs ss (pp_rhs rhs))
734
         , ppShowRhs ss (nest 2 (pp_branches rhs)) ]
735
  where
Jan Stolarek's avatar
Jan Stolarek committed
736 737 738 739 740 741 742 743
    pp_inj Nothing    _   = dcolon <+> ppr kind
    pp_inj (Just res) inj
       | Injective injectivity <- inj = hsep [ equals, ppr res, dcolon, ppr kind
                                             , pp_inj_cond res injectivity]
       | otherwise = hsep [ equals, ppr res, dcolon, ppr kind ]

    pp_inj_cond res inj = case filterByList inj tyvars of
       []  -> empty
744
       tvs -> hsep [vbar, ppr res, text "->", interppSP (map fst tvs)]
Jan Stolarek's avatar
Jan Stolarek committed
745

746 747
    pp_rhs IfaceDataFamilyTyCon
      = ppShowIface ss (ptext (sLit "data"))
748 749 750 751
    pp_rhs IfaceOpenSynFamilyTyCon
      = ppShowIface ss (ptext (sLit "open"))
    pp_rhs IfaceAbstractClosedSynFamilyTyCon
      = ppShowIface ss (ptext (sLit "closed, abstract"))
752
    pp_rhs (IfaceClosedSynFamilyTyCon {})
753 754 755 756 757
      = ptext (sLit "where")
    pp_rhs IfaceBuiltInSynFamTyCon
      = ppShowIface ss (ptext (sLit "built-in"))

    pp_branches (IfaceClosedSynFamilyTyCon (Just (ax, brs)))
758
      = vcat (map (pprAxBranch (pprPrefixIfDeclBndr ss tycon)) brs)
759
        $$ ppShowIface ss (ptext (sLit "axiom") <+> ppr ax)
760
    pp_branches _ = Outputable.empty
761

762
pprIfaceDecl _ (IfacePatSyn { ifName = name, ifPatBuilder = builder,
763
                              ifPatUnivTvs = univ_tvs, ifPatExTvs = ex_tvs,
764
                              ifPatProvCtxt = prov_ctxt, ifPatReqCtxt = req_ctxt,
765 766 767 768 769
                              ifPatArgs = arg_tys,
                              ifPatTy = pat_ty} )
  = pprPatSynSig name is_bidirectional
                 (pprUserIfaceForAll tvs)
                 (pprIfaceContextMaybe req_ctxt)
770
                 (pprIfaceContextMaybe prov_ctxt)
771
                 (pprIfaceType ty)
cactus's avatar
cactus committed
772
  where
773
    is_bidirectional = isJust builder
774 775
    tvs = univ_tvs ++ ex_tvs
    ty = foldr IfaceFunTy pat_ty arg_tys
cactus's avatar
cactus committed
776

777 778
pprIfaceDecl ss (IfaceId { ifName = var, ifType = ty,
                              ifIdDetails = details, ifIdInfo = info })
779
  = vcat [ hang (pprPrefixIfDeclBndr ss var <+> dcolon)
780 781
              2 (pprIfaceSigmaType ty)
         , ppShowIface ss (ppr details)
782
         , ppShowIface ss (ppr info) ]
783 784 785 786 787 788 789

pprIfaceDecl _ (IfaceAxiom { ifName = name, ifTyCon = tycon
                           , ifAxBranches = branches })
  = hang (ptext (sLit "axiom") <+> ppr name <> dcolon)
       2 (vcat $ map (pprAxBranch (ppr tycon)) branches)


790
pprCType :: Maybe CType -> SDoc
791
pprCType Nothing      = Outputable.empty
792 793
pprCType (Just cType) = ptext (sLit "C type:") <+> ppr cType

794 795 796 797 798 799 800 801
-- if, for each role, suppress_if role is True, then suppress the role
-- output
pprRoles :: (Role -> Bool) -> SDoc -> [IfaceTvBndr] -> [Role] -> SDoc
pprRoles suppress_if tyCon tyvars roles
  = sdocWithDynFlags $ \dflags ->
      let froles = suppressIfaceKinds dflags tyvars roles
      in ppUnless (all suppress_if roles || null froles) $
         ptext (sLit "type role") <+> tyCon <+> hsep (map ppr froles)
802

Ian Lynagh's avatar
Ian Lynagh committed
803
pprRec :: RecFlag -> SDoc
804
pprRec NonRecursive = Outputable.empty
805
pprRec Recursive    = ptext (sLit "RecFlag: Recursive")
Ian Lynagh's avatar
Ian Lynagh committed
806

807
pprInfixIfDeclBndr, pprPrefixIfDeclBndr :: ShowSub -> OccName -> SDoc
808
pprInfixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
809 810 811
  = pprInfixVar (isSymOcc occ) (ppr_bndr occ)
pprPrefixIfDeclBndr (ShowSub { ss_ppr_bndr = ppr_bndr }) occ
  = parenSymOcc occ (ppr_bndr occ)
812

813
instance Outputable IfaceClassOp where
814 815 816 817
   ppr = pprIfaceClassOp showAll

pprIfaceClassOp :: ShowSub -> IfaceClassOp -> SDoc
pprIfaceClassOp ss (IfaceClassOp n dm ty) = hang opHdr 2 (pprIfaceSigmaType ty)
818 819
  where opHdr = pprPrefixIfDeclBndr ss n
                <+> ppShowIface ss (ppr dm) <+> dcolon
820

821
instance Outputable IfaceAT where
822 823 824
   ppr = pprIfaceAT showAll

pprIfaceAT :: ShowSub -> IfaceAT -> SDoc
825
pprIfaceAT ss (IfaceAT d mb_def)
826
  = vcat [ pprIfaceDecl ss d
827
         , case mb_def of
828
              Nothing  -> Outputable.empty
829 830
              Just rhs -> nest 2 $
                          ptext (sLit "Default:") <+> ppr rhs ]
831 832 833 834 835 836

instance Outputable IfaceTyConParent where
  ppr p = pprIfaceTyConParent p

pprIfaceTyConParent :: IfaceTyConParent -> SDoc
pprIfaceTyConParent IfNoParent
837
  = Outputable.empty
838 839 840 841 842 843
pprIfaceTyConParent (IfDataInstance _ tc tys)
  = sdocWithDynFlags $ \dflags ->
    let ftys = stripKindArgs dflags tys
    in pprIfaceTypeApp tc ftys

pprIfaceDeclHead :: IfaceContext -> ShowSub -> OccName -> [IfaceTvBndr] -> SDoc
844
pprIfaceDeclHead context ss tc_occ tv_bndrs
845
  = sdocWithDynFlags $ \ dflags ->
846 847 848
    sep [ pprIfaceContextArr context
        , pprPrefixIfDeclBndr ss tc_occ
          <+> pprIfaceTvBndrs (stripIfaceKindVars dflags tv_bndrs) ]
849 850 851 852 853 854 855 856

isVanillaIfaceConDecl :: IfaceConDecl -> Bool
isVanillaIfaceConDecl (IfCon { ifConExTvs  = ex_tvs
                             , ifConEqSpec = eq_spec
                             , ifConCtxt   = ctxt })
  = (null ex_tvs) && (null eq_spec) && (null ctxt)

pprIfaceConDecl :: ShowSub -> Bool
857
                -> (IfaceEqSpec -> ([IfaceTvBndr], SDoc))
858
                -> [FieldLbl OccName]
859
                -> IfaceConDecl -> SDoc
860
pprIfaceConDecl ss gadt_style mk_user_con_res_ty fls
861
        (IfCon { ifConOcc = name, ifConInfix = is_infix,
862
                 ifConExTvs = ex_tvs,
dterei's avatar
dterei committed
863
                 ifConEqSpec = eq_spec, ifConCtxt = ctxt, ifConArgTys = arg_tys,
864
                 ifConStricts = stricts, ifConFields = labels })
865
  | gadt_style = pp_prefix_con <+> dcolon <+> ppr_ty
866
  | otherwise  = ppr_fields tys_w_strs
867
  where
868 869
    tys_w_strs :: [(IfaceBang, IfaceType)]
    tys_w_strs = zip stricts arg_tys
870
    pp_prefix_con = pprPrefixIfDeclBndr ss name
871

872 873
    (univ_tvs, pp_res_ty) = mk_user_con_res_ty eq_spec
    ppr_ty = pprIfaceForAllPart (univ_tvs ++ ex_tvs) ctxt pp_tau
dterei's avatar
dterei committed
874 875 876

        -- 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
877
    pp_tau = case map pprParendIfaceType arg_tys ++ [pp_res_ty] of
dterei's avatar
dterei committed
878 879
                (t:ts) -> fsep (t : map (arrow <+>) ts)
                []     -> panic "pp_con_taus"
880

881 882 883 884 885 886 887 888 889
    ppr_bang IfNoBang = ppWhen opt_PprStyle_Debug $ char '_'
    ppr_bang IfStrict = char '!'
    ppr_bang IfUnpack = ptext (sLit "{-# UNPACK #-}")
    ppr_bang (IfUnpackCo co) = ptext (sLit "! {-# UNPACK #-}") <>
                               pprParendIfaceCoercion co

    pprParendBangTy (bang, ty) = ppr_bang bang <> pprParendIfaceType ty
    pprBangTy       (bang, ty) = ppr_bang bang <> ppr ty

890 891
    maybe_show_label (sel,bty)
      | showSub ss sel = Just (pprPrefixIfDeclBndr ss lbl <+> dcolon <+> pprBangTy bty)
892
      | otherwise      = Nothing
893 894 895 896 897
      where
        -- IfaceConDecl contains the name of the selector function, so
        -- we have to look up the field label (in case
        -- DuplicateRecordFields was used for the definition)
        lbl = maybe sel (mkVarOccFS . flLabel) $ find (\ fl -> flSelector fl == sel) fls
898 899 900

    ppr_fields [ty1, ty2]
      | is_infix && null labels
901
      = sep [pprParendBangTy ty1, pprInfixIfDeclBndr ss name, pprParendBangTy ty2]
902
    ppr_fields fields
903 904
      | null labels = pp_prefix_con <+> sep (map pprParendBangTy fields)
      | otherwise   = pp_prefix_con <+> (braces $ sep $ punctuate comma $ ppr_trim $
905
                                    map maybe_show_label (zip labels fields))
906

907
instance Outputable IfaceRule where
908
  ppr (IfaceRule { ifRuleName = name, ifActivation = act, ifRuleBndrs = bndrs,
dterei's avatar
dterei committed
909
                   ifRuleHead = fn, ifRuleArgs = args, ifRuleRhs = rhs })
910
    = sep [hsep [pprRuleName name, ppr act,
dterei's avatar
dterei committed
911 912 913
                 ptext (sLit "forall") <+> pprIfaceBndrs bndrs],
           nest 2 (sep [ppr fn <+> sep (map pprParendIfaceExpr args),
                        ptext (sLit "=") <+> ppr rhs])
914 915
      ]

916
instance Outputable IfaceClsInst where
917 918
  ppr (IfaceClsInst { ifDFun = dfun_id, ifOFlag = flag
                    , ifInstCls = cls, ifInstTys = mb_tcs})
dterei's avatar
dterei committed
919 920
    = hang (ptext (sLit "instance") <+> ppr flag
                <+> ppr cls <+> brackets (pprWithCommas ppr_rough mb_tcs))
921
         2 (equals <+> ppr dfun_id)
922 923

instance Outputable IfaceFamInst where
924 925
  ppr (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs
                    , ifFamInstAxiom = tycon_ax})
dterei's avatar
dterei committed
926
    = hang (ptext (sLit "family instance") <+>
927
            ppr fam <+> pprWithCommas (brackets . ppr_rough) mb_tcs)
928
         2 (equals <+> ppr tycon_ax)
929 930 931 932

ppr_rough :: Maybe IfaceTyCon -> SDoc
ppr_rough Nothing   = dot
ppr_rough (Just tc) = ppr tc
933

Austin Seipp's avatar
Austin Seipp committed
934
{-
935 936
Note [Result type of a data family GADT]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
937
Consider
938 939 940 941 942
   data family T a
   data instance T (p,q) where
      T1 :: T (Int, Maybe c)
      T2 :: T (Bool, q)

943
The IfaceDecl actually looks like
944 945 946 947 948 949

   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
950
want to pretty print, we substitute the eq-spec
951 952 953 954
[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.
955 956

----------------------------- Printing IfaceExpr ------------------------------------
Austin Seipp's avatar
Austin Seipp committed
957
-}
958 959 960 961

instance Outputable IfaceExpr where
    ppr e = pprIfaceExpr noParens e

962 963 964
noParens :: SDoc -> SDoc
noParens pp = pp

965 966 967
pprParendIfaceExpr :: IfaceExpr -> SDoc
pprParendIfaceExpr = pprIfaceExpr parens

dterei's avatar
dterei committed
968 969 970 971
-- | 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)
972 973
pprIfaceExpr :: (SDoc -> SDoc) -> IfaceExpr -> SDoc

Ian Lynagh's avatar
Ian Lynagh committed
974 975 976 977 978
pprIfaceExpr _       (IfaceLcl v)       = ppr v
pprIfaceExpr _       (IfaceExt v)       = ppr v
pprIfaceExpr _       (IfaceLit l)       = ppr l
pprIfaceExpr _       (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
pprIfaceExpr _       (IfaceType ty)     = char '@' <+> pprParendIfaceType ty
979
pprIfaceExpr _       (IfaceCo co)       = text "@~" <+> pprParendIfaceCoercion co
980 981

pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
982
pprIfaceExpr _       (IfaceTuple c as)  = tupleParens c (pprWithCommas ppr as)
983

dterei's avatar
dterei committed
984
pprIfaceExpr add_par i@(IfaceLam _ _)
985
  = add_par (sep [char '\\' <+> sep (map pprIfaceLamBndr bndrs) <+> arrow,
dterei's avatar
dterei committed
986 987
                  pprIfaceExpr noParens body])
  where
dterei's avatar
dterei committed
988
    (bndrs,body) = collect [] i
989 990 991
    collect bs (IfaceLam b e) = collect (b:bs) e
    collect bs e              = (reverse bs, e)

992
pprIfaceExpr add_par (IfaceECase scrut ty)
993
  = add_par (sep [ ptext (sLit "case") <+> pprIfaceExpr noParens scrut
994 995 996
                 , ptext (sLit "ret_ty") <+> pprParendIfaceType ty
                 , ptext (sLit "of {}") ])

997
pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
998 999 1000 1001
  = add_par (sep [ptext (sLit "case")
                        <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
                        <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
                  pprIfaceExpr noParens rhs <+> char '}'])
1002

1003
pprIfaceExpr add_par (IfaceCase scrut bndr alts)
1004 1005 1006 1007
  = add_par (sep [ptext (sLit "case")
                        <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
                        <+> ppr bndr <+> char '{',
                  nest 2 (sep (map ppr_alt alts)) <+> char '}'])
1008

Ian Lynagh's avatar
Ian Lynagh committed
1009
pprIfaceExpr _       (IfaceCast expr co)
1010
  = sep [pprParendIfaceExpr expr,
dterei's avatar
dterei committed
1011
         nest 2 (ptext (sLit "`cast`")),
1012
         pprParendIfaceCoercion co]
1013

1014
pprIfaceExpr add_par (IfaceLet (IfaceNonRec b rhs) body)
dterei's avatar
dterei committed
1015 1016 1017 1018
  = add_par (sep [ptext (sLit "let {"),
                  nest 2 (ppr_bind (b, rhs)),
                  ptext (sLit "} in"),
                  pprIfaceExpr noParens body])
1019 1020

pprIfaceExpr add_par (IfaceLet (IfaceRec pairs) body)
Ian Lynagh's avatar
Ian Lynagh committed
1021
  = add_par (sep [ptext (sLit "letrec {"),
dterei's avatar
dterei committed
1022 1023 1024
                  nest 2 (sep (map ppr_bind pairs)),
                  ptext (sLit "} in"),
                  pprIfaceExpr noParens body])
1025

1026 1027
pprIfaceExpr add_par (IfaceTick tickish e)
  = add_par (pprIfaceTickish tickish <+> pprIfaceExpr noParens e)