HsBinds.hs 47.8 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, 1992-1998

5 6
\section[HsBinds]{Abstract syntax: top-level bindings and signatures}

7
Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
Austin Seipp's avatar
Austin Seipp committed
8
-}
9

10
{-# LANGUAGE DeriveDataTypeable #-}
11
{-# LANGUAGE DeriveFunctor #-}
12 13 14 15 16
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
                                      -- in module PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
17
{-# LANGUAGE BangPatterns #-}
18
{-# LANGUAGE TypeFamilies #-}
19

20 21
module HsBinds where

22 23
import GhcPrelude

24
import {-# SOURCE #-} HsExpr ( pprExpr, LHsExpr,
25 26
                               MatchGroup, pprFunBind,
                               GRHSs, pprPatBind )
27
import {-# SOURCE #-} HsPat  ( LPat )
sof's avatar
sof committed
28

29
import HsExtension
30
import HsTypes
31
import PprCore ()
32
import CoreSyn
33
import TcEvidence
34 35 36
import Type
import NameSet
import BasicTypes
37
import Outputable
38 39 40
import SrcLoc
import Var
import Bag
41
import FastString
42
import BooleanFormula (LBooleanFormula)
43
import DynFlags
44 45

import Data.Data hiding ( Fixity )
46
import Data.List hiding ( foldr )
47
import Data.Ord
48

Austin Seipp's avatar
Austin Seipp committed
49 50 51
{-
************************************************************************
*                                                                      *
52
\subsection{Bindings: @BindGroup@}
Austin Seipp's avatar
Austin Seipp committed
53 54
*                                                                      *
************************************************************************
55

56
Global bindings (where clauses)
Austin Seipp's avatar
Austin Seipp committed
57
-}
58

59
-- During renaming, we need bindings where the left-hand sides
60
-- have been renamed but the right-hand sides have not.
61 62 63 64
-- the ...LR datatypes are parametrized by two id types,
-- one for the left and one for the right.
-- Other than during renaming, these will be the same.

65
-- | Haskell Local Bindings
66 67
type HsLocalBinds id = HsLocalBindsLR id id

Richard Eisenberg's avatar
Richard Eisenberg committed
68 69 70
-- | Located Haskell local bindings
type LHsLocalBinds id = Located (HsLocalBinds id)

71 72 73
-- | Haskell Local Bindings with separate Left and Right identifier types
--
-- Bindings in a 'let' expression
74
-- or a 'where' clause
75
data HsLocalBindsLR idL idR
76 77 78
  = HsValBinds
        (XHsValBinds idL idR)
        (HsValBindsLR idL idR)
79 80
      -- ^ Haskell Value Bindings

81 82
         -- There should be no pattern synonyms in the HsValBindsLR
         -- These are *local* (not top level) bindings
83
         -- The parser accepts them, however, leaving the
84 85
         -- renamer to report them

86 87 88
  | HsIPBinds
        (XHsIPBinds idL idR)
        (HsIPBinds idR)
89
      -- ^ Haskell Implicit Parameter Bindings
90

91
  | EmptyLocalBinds (XEmptyLocalBinds idL idR)
92
      -- ^ Empty Local Bindings
93

94 95 96
  | XHsLocalBindsLR
        (XXHsLocalBindsLR idL idR)

97 98 99 100
type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = NoExt
type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = NoExt
type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExt
type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExt
101

Richard Eisenberg's avatar
Richard Eisenberg committed
102 103
type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)

sof's avatar
sof committed
104

105
-- | Haskell Value Bindings
106 107
type HsValBinds id = HsValBindsLR id id

108 109
-- | Haskell Value bindings with separate Left and Right identifier types
-- (not implicit parameters)
110 111
-- Used for both top level and nested bindings
-- May contain pattern synonym bindings
112
data HsValBindsLR idL idR
113 114 115
  = -- | Value Bindings In
    --
    -- Before renaming RHS; idR is always RdrName
116 117
    -- Not dependency analysed
    -- Recursive by default
118 119
    ValBinds
        (XValBinds idL idR)
120
        (LHsBindsLR idL idR) [LSig idR]
121

122 123 124 125
    -- | Value Bindings Out
    --
    -- After renaming RHS; idR can be Name or Id Dependency analysed,
    -- later bindings in the list may depend on earlier ones.
126 127
  | XValBindsLR
      (XXValBindsLR idL idR)
128

129 130 131 132 133 134 135 136 137
-- ---------------------------------------------------------------------
-- Deal with ValBindsOut

-- TODO: make this the only type for ValBinds
data NHsValBindsLR idL
  = NValBinds
      [(RecFlag, LHsBinds idL)]
      [LSig GhcRn]

138
type instance XValBinds    (GhcPass pL) (GhcPass pR) = NoExt
139 140 141 142
type instance XXValBindsLR (GhcPass pL) (GhcPass pR)
            = NHsValBindsLR (GhcPass pL)

-- ---------------------------------------------------------------------
143

144
-- | Located Haskell Binding
145
type LHsBind  id = LHsBindLR  id id
146 147

-- | Located Haskell Bindings
148
type LHsBinds id = LHsBindsLR id id
149 150

-- | Haskell Binding
151
type HsBind   id = HsBindLR   id id
152

153
-- | Located Haskell Bindings with separate Left and Right identifier types
154
type LHsBindsLR idL idR = Bag (LHsBindLR idL idR)
155 156

-- | Located Haskell Binding with separate Left and Right identifier types
157
type LHsBindLR  idL idR = Located (HsBindLR idL idR)
158

Simon Peyton Jones's avatar
Simon Peyton Jones committed
159 160
{- Note [FunBind vs PatBind]
   ~~~~~~~~~~~~~~~~~~~~~~~~~
Ben Gamari's avatar
Ben Gamari committed
161 162 163 164 165 166 167 168 169 170
The distinction between FunBind and PatBind is a bit subtle. FunBind covers
patterns which resemble function bindings and simple variable bindings.

    f x = e
    f !x = e
    f = e
    !x = e          -- FunRhs has SrcStrict
    x `f` y = e     -- FunRhs has Infix

The actual patterns and RHSs of a FunBind are encoding in fun_matches.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
171 172 173 174 175 176 177
The m_ctxt field of each Match in fun_matches will be FunRhs and carries
two bits of information about the match,

  * The mc_fixity field on each Match describes the fixity of the
    function binder in that match.  E.g. this is legal:
         f True False  = e1
         True `f` True = e2
Ben Gamari's avatar
Ben Gamari committed
178

Simon Peyton Jones's avatar
Simon Peyton Jones committed
179 180 181
  * The mc_strictness field is used /only/ for nullary FunBinds: ones
    with one Match, which has no pats. For these, it describes whether
    the match is decorated with a bang (e.g. `!x = e`).
Ben Gamari's avatar
Ben Gamari committed
182 183 184 185 186 187 188 189 190

By contrast, PatBind represents data constructor patterns, as well as a few
other interesting cases. Namely,

    Just x = e
    (x) = e
    x :: Ty = e
-}

191
-- | Haskell Binding with separate Left and Right id's
192
data HsBindLR idL idR
Ben Gamari's avatar
Ben Gamari committed
193
  = -- | Function-like Binding
194 195
    --
    -- FunBind is used for both functions     @f x = e@
196
    -- and variables                          @f = \x -> e@
Ben Gamari's avatar
Ben Gamari committed
197
    -- and strict variables                   @!x = x + 1@
198 199 200 201 202 203 204 205 206
    --
    -- Reason 1: Special case for type inference: see 'TcBinds.tcMonoBinds'.
    --
    -- Reason 2: Instance decls can only have FunBinds, which is convenient.
    --           If you change this, you'll need to change e.g. rnMethodBinds
    --
    -- But note that the form                 @f :: a->a = ...@
    -- parses as a pattern binding, just like
    --                                        @(f :: a -> a) = ... @
Alan Zimmerman's avatar
Alan Zimmerman committed
207
    --
Ben Gamari's avatar
Ben Gamari committed
208
    -- Strict bindings have their strictness recorded in the 'SrcStrictness' of their
Simon Peyton Jones's avatar
Simon Peyton Jones committed
209
    -- 'MatchContext'. See Note [FunBind vs PatBind] for
Ben Gamari's avatar
Ben Gamari committed
210 211
    -- details about the relationship between FunBind and PatBind.
    --
Alan Zimmerman's avatar
Alan Zimmerman committed
212 213 214 215 216 217
    --  'ApiAnnotation.AnnKeywordId's
    --
    --  - 'ApiAnnotation.AnnFunId', attached to each element of fun_matches
    --
    --  - 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
    --    'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
218 219

    -- For details on above see note [Api annotations] in ApiAnnotation
220
    FunBind {
221

222 223 224 225 226
        fun_ext :: XFunBind idL idR, -- ^ After the renamer, this contains
                                --  the locally-bound
                                -- free variables of this defn.
                                -- See Note [Bind free vars]

227
        fun_id :: Located (IdP idL), -- Note [fun_id in Match] in HsExpr
228

229
        fun_matches :: MatchGroup idR (LHsExpr idR),  -- ^ The payload
230

231 232
        fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of
                                -- the Id.  Example:
Alan Zimmerman's avatar
Alan Zimmerman committed
233
                                --
234
                                -- @
235 236
                                --      f :: Int -> forall a. a -> a
                                --      f x y = y
237
                                -- @
Alan Zimmerman's avatar
Alan Zimmerman committed
238
                                --
239 240 241 242 243
                                -- Then the MatchGroup will have type (Int -> a' -> a')
                                -- (with a free type variable a').  The coercion will take
                                -- a CoreExpr of this type and convert it to a CoreExpr of
                                -- type         Int -> forall a'. a' -> a'
                                -- Notice that the coercion captures the free a'.
244

245
        fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any
246 247
    }

248 249 250
  -- | Pattern Binding
  --
  -- The pattern is never a simple variable;
Ben Gamari's avatar
Ben Gamari committed
251
  -- That case is done by FunBind.
Simon Peyton Jones's avatar
Simon Peyton Jones committed
252
  -- See Note [FunBind vs PatBind] for details about the
Ben Gamari's avatar
Ben Gamari committed
253 254
  -- relationship between FunBind and PatBind.

Alan Zimmerman's avatar
Alan Zimmerman committed
255 256 257 258
  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang',
  --       'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',
259 260

  -- For details on above see note [Api annotations] in ApiAnnotation
261
  | PatBind {
262
        pat_ext    :: XPatBind idL idR, -- ^ See Note [Bind free vars]
263
        pat_lhs    :: LPat idL,
264
        pat_rhs    :: GRHSs idR (LHsExpr idR),
265 266
        pat_ticks  :: ([Tickish Id], [[Tickish Id]])
               -- ^ Ticks to put on the rhs, if any, and ticks to put on
267
               -- the bound variables.
268 269
    }

270 271 272
  -- | Variable Binding
  --
  -- Dictionary binding and suchlike.
273
  -- All VarBinds are introduced by the type checker
274
  | VarBind {
275
        var_ext    :: XVarBind idL idR,
276
        var_id     :: IdP idL,
277 278
        var_rhs    :: LHsExpr idR,   -- ^ Located only for consistency
        var_inline :: Bool           -- ^ True <=> inline this binding regardless
279
                                     -- (used for implication constraints only)
280 281
    }

282
  -- | Abstraction Bindings
283
  | AbsBinds {                      -- Binds abstraction; TRANSLATION
284
        abs_ext     :: XAbsBinds idL idR,
285
        abs_tvs     :: [TyVar],
286
        abs_ev_vars :: [EvVar],  -- ^ Includes equality constraints
287

288
       -- | AbsBinds only gets used when idL = idR after renaming,
289
       -- but these need to be idL's for the collect... code in HsUtil
Simon Peyton Jones's avatar
Simon Peyton Jones committed
290
       -- to have the right type
291
        abs_exports :: [ABExport idL],
292

293 294 295 296 297 298
        -- | Evidence bindings
        -- Why a list? See TcInstDcls
        -- Note [Typechecking plan for instance declarations]
        abs_ev_binds :: [TcEvBinds],

        -- | Typechecked user bindings
299
        abs_binds    :: LHsBinds idL,
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
300

301
        abs_sig :: Bool  -- See Note [The abs_sig field of AbsBinds]
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
302 303
    }

304
  -- | Patterns Synonym Binding
305 306 307
  | PatSynBind
        (XPatSynBind idL idR)
        (PatSynBind idL idR)
Alan Zimmerman's avatar
Alan Zimmerman committed
308
        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
Alan Zimmerman's avatar
Alan Zimmerman committed
309 310 311
        --          'ApiAnnotation.AnnLarrow','ApiAnnotation.AnnEqual',
        --          'ApiAnnotation.AnnWhere'
        --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@
cactus's avatar
cactus committed
312

313 314
        -- For details on above see note [Api annotations] in ApiAnnotation

315 316 317 318 319 320 321
  | XHsBindsLR (XXHsBindsLR idL idR)

data NPatBindTc = NPatBindTc {
     pat_fvs :: NameSet, -- ^ Free variables
     pat_rhs_ty :: Type  -- ^ Type of the GRHSs
     } deriving Data

322
type instance XFunBind    (GhcPass pL) GhcPs = NoExt
323 324 325
type instance XFunBind    (GhcPass pL) GhcRn = NameSet -- Free variables
type instance XFunBind    (GhcPass pL) GhcTc = NameSet -- Free variables

326
type instance XPatBind    GhcPs (GhcPass pR) = NoExt
327 328 329
type instance XPatBind    GhcRn (GhcPass pR) = NameSet -- Free variables
type instance XPatBind    GhcTc (GhcPass pR) = NPatBindTc

330 331 332 333
type instance XVarBind    (GhcPass pL) (GhcPass pR) = NoExt
type instance XAbsBinds   (GhcPass pL) (GhcPass pR) = NoExt
type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExt
type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExt
334

335

336 337 338 339 340 341 342 343 344 345
        -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
        --
        -- Creates bindings for (polymorphic, overloaded) poly_f
        -- in terms of monomorphic, non-overloaded mono_f
        --
        -- Invariants:
        --      1. 'binds' binds mono_f
        --      2. ftvs is a subset of tvs
        --      3. ftvs includes all tyvars free in ds
        --
346
        -- See Note [AbsBinds]
347

348
-- | Abtraction Bindings Export
349
data ABExport p
350 351
  = ABE { abe_ext       :: XABE p
        , abe_poly      :: IdP p -- ^ Any INLINE pragma is attached to this Id
352
        , abe_mono      :: IdP p
353 354
        , abe_wrap      :: HsWrapper    -- ^ See Note [ABExport wrapper]
             -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
355
        , abe_prags     :: TcSpecPrags  -- ^ SPECIALISE pragmas
356 357 358
        }
   | XABExport (XXABExport p)

359 360
type instance XABE       (GhcPass p) = NoExt
type instance XXABExport (GhcPass p) = NoExt
361

362

Alan Zimmerman's avatar
Alan Zimmerman committed
363 364 365 366
-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
--             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnLarrow'
--             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen' @'{'@,
--             'ApiAnnotation.AnnClose' @'}'@,
367 368

-- For details on above see note [Api annotations] in ApiAnnotation
369 370

-- | Pattern Synonym binding
371
data PatSynBind idL idR
372 373
  = PSB { psb_ext  :: XPSB idL idR,            -- ^ Post renaming, FVs.
                                               -- See Note [Bind free vars]
374
          psb_id   :: Located (IdP idL),       -- ^ Name of the pattern synonym
375 376 377 378
          psb_args :: HsPatSynDetails (Located (IdP idR)),
                                               -- ^ Formal parameter names
          psb_def  :: LPat idR,                -- ^ Right-hand side
          psb_dir  :: HsPatSynDir idR          -- ^ Directionality
379 380 381
     }
   | XPatSynBind (XXPatSynBind idL idR)

382 383 384 385 386
type instance XPSB         (GhcPass idL) GhcPs = NoExt
type instance XPSB         (GhcPass idL) GhcRn = NameSet
type instance XPSB         (GhcPass idL) GhcTc = NameSet

type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExt
387

Austin Seipp's avatar
Austin Seipp committed
388
{-
389 390
Note [AbsBinds]
~~~~~~~~~~~~~~~
391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435
The AbsBinds constructor is used in the output of the type checker, to
record *typechecked* and *generalised* bindings.  Specifically

         AbsBinds { abs_tvs      = tvs
                  , abs_ev_vars  = [d1,d2]
                  , abs_exports  = [ABE { abe_poly = fp, abe_mono = fm
                                        , abe_wrap = fwrap }
                                    ABE { slly for g } ]
                  , abs_ev_binds = DBINDS
                  , abs_binds    = BIND[fm,gm] }

where 'BIND' binds the monomorphic Ids 'fm' and 'gm', means

        fp = fwrap [/\ tvs. \d1 d2. letrec { DBINDS        ]
                   [                       ; BIND[fm,gm] } ]
                   [                 in fm                 ]

        gp = ...same again, with gm instead of fm

The 'fwrap' is an impedence-matcher that typically does nothing; see
Note [ABExport wrapper].

This is a pretty bad translation, because it duplicates all the bindings.
So the desugarer tries to do a better job:

        fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of
                                        (fm,gm) -> fm
        ..ditto for gp..

        tp = /\ [a,b] -> \ [d1,d2] -> letrec { DBINDS; BIND }
                                      in (fm,gm)

In general:

  * abs_tvs are the type variables over which the binding group is
    generalised
  * abs_ev_var are the evidence variables (usually dictionaries)
    over which the binding group is generalised
  * abs_binds are the monomorphic bindings
  * abs_ex_binds are the evidence bindings that wrap the abs_binds
  * abs_exports connects the monomorphic Ids bound by abs_binds
    with the polymorphic Ids bound by the AbsBinds itself.

For example, consider a module M, with this top-level binding, where
there is no type signature for M.reverse,
436 437 438
    M.reverse []     = []
    M.reverse (x:xs) = M.reverse xs ++ [x]

439 440 441
In Hindley-Milner, a recursive binding is typechecked with the
*recursive* uses being *monomorphic*.  So after typechecking *and*
desugaring we will get something like this
442

443
    M.reverse :: forall a. [a] -> [a]
444
      = /\a. letrec
445 446 447 448 449 450
                reverse :: [a] -> [a] = \xs -> case xs of
                                                []     -> []
                                                (x:xs) -> reverse xs ++ [x]
             in reverse

Notice that 'M.reverse' is polymorphic as expected, but there is a local
Simon Peyton Jones's avatar
Simon Peyton Jones committed
451
definition for plain 'reverse' which is *monomorphic*.  The type variable
452 453
'a' scopes over the entire letrec.

454 455
That's after desugaring.  What about after type checking but before
desugaring?  That's where AbsBinds comes in.  It looks like this:
456 457

   AbsBinds { abs_tvs     = [a]
458
            , abs_ev_vars = []
459
            , abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a],
dfordivam's avatar
dfordivam committed
460
                                 , abe_mono = reverse :: [a] -> [a]}]
461
            , abs_ev_binds = {}
462
            , abs_binds = { reverse :: [a] -> [a]
463 464 465 466 467
                               = \xs -> case xs of
                                            []     -> []
                                            (x:xs) -> reverse xs ++ [x] } }

Here,
468 469 470

  * abs_tvs says what type variables are abstracted over the binding
    group, just 'a' in this case.
471
  * abs_binds is the *monomorphic* bindings of the group
472 473
  * abs_exports describes how to get the polymorphic Id 'M.reverse'
    from the monomorphic one 'reverse'
474 475 476 477 478 479

Notice that the *original* function (the polymorphic one you thought
you were defining) appears in the abe_poly field of the
abs_exports. The bindings in abs_binds are for fresh, local, Ids with
a *monomorphic* Id.

Gabor Greif's avatar
Gabor Greif committed
480
If there is a group of mutually recursive (see Note [Polymorphic
481 482 483 484
recursion]) functions without type signatures, we get one AbsBinds
with the monomorphic versions of the bindings in abs_binds, and one
element of abe_exports for each variable bound in the mutually
recursive group.  This is true even for pattern bindings.  Example:
485 486 487 488 489 490 491 492 493
        (f,g) = (\x -> x, f)
After type checking we get
   AbsBinds { abs_tvs     = [a]
            , abs_exports = [ ABE { abe_poly = M.f :: forall a. a -> a
                                  , abe_mono = f :: a -> a }
                            , ABE { abe_poly = M.g :: forall a. a -> a
                                  , abe_mono = g :: a -> a }]
            , abs_binds = { (f,g) = (\x -> x, f) }

Gabor Greif's avatar
Gabor Greif committed
494
Note [Polymorphic recursion]
495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider
   Rec { f x = ...(g ef)...

       ; g :: forall a. [a] -> [a]
       ; g y = ...(f eg)...  }

These bindings /are/ mutually recursive (f calls g, and g calls f).
But we can use the type signature for g to break the recursion,
like this:

  1. Add g :: forall a. [a] -> [a] to the type environment

  2. Typecheck the definition of f, all by itself,
     including generalising it to find its most general
     type, say f :: forall b. b -> b -> [b]

  3. Extend the type environment with that type for f

  4. Typecheck the definition of g, all by itself,
     checking that it has the type claimed by its signature

Steps 2 and 4 each generate a separate AbsBinds, so we end
up with
   Rec { AbsBinds { ...for f ... }
       ; AbsBinds { ...for g ... } }

This approach allows both f and to call each other
Gabor Greif's avatar
Gabor Greif committed
523
polymorphically, even though only g has a signature.
524 525 526 527 528 529 530

We get an AbsBinds that encompasses multiple source-program
bindings only when
 * Each binding in the group has at least one binder that
   lacks a user type signature
 * The group forms a strongly connected component

531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552

Note [The abs_sig field of AbsBinds]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The abs_sig field supports a couple of special cases for bindings.
Consider

  x :: Num a => (# a, a #)
  x = (# 3, 4 #)

The general desugaring for AbsBinds would give

  x = /\a. \ ($dNum :: Num a) ->
      letrec xm = (# fromInteger $dNum 3, fromInteger $dNum 4 #) in
      xm

But that has an illegal let-binding for an unboxed tuple.  In this
case we'd prefer to generate the (more direct)

  x = /\ a. \ ($dNum :: Num a) ->
     (# fromInteger $dNum 3, fromInteger $dNum 4 #)

A similar thing happens with representation-polymorphic defns
553
(#11405):
554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577

  undef :: forall (r :: RuntimeRep) (a :: TYPE r). HasCallStack => a
  undef = error "undef"

Again, the vanilla desugaring gives a local let-binding for a
representation-polymorphic (undefm :: a), which is illegal.  But
again we can desugar without a let:

  undef = /\ a. \ (d:HasCallStack) -> error a d "undef"

The abs_sig field supports this direct desugaring, with no local
let-bining.  When abs_sig = True

 * the abs_binds is single FunBind

 * the abs_exports is a singleton

 * we have a complete type sig for binder
   and hence the abs_binds is non-recursive
   (it binds the mono_id but refers to the poly_id

These properties are exploited in DsBinds.dsAbsBinds to
generate code without a let-binding.

578 579
Note [ABExport wrapper]
~~~~~~~~~~~~~~~~~~~~~~~
Simon Peyton Jones's avatar
Simon Peyton Jones committed
580
Consider
581 582 583 584 585
   (f,g) = (\x.x, \y.y)
This ultimately desugars to something like this:
   tup :: forall a b. (a->a, b->b)
   tup = /\a b. (\x:a.x, \y:b.y)
   f :: forall a. a -> a
586
   f = /\a. case tup a Any of
587 588 589
               (fm::a->a,gm:Any->Any) -> fm
   ...similarly for g...

Gabor Greif's avatar
Gabor Greif committed
590
The abe_wrap field deals with impedance-matching between
591 592 593 594 595 596 597
    (/\a b. case tup a b of { (f,g) -> f })
and the thing we really want, which may have fewer type
variables.  The action happens in TcBinds.mkExport.

Note [Bind free vars]
~~~~~~~~~~~~~~~~~~~~~
The bind_fvs field of FunBind and PatBind records the free variables
598
of the definition.  It is used for the following purposes
599 600 601

a) Dependency analysis prior to type checking
    (see TcBinds.tc_group)
602

603 604 605
b) Deciding whether we can do generalisation of the binding
    (see TcBinds.decideGeneralisationPlan)

606 607 608 609
c) Deciding whether the binding can be used in static forms
    (see TcExpr.checkClosedInStaticForm for the HsStatic case and
     TcBinds.isClosedBndrGroup).

610
Specifically,
611 612 613 614 615 616 617 618

  * bind_fvs includes all free vars that are defined in this module
    (including top-level things and lexically scoped type variables)

  * bind_fvs excludes imported vars; this is just to keep the set smaller

  * Before renaming, and after typechecking, the field is unused;
    it's just an error thunk
Austin Seipp's avatar
Austin Seipp committed
619
-}
620

621
instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
Ben Gamari's avatar
Ben Gamari committed
622 623
          OutputableBndrId idL, OutputableBndrId idR)
        => Outputable (HsLocalBindsLR idL idR) where
624 625 626 627
  ppr (HsValBinds _ bs)   = ppr bs
  ppr (HsIPBinds _ bs)    = ppr bs
  ppr (EmptyLocalBinds _) = empty
  ppr (XHsLocalBindsLR x) = ppr x
628

629
instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
Ben Gamari's avatar
Ben Gamari committed
630 631
          OutputableBndrId idL, OutputableBndrId idR)
        => Outputable (HsValBindsLR idL idR) where
632
  ppr (ValBinds _ binds sigs)
633
   = pprDeclList (pprLHsBindsForUser binds sigs)
634

635
  ppr (XValBindsLR (NValBinds sccs sigs))
636
    = getPprStyle $ \ sty ->
637 638
      if debugStyle sty then    -- Print with sccs showing
        vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
639
     else
640
        pprDeclList (pprLHsBindsForUser (unionManyBags (map snd sccs)) sigs)
641 642
   where
     ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
643 644
     pp_rec Recursive    = text "rec"
     pp_rec NonRecursive = text "nonrec"
645

646 647
pprLHsBinds :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
            => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
648
pprLHsBinds binds
649
  | isEmptyLHsBinds binds = empty
650
  | otherwise = pprDeclList (map ppr (bagToList binds))
651

652 653 654 655
pprLHsBindsForUser :: (OutputableBndrId (GhcPass idL),
                       OutputableBndrId (GhcPass idR),
                       OutputableBndrId (GhcPass id2))
     => LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc]
656
--  pprLHsBindsForUser is different to pprLHsBinds because
657
--  a) No braces: 'let' and 'where' include a list of HsBindGroups
658
--     and we don't want several groups of bindings each
659 660 661 662
--     with braces around
--  b) Sort by location before printing
--  c) Include signatures
pprLHsBindsForUser binds sigs
663
  = map snd (sort_by_loc decls)
664 665 666 667
  where

    decls :: [(SrcSpan, SDoc)]
    decls = [(loc, ppr sig)  | L loc sig <- sigs] ++
668
            [(loc, ppr bind) | L loc bind <- bagToList binds]
669

670
    sort_by_loc decls = sortBy (comparing fst) decls
671

672 673 674 675 676
pprDeclList :: [SDoc] -> SDoc   -- Braces with a space
-- Print a bunch of declarations
-- One could choose  { d1; d2; ... }, using 'sep'
-- or      d1
--         d2
677
--         ..
678 679 680 681 682
--    using vcat
-- At the moment we chose the latter
-- Also we do the 'pprDeeperList' thing.
pprDeclList ds = pprDeeperList vcat ds

683
------------
684 685 686 687 688 689 690 691 692 693 694 695 696 697 698
emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds = EmptyLocalBinds noExt

-- AZ:These functions do not seem to be used at all?
isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool
isEmptyLocalBindsTc (HsValBinds _ ds)   = isEmptyValBinds ds
isEmptyLocalBindsTc (HsIPBinds _ ds)    = isEmptyIPBindsTc ds
isEmptyLocalBindsTc (EmptyLocalBinds _) = True
isEmptyLocalBindsTc (XHsLocalBindsLR _) = True

isEmptyLocalBindsPR :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
isEmptyLocalBindsPR (HsValBinds _ ds)   = isEmptyValBinds ds
isEmptyLocalBindsPR (HsIPBinds _ ds)    = isEmptyIPBindsPR ds
isEmptyLocalBindsPR (EmptyLocalBinds _) = True
isEmptyLocalBindsPR (XHsLocalBindsLR _) = True
699

Alan Zimmerman's avatar
Alan Zimmerman committed
700
eqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
701 702
eqEmptyLocalBinds (EmptyLocalBinds _) = True
eqEmptyLocalBinds _                   = False
Alan Zimmerman's avatar
Alan Zimmerman committed
703

704 705 706
isEmptyValBinds :: HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
isEmptyValBinds (ValBinds _ ds sigs)  = isEmptyLHsBinds ds && null sigs
isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = null ds && null sigs
707

708 709 710
emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)
emptyValBindsIn  = ValBinds noExt emptyBag []
emptyValBindsOut = XValBindsLR (NValBinds [] [])
711

712
emptyLHsBinds :: LHsBindsLR idL idR
713 714
emptyLHsBinds = emptyBag

715
isEmptyLHsBinds :: LHsBindsLR idL idR -> Bool
716 717 718
isEmptyLHsBinds = isEmptyBag

------------
719 720 721 722 723 724 725
plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
               -> HsValBinds(GhcPass a)
plusHsValBinds (ValBinds _ ds1 sigs1) (ValBinds _ ds2 sigs2)
  = ValBinds noExt (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))
               (XValBindsLR (NValBinds ds2 sigs2))
  = XValBindsLR (NValBinds (ds1 ++ ds2) (sigs1 ++ sigs2))
726 727
plusHsValBinds _ _
  = panic "HsBinds.plusHsValBinds"
728

729
instance (idL ~ GhcPass pl, idR ~ GhcPass pr,
Ben Gamari's avatar
Ben Gamari committed
730 731
          OutputableBndrId idL, OutputableBndrId idR)
         => Outputable (HsBindLR idL idR) where
732
    ppr mbind = ppr_monobind mbind
sof's avatar
sof committed
733

734 735
ppr_monobind :: (OutputableBndrId (GhcPass idL), OutputableBndrId (GhcPass idR))
             => HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
736

737 738
ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })
  = pprPatBind pat grhss
739
ppr_monobind (VarBind { var_id = var, var_rhs = rhs })
740
  = sep [pprBndr CasePatBind var, nest 2 $ equals <+> pprExpr (unLoc rhs)]
741
ppr_monobind (FunBind { fun_id = fun,
742 743
                        fun_co_fn = wrap,
                        fun_matches = matches,
744 745 746
                        fun_tick = ticks })
  = pprTicks empty (if null ticks then empty
                    else text "-- ticks = " <> ppr ticks)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
747
    $$  whenPprDebug (pprBndr LetBind (unLoc fun))
748
    $$  pprFunBind  matches
Simon Peyton Jones's avatar
Simon Peyton Jones committed
749
    $$  whenPprDebug (ppr wrap)
750
ppr_monobind (PatSynBind _ psb) = ppr psb
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
751 752
ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_ev_vars = dictvars
                       , abs_exports = exports, abs_binds = val_binds
753
                       , abs_ev_binds = ev_binds })
754
  = sdocWithDynFlags $ \ dflags ->
eir@cis.upenn.edu's avatar
eir@cis.upenn.edu committed
755
    if gopt Opt_PrintTypecheckerElaboration dflags then
756
      -- Show extra information (bug number: #10662)
757
      hang (text "AbsBinds" <+> brackets (interpp'SP tyvars)
758 759
                                    <+> brackets (interpp'SP dictvars))
         2 $ braces $ vcat
760
      [ text "Exports:" <+>
761
          brackets (sep (punctuate comma (map ppr exports)))
762
      , text "Exported types:" <+>
763
          vcat [pprBndr LetBind (abe_poly ex) | ex <- exports]
764 765
      , text "Binds:" <+> pprLHsBinds val_binds
      , text "Evidence:" <+> ppr ev_binds ]
766 767
    else
      pprLHsBinds val_binds
768
ppr_monobind (XHsBindsLR x) = ppr x
769

770
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (ABExport p) where
771
  ppr (ABE { abe_wrap = wrap, abe_poly = gbl, abe_mono = lcl, abe_prags = prags })
772
    = vcat [ ppr gbl <+> text "<=" <+> ppr lcl
773
           , nest 2 (pprTcSpecPrags prags)
774
           , nest 2 (text "wrap:" <+> ppr wrap)]
775
  ppr (XABExport x) = ppr x
776

777 778
instance (idR ~ GhcPass pr,OutputableBndrId idL, OutputableBndrId idR,
         Outputable (XXPatSynBind idL idR))
Ben Gamari's avatar
Ben Gamari committed
779
          => Outputable (PatSynBind idL idR) where
780 781
  ppr (PSB{ psb_id = (L _ psyn), psb_args = details, psb_def = pat,
            psb_dir = dir })
782 783
      = ppr_lhs <+> ppr_rhs
    where
784
      ppr_lhs = text "pattern" <+> ppr_details
785 786
      ppr_simple syntax = syntax <+> ppr pat

787
      ppr_details = case details of
Simon Peyton Jones's avatar
Simon Peyton Jones committed
788 789 790 791
          InfixCon v1 v2 -> hsep [ppr v1, pprInfixOcc psyn, ppr v2]
          PrefixCon vs   -> hsep (pprPrefixOcc psyn : map ppr vs)
          RecCon vs      -> pprPrefixOcc psyn
                            <> braces (sep (punctuate comma (map ppr vs)))
792 793

      ppr_rhs = case dir of
794
          Unidirectional           -> ppr_simple (text "<-")
795
          ImplicitBidirectional    -> ppr_simple equals
796
          ExplicitBidirectional mg -> ppr_simple (text "<-") <+> ptext (sLit "where") $$
797
                                      (nest 2 $ pprFunBind mg)
798
  ppr (XPatSynBind x) = ppr x
799

800 801
pprTicks :: SDoc -> SDoc -> SDoc
-- Print stuff about ticks only when -dppr-debug is on, to avoid
802
-- them appearing in error messages (from the desugarer); see # 3263
803 804
-- Also print ticks in dumpStyle, so that -ddump-hpc actually does
-- something useful.
805
pprTicks pp_no_debug pp_when_debug
806 807 808
  = getPprStyle (\ sty -> if debugStyle sty || dumpStyle sty
                             then pp_when_debug
                             else pp_no_debug)
809

Austin Seipp's avatar
Austin Seipp committed
810 811 812
{-
************************************************************************
*                                                                      *
813
                Implicit parameter bindings
Austin Seipp's avatar
Austin Seipp committed
814 815 816
*                                                                      *
************************************************************************
-}
817

818
-- | Haskell Implicit Parameter Bindings
819
data HsIPBinds id
820
  = IPBinds
821
        (XIPBinds id)
822
        [LIPBind id]
823 824 825
        -- TcEvBinds       -- Only in typechecker output; binds
        --                 -- uses of the implicit parameters
  | XHsIPBinds (XXHsIPBinds id)
826

827 828
type instance XIPBinds       GhcPs = NoExt
type instance XIPBinds       GhcRn = NoExt
829 830 831 832
type instance XIPBinds       GhcTc = TcEvBinds -- binds uses of the
                                               -- implicit parameters


833
type instance XXHsIPBinds    (GhcPass p) = NoExt
834 835 836 837 838 839 840 841

isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
isEmptyIPBindsPR (IPBinds _ is) = null is
isEmptyIPBindsPR (XHsIPBinds _) = True

isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool
isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds
isEmptyIPBindsTc (XHsIPBinds _) = True
842

843
-- | Located Implicit Parameter Binding
844
type LIPBind id = Located (IPBind id)
Alan Zimmerman's avatar
Alan Zimmerman committed
845 846
-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
--   list
847

848 849
-- For details on above see note [Api annotations] in ApiAnnotation

850
-- | Implicit parameter bindings.
Alan Zimmerman's avatar
Alan Zimmerman committed
851
--
Alan Zimmerman's avatar
Alan Zimmerman committed
852 853 854 855 856
-- These bindings start off as (Left "x") in the parser and stay
-- that way until after type-checking when they are replaced with
-- (Right d), where "d" is the name of the dictionary holding the
-- evidence for the implicit parameter.
--
Alan Zimmerman's avatar
Alan Zimmerman committed
857
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'
858 859

-- For details on above see note [Api annotations] in ApiAnnotation
860
data IPBind id
861
  = IPBind
862
        (XCIPBind id)
863 864
        (Either (Located HsIPName) (IdP id))
        (LHsExpr id)
865
  | XIPBind (XXIPBind id)
866

867
type instance XCIPBind    (GhcPass p) = NoExt
868
type instance XXIPBind    (GhcPass p) = NoExt
869

870 871
instance (p ~ GhcPass pass, OutputableBndrId p)
       => Outputable (HsIPBinds p) where
872
  ppr (IPBinds ds bs) = pprDeeperList vcat (map ppr bs)
Simon Peyton Jones's avatar
Simon Peyton Jones committed
873
                        $$ whenPprDebug (ppr ds)
874
  ppr (XHsIPBinds x) = ppr x
875

876
instance (p ~ GhcPass pass, OutputableBndrId p) => Outputable (IPBind p) where
877
  ppr (IPBind _ lr rhs) = name <+> equals <+> pprExpr (unLoc rhs)
878
    where name = case lr of
Alan Zimmerman's avatar
Alan Zimmerman committed
879 880
                   Left (L _ ip) -> pprBndr LetBind ip
                   Right     id  -> pprBndr LetBind id
881
  ppr (XIPBind x) = ppr x
882

Austin Seipp's avatar
Austin Seipp committed
883 884 885
{-
************************************************************************
*                                                                      *
886
\subsection{@Sig@: type signatures and value-modifying user pragmas}
Austin Seipp's avatar
Austin Seipp committed
887 888
*                                                                      *
************************************************************************
889 890 891 892 893

It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
``specialise this function to these four types...'') in with type
signatures.  Then all the machinery to move them into place, etc.,
serves for both.
Austin Seipp's avatar
Austin Seipp committed
894
-}
895

896
-- | Located Signature
897
type LSig pass = Located (Sig pass)
898

899
-- | Signatures and pragmas
900
data Sig pass
901
  =   -- | An ordinary type signature
902 903 904
      --
      -- > f :: Num a => a -> a
      --
My Nguyen's avatar
My Nguyen committed
905
      -- After renaming, this list of Names contains the named
thomasw's avatar
thomasw committed
906
      -- wildcards brought into scope by this signature. For a signature
My Nguyen's avatar
My Nguyen committed
907 908 909 910 911
      -- @_ -> _a -> Bool@, the renamer will leave the unnamed wildcard @_@
      -- untouched, and the named wildcard @_a@ is then replaced with
      -- fresh meta vars in the type. Their names are stored in the type
      -- signature that brought them into scope, in this third field to be
      -- more specific.
Alan Zimmerman's avatar
Alan Zimmerman committed
912 913 914
      --
      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon',
      --          'ApiAnnotation.AnnComma'
915 916

      -- For details on above see note [Api annotations] in ApiAnnotation
Matthew Pickering's avatar
Matthew Pickering committed
917
    TypeSig
918
       (XTypeSig pass)
919 920
       [Located (IdP pass)]  -- LHS of the signature; e.g.  f,g,h :: blah
       (LHsSigWcType pass)   -- RHS of the signature; can have wildcards
921

cactus's avatar
cactus committed
922
      -- | A pattern synonym type signature
923 924 925 926 927 928
      --
      -- > pattern Single :: () => (Show a) => a -> [a]
      --
      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
      --           'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall'
      --           'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'
929 930

      -- For details on above see note [Api annotations] in ApiAnnotation
931
  | PatSynSig (XPatSynSig pass) [Located (IdP pass)] (LHsSigType pass)
Rik Steenkamp's avatar
Rik Steenkamp committed
932