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

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

Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
-}

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-} -- Note [Pass sensitive types]
                                      -- in module GHC.Hs.PlaceHolder
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeFamilies #-}

module GHC.Hs.Binds where

import GhcPrelude

import {-# SOURCE #-} GHC.Hs.Expr ( pprExpr, LHsExpr,
                                    MatchGroup, pprFunBind,
                                    GRHSs, pprPatBind )
import {-# SOURCE #-} GHC.Hs.Pat  ( LPat )

import GHC.Hs.Extension
import GHC.Hs.Types
import CoreSyn
import TcEvidence
import Type
import NameSet
import BasicTypes
import Outputable
import SrcLoc
import Var
import Bag
import FastString
import BooleanFormula (LBooleanFormula)
import DynFlags

import Data.Data hiding ( Fixity )
import Data.List hiding ( foldr )
import Data.Ord

{-
************************************************************************
*                                                                      *
\subsection{Bindings: @BindGroup@}
*                                                                      *
************************************************************************

Global bindings (where clauses)
-}

-- During renaming, we need bindings where the left-hand sides
-- have been renamed but the right-hand sides have not.
-- 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.

-- | Haskell Local Bindings
type HsLocalBinds id = HsLocalBindsLR id id

-- | Located Haskell local bindings
type LHsLocalBinds id = Located (HsLocalBinds id)

-- | Haskell Local Bindings with separate Left and Right identifier types
--
-- Bindings in a 'let' expression
-- or a 'where' clause
data HsLocalBindsLR idL idR
  = HsValBinds
        (XHsValBinds idL idR)
        (HsValBindsLR idL idR)
      -- ^ Haskell Value Bindings

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

  | HsIPBinds
        (XHsIPBinds idL idR)
        (HsIPBinds idR)
      -- ^ Haskell Implicit Parameter Bindings

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

  | XHsLocalBindsLR
        (XXHsLocalBindsLR idL idR)

type instance XHsValBinds      (GhcPass pL) (GhcPass pR) = NoExtField
type instance XHsIPBinds       (GhcPass pL) (GhcPass pR) = NoExtField
type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField
type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon

type LHsLocalBindsLR idL idR = Located (HsLocalBindsLR idL idR)


-- | Haskell Value Bindings
type HsValBinds id = HsValBindsLR id id

-- | Haskell Value bindings with separate Left and Right identifier types
-- (not implicit parameters)
-- Used for both top level and nested bindings
-- May contain pattern synonym bindings
data HsValBindsLR idL idR
  = -- | Value Bindings In
    --
    -- Before renaming RHS; idR is always RdrName
    -- Not dependency analysed
    -- Recursive by default
    ValBinds
        (XValBinds idL idR)
        (LHsBindsLR idL idR) [LSig idR]

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

-- ---------------------------------------------------------------------
-- Deal with ValBindsOut

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

type instance XValBinds    (GhcPass pL) (GhcPass pR) = NoExtField
type instance XXValBindsLR (GhcPass pL) (GhcPass pR)
            = NHsValBindsLR (GhcPass pL)

-- ---------------------------------------------------------------------

-- | Located Haskell Binding
type LHsBind  id = LHsBindLR  id id

-- | Located Haskell Bindings
type LHsBinds id = LHsBindsLR id id

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

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

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

{- Note [FunBind vs PatBind]
   ~~~~~~~~~~~~~~~~~~~~~~~~~
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.
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

  * 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`).

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

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

-- | Haskell Binding with separate Left and Right id's
data HsBindLR idL idR
  = -- | Function-like Binding
    --
    -- FunBind is used for both functions     @f x = e@
    -- and variables                          @f = \x -> e@
    -- and strict variables                   @!x = x + 1@
    --
    -- 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) = ... @
    --
    -- Strict bindings have their strictness recorded in the 'SrcStrictness' of their
    -- 'MatchContext'. See Note [FunBind vs PatBind] for
    -- details about the relationship between FunBind and PatBind.
    --
    --  'ApiAnnotation.AnnKeywordId's
    --
    --  - 'ApiAnnotation.AnnFunId', attached to each element of fun_matches
    --
    --  - 'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
    --    'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',

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

        HsBindLR idL idR -> XFunBind idL idR
fun_ext :: XFunBind idL idR, -- ^ After the renamer, this contains
                                --  the locally-bound
                                -- free variables of this defn.
                                -- See Note [Bind free vars]

        HsBindLR idL idR -> Located (IdP idL)
fun_id :: Located (IdP idL), -- Note [fun_id in Match] in GHC.Hs.Expr

        HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches :: MatchGroup idR (LHsExpr idR),  -- ^ The payload

        HsBindLR idL idR -> HsWrapper
fun_co_fn :: HsWrapper, -- ^ Coercion from the type of the MatchGroup to the type of
                                -- the Id.  Example:
                                --
                                -- @
                                --      f :: Int -> forall a. a -> a
                                --      f x y = y
                                -- @
                                --
                                -- 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'.

        HsBindLR idL idR -> [Tickish Id]
fun_tick :: [Tickish Id] -- ^ Ticks to put on the rhs, if any
    }

  -- | Pattern Binding
  --
  -- The pattern is never a simple variable;
  -- That case is done by FunBind.
  -- See Note [FunBind vs PatBind] for details about the
  -- relationship between FunBind and PatBind.

  --
  --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnBang',
  --       'ApiAnnotation.AnnEqual','ApiAnnotation.AnnWhere',
  --       'ApiAnnotation.AnnOpen','ApiAnnotation.AnnClose',

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

  -- | Variable Binding
  --
  -- Dictionary binding and suchlike.
  -- All VarBinds are introduced by the type checker
  | VarBind {
        HsBindLR idL idR -> XVarBind idL idR
var_ext    :: XVarBind idL idR,
        HsBindLR idL idR -> IdP idL
var_id     :: IdP idL,
        HsBindLR idL idR -> LHsExpr idR
var_rhs    :: LHsExpr idR,   -- ^ Located only for consistency
        HsBindLR idL idR -> Bool
var_inline :: Bool           -- ^ True <=> inline this binding regardless
                                     -- (used for implication constraints only)
    }

  -- | Abstraction Bindings
  | AbsBinds {                      -- Binds abstraction; TRANSLATION
        HsBindLR idL idR -> XAbsBinds idL idR
abs_ext     :: XAbsBinds idL idR,
        HsBindLR idL idR -> [Id]
abs_tvs     :: [TyVar],
        HsBindLR idL idR -> [Id]
abs_ev_vars :: [EvVar],  -- ^ Includes equality constraints

       -- | AbsBinds only gets used when idL = idR after renaming,
       -- but these need to be idL's for the collect... code in HsUtil
       -- to have the right type
        HsBindLR idL idR -> [ABExport idL]
abs_exports :: [ABExport idL],

        -- | Evidence bindings
        -- Why a list? See TcInstDcls
        -- Note [Typechecking plan for instance declarations]
        HsBindLR idL idR -> [TcEvBinds]
abs_ev_binds :: [TcEvBinds],

        -- | Typechecked user bindings
        HsBindLR idL idR -> LHsBinds idL
abs_binds    :: LHsBinds idL,

        HsBindLR idL idR -> Bool
abs_sig :: Bool  -- See Note [The abs_sig field of AbsBinds]
    }

  -- | Patterns Synonym Binding
  | PatSynBind
        (XPatSynBind idL idR)
        (PatSynBind idL idR)
        -- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
        --          'ApiAnnotation.AnnLarrow','ApiAnnotation.AnnEqual',
        --          'ApiAnnotation.AnnWhere'
        --          'ApiAnnotation.AnnOpen' @'{'@,'ApiAnnotation.AnnClose' @'}'@

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

  | XHsBindsLR (XXHsBindsLR idL idR)

data NPatBindTc = NPatBindTc {
     NPatBindTc -> NameSet
pat_fvs :: NameSet, -- ^ Free variables
     NPatBindTc -> Type
pat_rhs_ty :: Type  -- ^ Type of the GRHSs
     } deriving Typeable NPatBindTc
DataType
Constr
Typeable NPatBindTc
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> NPatBindTc -> c NPatBindTc)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c NPatBindTc)
-> (NPatBindTc -> Constr)
-> (NPatBindTc -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c NPatBindTc))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c NPatBindTc))
-> ((forall b. Data b => b -> b) -> NPatBindTc -> NPatBindTc)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> NPatBindTc -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> NPatBindTc -> r)
-> (forall u. (forall d. Data d => d -> u) -> NPatBindTc -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> NPatBindTc -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc)
-> Data NPatBindTc
NPatBindTc -> DataType
NPatBindTc -> Constr
(forall b. Data b => b -> b) -> NPatBindTc -> NPatBindTc
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NPatBindTc -> c NPatBindTc
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NPatBindTc
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NPatBindTc -> u
forall u. (forall d. Data d => d -> u) -> NPatBindTc -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NPatBindTc -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NPatBindTc -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NPatBindTc
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NPatBindTc -> c NPatBindTc
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NPatBindTc)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NPatBindTc)
$cNPatBindTc :: Constr
$tNPatBindTc :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc
gmapMp :: (forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc
gmapM :: (forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NPatBindTc -> m NPatBindTc
gmapQi :: Int -> (forall d. Data d => d -> u) -> NPatBindTc -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NPatBindTc -> u
gmapQ :: (forall d. Data d => d -> u) -> NPatBindTc -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NPatBindTc -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NPatBindTc -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NPatBindTc -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NPatBindTc -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NPatBindTc -> r
gmapT :: (forall b. Data b => b -> b) -> NPatBindTc -> NPatBindTc
$cgmapT :: (forall b. Data b => b -> b) -> NPatBindTc -> NPatBindTc
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NPatBindTc)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NPatBindTc)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c NPatBindTc)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NPatBindTc)
dataTypeOf :: NPatBindTc -> DataType
$cdataTypeOf :: NPatBindTc -> DataType
toConstr :: NPatBindTc -> Constr
$ctoConstr :: NPatBindTc -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NPatBindTc
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NPatBindTc
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NPatBindTc -> c NPatBindTc
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NPatBindTc -> c NPatBindTc
$cp1Data :: Typeable NPatBindTc
Data

type instance XFunBind    (GhcPass pL) GhcPs = NoExtField
type instance XFunBind    (GhcPass pL) GhcRn = NameSet -- Free variables
type instance XFunBind    (GhcPass pL) GhcTc = NameSet -- Free variables

type instance XPatBind    GhcPs (GhcPass pR) = NoExtField
type instance XPatBind    GhcRn (GhcPass pR) = NameSet -- Free variables
type instance XPatBind    GhcTc (GhcPass pR) = NPatBindTc

type instance XVarBind    (GhcPass pL) (GhcPass pR) = NoExtField
type instance XAbsBinds   (GhcPass pL) (GhcPass pR) = NoExtField
type instance XPatSynBind (GhcPass pL) (GhcPass pR) = NoExtField
type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon


        -- 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
        --
        -- See Note [AbsBinds]

-- | Abtraction Bindings Export
data ABExport p
  = ABE { ABExport p -> XABE p
abe_ext       :: XABE p
        , ABExport p -> IdP p
abe_poly      :: IdP p -- ^ Any INLINE pragma is attached to this Id
        , ABExport p -> IdP p
abe_mono      :: IdP p
        , ABExport p -> HsWrapper
abe_wrap      :: HsWrapper    -- ^ See Note [ABExport wrapper]
             -- Shape: (forall abs_tvs. abs_ev_vars => abe_mono) ~ abe_poly
        , ABExport p -> TcSpecPrags
abe_prags     :: TcSpecPrags  -- ^ SPECIALISE pragmas
        }
   | XABExport (XXABExport p)

type instance XABE       (GhcPass p) = NoExtField
type instance XXABExport (GhcPass p) = NoExtCon


-- | - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
--             'ApiAnnotation.AnnEqual','ApiAnnotation.AnnLarrow'
--             'ApiAnnotation.AnnWhere','ApiAnnotation.AnnOpen' @'{'@,
--             'ApiAnnotation.AnnClose' @'}'@,

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

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

type instance XPSB         (GhcPass idL) GhcPs = NoExtField
type instance XPSB         (GhcPass idL) GhcRn = NameSet
type instance XPSB         (GhcPass idL) GhcTc = NameSet

type instance XXPatSynBind (GhcPass idL) (GhcPass idR) = NoExtCon

{-
Note [AbsBinds]
~~~~~~~~~~~~~~~
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,
    M.reverse []     = []
    M.reverse (x:xs) = M.reverse xs ++ [x]

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

    M.reverse :: forall a. [a] -> [a]
      = /\a. letrec
                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
definition for plain 'reverse' which is *monomorphic*.  The type variable
'a' scopes over the entire letrec.

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

   AbsBinds { abs_tvs     = [a]
            , abs_ev_vars = []
            , abs_exports = [ABE { abe_poly = M.reverse :: forall a. [a] -> [a],
                                 , abe_mono = reverse :: [a] -> [a]}]
            , abs_ev_binds = {}
            , abs_binds = { reverse :: [a] -> [a]
                               = \xs -> case xs of
                                            []     -> []
                                            (x:xs) -> reverse xs ++ [x] } }

Here,

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

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.

If there is a group of mutually recursive (see Note [Polymorphic
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:
        (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) }

Note [Polymorphic recursion]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
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
polymorphically, even though only g has a signature.

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


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
(#11405):

  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.

Note [ABExport wrapper]
~~~~~~~~~~~~~~~~~~~~~~~
Consider
   (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
   f = /\a. case tup a Any of
               (fm::a->a,gm:Any->Any) -> fm
   ...similarly for g...

The abe_wrap field deals with impedance-matching between
    (/\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
of the definition.  It is used for the following purposes

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

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

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

Specifically,

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

instance (OutputableBndrId pl, OutputableBndrId pr)
        => Outputable (HsLocalBindsLR (GhcPass pl) (GhcPass pr)) where
  ppr :: HsLocalBindsLR (GhcPass pl) (GhcPass pr) -> SDoc
ppr (HsValBinds XHsValBinds (GhcPass pl) (GhcPass pr)
_ HsValBindsLR (GhcPass pl) (GhcPass pr)
bs)   = HsValBindsLR (GhcPass pl) (GhcPass pr) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsValBindsLR (GhcPass pl) (GhcPass pr)
bs
  ppr (HsIPBinds XHsIPBinds (GhcPass pl) (GhcPass pr)
_ HsIPBinds (GhcPass pr)
bs)    = HsIPBinds (GhcPass pr) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsIPBinds (GhcPass pr)
bs
  ppr (EmptyLocalBinds XEmptyLocalBinds (GhcPass pl) (GhcPass pr)
_) = SDoc
empty
  ppr (XHsLocalBindsLR XXHsLocalBindsLR (GhcPass pl) (GhcPass pr)
x) = NoExtCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXHsLocalBindsLR (GhcPass pl) (GhcPass pr)
NoExtCon
x

instance (OutputableBndrId pl, OutputableBndrId pr)
        => Outputable (HsValBindsLR (GhcPass pl) (GhcPass pr)) where
  ppr :: HsValBindsLR (GhcPass pl) (GhcPass pr) -> SDoc
ppr (ValBinds XValBinds (GhcPass pl) (GhcPass pr)
_ LHsBindsLR (GhcPass pl) (GhcPass pr)
binds [LSig (GhcPass pr)]
sigs)
   = [SDoc] -> SDoc
pprDeclList (LHsBindsLR (GhcPass pl) (GhcPass pr)
-> [LSig (GhcPass pr)] -> [SDoc]
forall (idL :: Pass) (idR :: Pass) (id2 :: Pass).
(OutputableBndrId idL, OutputableBndrId idR,
 OutputableBndrId id2) =>
LHsBindsLR (GhcPass idL) (GhcPass idR)
-> [LSig (GhcPass id2)] -> [SDoc]
pprLHsBindsForUser LHsBindsLR (GhcPass pl) (GhcPass pr)
binds [LSig (GhcPass pr)]
sigs)

  ppr (XValBindsLR (NValBinds sccs sigs))
    = (PprStyle -> SDoc) -> SDoc
getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ PprStyle
sty ->
      if PprStyle -> Bool
debugStyle PprStyle
sty then    -- Print with sccs showing
        [SDoc] -> SDoc
vcat ((LSig GhcRn -> SDoc) -> [LSig GhcRn] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LSig GhcRn -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LSig GhcRn]
sigs) SDoc -> SDoc -> SDoc
$$ [SDoc] -> SDoc
vcat (((RecFlag, LHsBindsLR (GhcPass pl) (GhcPass pl)) -> SDoc)
-> [(RecFlag, LHsBindsLR (GhcPass pl) (GhcPass pl))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag, LHsBindsLR (GhcPass pl) (GhcPass pl)) -> SDoc
forall (idR :: Pass) (idL :: Pass).
(OutputableBndr (IdP (GhcPass (NoGhcTcPass idR))),
 OutputableBndr (NameOrRdrName (IdP (GhcPass (NoGhcTcPass idR)))),
 OutputableBndr (IdP (GhcPass idR)),
 OutputableBndr (NameOrRdrName (IdP (GhcPass idR))),
 OutputableBndr (NameOrRdrName (IdP (GhcPass idL))),
 OutputableBndr (IdP (GhcPass idL)),
 OutputableBndr (IdP (GhcPass (NoGhcTcPass idL))),
 OutputableBndr (NameOrRdrName (IdP (GhcPass (NoGhcTcPass idL)))),
 Outputable (XViaStrategy (GhcPass (NoGhcTcPass idL))),
 Outputable (XIPBinds (GhcPass (NoGhcTcPass idL))),
 Outputable (XViaStrategy (GhcPass idL)),
 Outputable (XIPBinds (GhcPass idL)),
 Outputable (XIPBinds (GhcPass idR)),
 Outputable (XViaStrategy (GhcPass idR)),
 Outputable (XIPBinds (GhcPass (NoGhcTcPass idR))),
 Outputable (XViaStrategy (GhcPass (NoGhcTcPass idR))),
 NoGhcTcPass idL ~ NoGhcTcPass (NoGhcTcPass idL),
 NoGhcTcPass idR ~ NoGhcTcPass (NoGhcTcPass idR)) =>
(RecFlag, LHsBindsLR (GhcPass idL) (GhcPass idR)) -> SDoc
ppr_scc [(RecFlag, LHsBindsLR (GhcPass pl) (GhcPass pl))]
sccs)
     else
        [SDoc] -> SDoc
pprDeclList (LHsBindsLR (GhcPass pl) (GhcPass pl) -> [LSig GhcRn] -> [SDoc]
forall (idL :: Pass) (idR :: Pass) (id2 :: Pass).
(OutputableBndrId idL, OutputableBndrId idR,
 OutputableBndrId id2) =>
LHsBindsLR (GhcPass idL) (GhcPass idR)
-> [LSig (GhcPass id2)] -> [SDoc]
pprLHsBindsForUser ([LHsBindsLR (GhcPass pl) (GhcPass pl)]
-> LHsBindsLR (GhcPass pl) (GhcPass pl)
forall a. [Bag a] -> Bag a
unionManyBags (((RecFlag, LHsBindsLR (GhcPass pl) (GhcPass pl))
 -> LHsBindsLR (GhcPass pl) (GhcPass pl))
-> [(RecFlag, LHsBindsLR (GhcPass pl) (GhcPass pl))]
-> [LHsBindsLR (GhcPass pl) (GhcPass pl)]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag, LHsBindsLR (GhcPass pl) (GhcPass pl))
-> LHsBindsLR (GhcPass pl) (GhcPass pl)
forall a b. (a, b) -> b
snd [(RecFlag, LHsBindsLR (GhcPass pl) (GhcPass pl))]
sccs)) [LSig GhcRn]
sigs)
   where
     ppr_scc :: (RecFlag, LHsBindsLR (GhcPass idL) (GhcPass idR)) -> SDoc
ppr_scc (RecFlag
rec_flag, LHsBindsLR (GhcPass idL) (GhcPass idR)
binds) = RecFlag -> SDoc
pp_rec RecFlag
rec_flag SDoc -> SDoc -> SDoc
<+> LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
forall (idL :: Pass) (idR :: Pass).
(OutputableBndrId idL, OutputableBndrId idR) =>
LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
pprLHsBinds LHsBindsLR (GhcPass idL) (GhcPass idR)
binds
     pp_rec :: RecFlag -> SDoc
pp_rec RecFlag
Recursive    = String -> SDoc
text String
"rec"
     pp_rec RecFlag
NonRecursive = String -> SDoc
text String
"nonrec"

pprLHsBinds :: (OutputableBndrId idL, OutputableBndrId idR)
            => LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
pprLHsBinds :: LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
pprLHsBinds LHsBindsLR (GhcPass idL) (GhcPass idR)
binds
  | LHsBindsLR (GhcPass idL) (GhcPass idR) -> Bool
forall idL idR. LHsBindsLR idL idR -> Bool
isEmptyLHsBinds LHsBindsLR (GhcPass idL) (GhcPass idR)
binds = SDoc
empty
  | Bool
otherwise = [SDoc] -> SDoc
pprDeclList ((LHsBindLR (GhcPass idL) (GhcPass idR) -> SDoc)
-> [LHsBindLR (GhcPass idL) (GhcPass idR)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LHsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (LHsBindsLR (GhcPass idL) (GhcPass idR)
-> [LHsBindLR (GhcPass idL) (GhcPass idR)]
forall a. Bag a -> [a]
bagToList LHsBindsLR (GhcPass idL) (GhcPass idR)
binds))

pprLHsBindsForUser :: (OutputableBndrId idL,
                       OutputableBndrId idR,
                       OutputableBndrId id2)
     => LHsBindsLR (GhcPass idL) (GhcPass idR) -> [LSig (GhcPass id2)] -> [SDoc]
--  pprLHsBindsForUser is different to pprLHsBinds because
--  a) No braces: 'let' and 'where' include a list of HsBindGroups
--     and we don't want several groups of bindings each
--     with braces around
--  b) Sort by location before printing
--  c) Include signatures
pprLHsBindsForUser :: LHsBindsLR (GhcPass idL) (GhcPass idR)
-> [LSig (GhcPass id2)] -> [SDoc]
pprLHsBindsForUser LHsBindsLR (GhcPass idL) (GhcPass idR)
binds [LSig (GhcPass id2)]
sigs
  = ((SrcSpan, SDoc) -> SDoc) -> [(SrcSpan, SDoc)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (SrcSpan, SDoc) -> SDoc
forall a b. (a, b) -> b
snd ([(SrcSpan, SDoc)] -> [(SrcSpan, SDoc)]
forall a b. Ord a => [(a, b)] -> [(a, b)]
sort_by_loc [(SrcSpan, SDoc)]
decls)
  where

    decls :: [(SrcSpan, SDoc)]
    decls :: [(SrcSpan, SDoc)]
decls = [(SrcSpan
loc, Sig (GhcPass id2) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Sig (GhcPass id2)
sig)  | L SrcSpan
loc Sig (GhcPass id2)
sig <- [LSig (GhcPass id2)]
sigs] [(SrcSpan, SDoc)] -> [(SrcSpan, SDoc)] -> [(SrcSpan, SDoc)]
forall a. [a] -> [a] -> [a]
++
            [(SrcSpan
loc, HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsBindLR (GhcPass idL) (GhcPass idR)
bind) | L SrcSpan
loc HsBindLR (GhcPass idL) (GhcPass idR)
bind <- LHsBindsLR (GhcPass idL) (GhcPass idR)
-> [GenLocated SrcSpan (HsBindLR (GhcPass idL) (GhcPass idR))]
forall a. Bag a -> [a]
bagToList LHsBindsLR (GhcPass idL) (GhcPass idR)
binds]

    sort_by_loc :: [(a, b)] -> [(a, b)]
sort_by_loc [(a, b)]
decls = ((a, b) -> (a, b) -> Ordering) -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((a, b) -> a) -> (a, b) -> (a, b) -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (a, b) -> a
forall a b. (a, b) -> a
fst) [(a, b)]
decls

pprDeclList :: [SDoc] -> SDoc   -- Braces with a space
-- Print a bunch of declarations
-- One could choose  { d1; d2; ... }, using 'sep'
-- or      d1
--         d2
--         ..
--    using vcat
-- At the moment we chose the latter
-- Also we do the 'pprDeeperList' thing.
pprDeclList :: [SDoc] -> SDoc
pprDeclList [SDoc]
ds = ([SDoc] -> SDoc) -> [SDoc] -> SDoc
pprDeeperList [SDoc] -> SDoc
vcat [SDoc]
ds

------------
emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds :: HsLocalBindsLR (GhcPass a) (GhcPass b)
emptyLocalBinds = XEmptyLocalBinds (GhcPass a) (GhcPass b)
-> HsLocalBindsLR (GhcPass a) (GhcPass b)
forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
EmptyLocalBinds XEmptyLocalBinds (GhcPass a) (GhcPass b)
NoExtField
noExtField

-- AZ:These functions do not seem to be used at all?
isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool
isEmptyLocalBindsTc :: HsLocalBindsLR (GhcPass a) GhcTc -> Bool
isEmptyLocalBindsTc (HsValBinds XHsValBinds (GhcPass a) GhcTc
_ HsValBindsLR (GhcPass a) GhcTc
ds)   = HsValBindsLR (GhcPass a) GhcTc -> Bool
forall (a :: Pass) (b :: Pass).
HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
isEmptyValBinds HsValBindsLR (GhcPass a) GhcTc
ds
isEmptyLocalBindsTc (HsIPBinds XHsIPBinds (GhcPass a) GhcTc
_ HsIPBinds GhcTc
ds)    = HsIPBinds GhcTc -> Bool
isEmptyIPBindsTc HsIPBinds GhcTc
ds
isEmptyLocalBindsTc (EmptyLocalBinds XEmptyLocalBinds (GhcPass a) GhcTc
_) = Bool
True
isEmptyLocalBindsTc (XHsLocalBindsLR XXHsLocalBindsLR (GhcPass a) GhcTc
_) = Bool
True

isEmptyLocalBindsPR :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
isEmptyLocalBindsPR :: HsLocalBindsLR (GhcPass a) (GhcPass b) -> Bool
isEmptyLocalBindsPR (HsValBinds XHsValBinds (GhcPass a) (GhcPass b)
_ HsValBindsLR (GhcPass a) (GhcPass b)
ds)   = HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
forall (a :: Pass) (b :: Pass).
HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
isEmptyValBinds HsValBindsLR (GhcPass a) (GhcPass b)
ds
isEmptyLocalBindsPR (HsIPBinds XHsIPBinds (GhcPass a) (GhcPass b)
_ HsIPBinds (GhcPass b)
ds)    = HsIPBinds (GhcPass b) -> Bool
forall (p :: Pass). HsIPBinds (GhcPass p) -> Bool
isEmptyIPBindsPR HsIPBinds (GhcPass b)
ds
isEmptyLocalBindsPR (EmptyLocalBinds XEmptyLocalBinds (GhcPass a) (GhcPass b)
_) = Bool
True
isEmptyLocalBindsPR (XHsLocalBindsLR XXHsLocalBindsLR (GhcPass a) (GhcPass b)
_) = Bool
True

eqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds :: HsLocalBindsLR a b -> Bool
eqEmptyLocalBinds (EmptyLocalBinds XEmptyLocalBinds a b
_) = Bool
True
eqEmptyLocalBinds HsLocalBindsLR a b
_                   = Bool
False

isEmptyValBinds :: HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
isEmptyValBinds :: HsValBindsLR (GhcPass a) (GhcPass b) -> Bool
isEmptyValBinds (ValBinds XValBinds (GhcPass a) (GhcPass b)
_ LHsBindsLR (GhcPass a) (GhcPass b)
ds [LSig (GhcPass b)]
sigs)  = LHsBindsLR (GhcPass a) (GhcPass b) -> Bool
forall idL idR. LHsBindsLR idL idR -> Bool
isEmptyLHsBinds LHsBindsLR (GhcPass a) (GhcPass b)
ds Bool -> Bool -> Bool
&& [LSig (GhcPass b)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSig (GhcPass b)]
sigs
isEmptyValBinds (XValBindsLR (NValBinds ds sigs)) = [(RecFlag, LHsBinds (GhcPass a))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(RecFlag, LHsBinds (GhcPass a))]
ds Bool -> Bool -> Bool
&& [LSig GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LSig GhcRn]
sigs

emptyValBindsIn, emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)
emptyValBindsIn :: HsValBindsLR (GhcPass a) (GhcPass b)
emptyValBindsIn  = XValBinds (GhcPass a) (GhcPass b)
-> LHsBindsLR (GhcPass a) (GhcPass b)
-> [LSig (GhcPass b)]
-> HsValBindsLR (GhcPass a) (GhcPass b)
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds (GhcPass a) (GhcPass b)
NoExtField
noExtField LHsBindsLR (GhcPass a) (GhcPass b)
forall a. Bag a
emptyBag []
emptyValBindsOut :: HsValBindsLR (GhcPass a) (GhcPass b)
emptyValBindsOut = XXValBindsLR (GhcPass a) (GhcPass b)
-> HsValBindsLR (GhcPass a) (GhcPass b)
forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
XValBindsLR ([(RecFlag, LHsBinds (GhcPass a))]
-> [LSig GhcRn] -> NHsValBindsLR (GhcPass a)
forall idL.
[(RecFlag, LHsBinds idL)] -> [LSig GhcRn] -> NHsValBindsLR idL
NValBinds [] [])

emptyLHsBinds :: LHsBindsLR idL idR
emptyLHsBinds :: LHsBindsLR idL idR
emptyLHsBinds = LHsBindsLR idL idR
forall a. Bag a
emptyBag

isEmptyLHsBinds :: LHsBindsLR idL idR -> Bool
isEmptyLHsBinds :: LHsBindsLR idL idR -> Bool
isEmptyLHsBinds = LHsBindsLR idL idR -> Bool
forall a. Bag a -> Bool
isEmptyBag

------------
plusHsValBinds :: HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
               -> HsValBinds(GhcPass a)
plusHsValBinds :: HsValBinds (GhcPass a)
-> HsValBinds (GhcPass a) -> HsValBinds (GhcPass a)
plusHsValBinds (ValBinds XValBinds (GhcPass a) (GhcPass a)
_ LHsBindsLR (GhcPass a) (GhcPass a)
ds1 [LSig (GhcPass a)]
sigs1) (ValBinds XValBinds (GhcPass a) (GhcPass a)
_ LHsBindsLR (GhcPass a) (GhcPass a)
ds2 [LSig (GhcPass a)]
sigs2)
  = XValBinds (GhcPass a) (GhcPass a)
-> LHsBindsLR (GhcPass a) (GhcPass a)
-> [LSig (GhcPass a)]
-> HsValBinds (GhcPass a)
forall idL idR.
XValBinds idL idR
-> LHsBindsLR idL idR -> [LSig idR] -> HsValBindsLR idL idR
ValBinds XValBinds (GhcPass a) (GhcPass a)
NoExtField
noExtField (LHsBindsLR (GhcPass a) (GhcPass a)
ds1 LHsBindsLR (GhcPass a) (GhcPass a)
-> LHsBindsLR (GhcPass a) (GhcPass a)
-> LHsBindsLR (GhcPass a) (GhcPass a)
forall a. Bag a -> Bag a -> Bag a
`unionBags` LHsBindsLR (GhcPass a) (GhcPass a)
ds2) ([LSig (GhcPass a)]
sigs1 [LSig (GhcPass a)] -> [LSig (GhcPass a)] -> [LSig (GhcPass a)]
forall a. [a] -> [a] -> [a]
++ [LSig (GhcPass a)]
sigs2)
plusHsValBinds (XValBindsLR (NValBinds ds1 sigs1))
               (XValBindsLR (NValBinds ds2 sigs2))
  = XXValBindsLR (GhcPass a) (GhcPass a) -> HsValBinds (GhcPass a)
forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
XValBindsLR ([(RecFlag, LHsBindsLR (GhcPass a) (GhcPass a))]
-> [LSig GhcRn] -> NHsValBindsLR (GhcPass a)
forall idL.
[(RecFlag, LHsBinds idL)] -> [LSig GhcRn] -> NHsValBindsLR idL
NValBinds ([(RecFlag, LHsBindsLR (GhcPass a) (GhcPass a))]
ds1 [(RecFlag, LHsBindsLR (GhcPass a) (GhcPass a))]
-> [(RecFlag, LHsBindsLR (GhcPass a) (GhcPass a))]
-> [(RecFlag, LHsBindsLR (GhcPass a) (GhcPass a))]
forall a. [a] -> [a] -> [a]
++ [(RecFlag, LHsBindsLR (GhcPass a) (GhcPass a))]
ds2) ([LSig GhcRn]
sigs1 [LSig GhcRn] -> [LSig GhcRn] -> [LSig GhcRn]
forall a. [a] -> [a] -> [a]
++ [LSig GhcRn]
sigs2))
plusHsValBinds HsValBinds (GhcPass a)
_ HsValBinds (GhcPass a)
_
  = String -> HsValBinds (GhcPass a)
forall a. String -> a
panic String
"HsBinds.plusHsValBinds"

instance (OutputableBndrId pl, OutputableBndrId pr)
         => Outputable (HsBindLR (GhcPass pl) (GhcPass pr)) where
    ppr :: HsBindLR (GhcPass pl) (GhcPass pr) -> SDoc
ppr HsBindLR (GhcPass pl) (GhcPass pr)
mbind = HsBindLR (GhcPass pl) (GhcPass pr) -> SDoc
forall (pl :: Pass) (pr :: Pass).
(OutputableBndrId pl, OutputableBndrId pr) =>
HsBindLR (GhcPass pl) (GhcPass pr) -> SDoc
ppr_monobind HsBindLR (GhcPass pl) (GhcPass pr)
mbind

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

ppr_monobind :: HsBindLR (GhcPass idL) (GhcPass idR) -> SDoc
ppr_monobind (PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_lhs = LPat (GhcPass idL)
pat, pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_rhs = GRHSs (GhcPass idR) (LHsExpr (GhcPass idR))
grhss })
  = LPat (GhcPass idL)
-> GRHSs (GhcPass idR) (LHsExpr (GhcPass idR)) -> SDoc
forall (bndr :: Pass) (p :: Pass) body.
(OutputableBndrId bndr, OutputableBndrId p, Outputable body) =>
LPat (GhcPass bndr) -> GRHSs (GhcPass p) body -> SDoc
pprPatBind LPat (GhcPass idL)
pat GRHSs (GhcPass idR) (LHsExpr (GhcPass idR))
grhss
ppr_monobind (VarBind { var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_id = IdP (GhcPass idL)
var, var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_rhs = LHsExpr (GhcPass idR)
rhs })
  = [SDoc] -> SDoc
sep [BindingSite -> IdP (GhcPass idL) -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
CasePatBind IdP (GhcPass idL)
var, Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc
equals SDoc -> SDoc -> SDoc
<+> HsExpr (GhcPass idR) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsExpr (GhcPass p) -> SDoc
pprExpr (LHsExpr (GhcPass idR) -> SrcSpanLess (LHsExpr (GhcPass idR))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr (GhcPass idR)
rhs)]
ppr_monobind (FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
fun_id = Located (IdP (GhcPass idL))
fun,
                        fun_co_fn :: forall idL idR. HsBindLR idL idR -> HsWrapper
fun_co_fn = HsWrapper
wrap,
                        fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_matches = MatchGroup (GhcPass idR) (LHsExpr (GhcPass idR))
matches,
                        fun_tick :: forall idL idR. HsBindLR idL idR -> [Tickish Id]
fun_tick = [Tickish Id]
ticks })
  = SDoc -> SDoc -> SDoc
pprTicks SDoc
empty (if [Tickish Id] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Tickish Id]
ticks then SDoc
empty
                    else String -> SDoc
text String
"-- ticks = " SDoc -> SDoc -> SDoc
<> [Tickish Id] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Tickish Id]
ticks)
    SDoc -> SDoc -> SDoc
$$  SDoc -> SDoc
whenPprDebug (BindingSite -> IdP (GhcPass idL) -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind (Located (IdP (GhcPass idL))
-> SrcSpanLess (Located (IdP (GhcPass idL)))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP (GhcPass idL))
fun))
    SDoc -> SDoc -> SDoc
$$  MatchGroup (GhcPass idR) (LHsExpr (GhcPass idR)) -> SDoc
forall (idR :: Pass) body.
(OutputableBndrId idR, Outputable body) =>
MatchGroup (GhcPass idR) body -> SDoc
pprFunBind  MatchGroup (GhcPass idR) (LHsExpr (GhcPass idR))
matches
    SDoc -> SDoc -> SDoc
$$  SDoc -> SDoc
whenPprDebug (HsWrapper -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsWrapper
wrap)
ppr_monobind (PatSynBind XPatSynBind (GhcPass idL) (GhcPass idR)
_ PatSynBind (GhcPass idL) (GhcPass idR)
psb) = PatSynBind (GhcPass idL) (GhcPass idR) -> SDoc
forall a. Outputable a => a -> SDoc
ppr PatSynBind (GhcPass idL) (GhcPass idR)
psb
ppr_monobind (AbsBinds { abs_tvs :: forall idL idR. HsBindLR idL idR -> [Id]
abs_tvs = [Id]
tyvars, abs_ev_vars :: forall idL idR. HsBindLR idL idR -> [Id]
abs_ev_vars = [Id]
dictvars
                       , abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
abs_exports = [ABExport (GhcPass idL)]
exports, abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
abs_binds = LHsBinds (GhcPass idL)
val_binds
                       , abs_ev_binds :: forall idL idR. HsBindLR idL idR -> [TcEvBinds]
abs_ev_binds = [TcEvBinds]
ev_binds })
  = (DynFlags -> SDoc) -> SDoc
sdocWithDynFlags ((DynFlags -> SDoc) -> SDoc) -> (DynFlags -> SDoc) -> SDoc
forall a b. (a -> b) -> a -> b
$ \ DynFlags
dflags ->
    if GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_PrintTypecheckerElaboration DynFlags
dflags then
      -- Show extra information (bug number: #10662)
      SDoc -> Int -> SDoc -> SDoc
hang (String -> SDoc
text String
"AbsBinds" SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
brackets ([Id] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [Id]
tyvars)
                                    SDoc -> SDoc -> SDoc
<+> SDoc -> SDoc
brackets ([Id] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [Id]
dictvars))
         Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> SDoc
braces (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ [SDoc] -> SDoc
vcat
      [ String -> SDoc
text String
"Exports:" SDoc -> SDoc -> SDoc
<+>
          SDoc -> SDoc
brackets ([SDoc] -> SDoc
sep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((ABExport (GhcPass idL) -> SDoc)
-> [ABExport (GhcPass idL)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map ABExport (GhcPass idL) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [ABExport (GhcPass idL)]
exports)))
      , String -> SDoc
text String
"Exported types:" SDoc -> SDoc -> SDoc
<+>
          [SDoc] -> SDoc
vcat [BindingSite -> IdP (GhcPass idL) -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind (ABExport (GhcPass idL) -> IdP (GhcPass idL)
forall p. ABExport p -> IdP p
abe_poly ABExport (GhcPass idL)
ex) | ABExport (GhcPass idL)
ex <- [ABExport (GhcPass idL)]
exports]
      , String -> SDoc
text String
"Binds:" SDoc -> SDoc -> SDoc
<+> LHsBinds (GhcPass idL) -> SDoc
forall (idL :: Pass) (idR :: Pass).
(OutputableBndrId idL, OutputableBndrId idR) =>
LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
pprLHsBinds LHsBinds (GhcPass idL)
val_binds
      , String -> SDoc
text String
"Evidence:" SDoc -> SDoc -> SDoc
<+> [TcEvBinds] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [TcEvBinds]
ev_binds ]
    else
      LHsBinds (GhcPass idL) -> SDoc
forall (idL :: Pass) (idR :: Pass).
(OutputableBndrId idL, OutputableBndrId idR) =>
LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
pprLHsBinds LHsBinds (GhcPass idL)
val_binds
ppr_monobind (XHsBindsLR XXHsBindsLR (GhcPass idL) (GhcPass idR)
x) = NoExtCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXHsBindsLR (GhcPass idL) (GhcPass idR)
NoExtCon
x

instance OutputableBndrId p => Outputable (ABExport (GhcPass p)) where
  ppr :: ABExport (GhcPass p) -> SDoc
ppr (ABE { abe_wrap :: forall p. ABExport p -> HsWrapper
abe_wrap = HsWrapper
wrap, abe_poly :: forall p. ABExport p -> IdP p
abe_poly = IdP (GhcPass p)
gbl, abe_mono :: forall p. ABExport p -> IdP p
abe_mono = IdP (GhcPass p)
lcl, abe_prags :: forall p. ABExport p -> TcSpecPrags
abe_prags = TcSpecPrags
prags })
    = [SDoc] -> SDoc
vcat [ IdP (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdP (GhcPass p)
gbl SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"<=" SDoc -> SDoc -> SDoc
<+> IdP (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdP (GhcPass p)
lcl
           , Int -> SDoc -> SDoc
nest Int
2 (TcSpecPrags -> SDoc
pprTcSpecPrags TcSpecPrags
prags)
           , Int -> SDoc -> SDoc
nest Int
2 (String -> SDoc
text String
"wrap:" SDoc -> SDoc -> SDoc
<+> HsWrapper -> SDoc
forall a. Outputable a => a -> SDoc
ppr HsWrapper
wrap)]
  ppr (XABExport XXABExport (GhcPass p)
x) = NoExtCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXABExport (GhcPass p)
NoExtCon
x

instance (OutputableBndrId l, OutputableBndrId r,
         Outputable (XXPatSynBind (GhcPass l) (GhcPass r)))
          => Outputable (PatSynBind (GhcPass l) (GhcPass r)) where
  ppr :: PatSynBind (GhcPass l) (GhcPass r) -> SDoc
ppr (PSB{ psb_id :: forall idL idR. PatSynBind idL idR -> Located (IdP idL)
psb_id = (L SrcSpan
_ IdP (GhcPass l)
psyn), psb_args :: forall idL idR.
PatSynBind idL idR -> HsPatSynDetails (Located (IdP idR))
psb_args = HsPatSynDetails (Located (IdP (GhcPass r)))
details, psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_def = LPat (GhcPass r)
pat,
            psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_dir = HsPatSynDir (GhcPass r)
dir })
      = SDoc
ppr_lhs SDoc -> SDoc -> SDoc
<+> SDoc
ppr_rhs
    where
      ppr_lhs :: SDoc
ppr_lhs = String -> SDoc
text String
"pattern" SDoc -> SDoc -> SDoc
<+> SDoc
ppr_details
      ppr_simple :: SDoc -> SDoc
ppr_simple SDoc
syntax = SDoc
syntax SDoc -> SDoc -> SDoc
<+> Located (Pat (GhcPass r)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (Pat (GhcPass r))
LPat (GhcPass r)
pat

      ppr_details :: SDoc
ppr_details = case HsPatSynDetails (Located (IdP (GhcPass r)))
details of
          InfixCon Located (IdP (GhcPass r))
v1 Located (IdP (GhcPass r))
v2 -> [SDoc] -> SDoc
hsep [Located (IdP (GhcPass r)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (IdP (GhcPass r))
v1, IdP (GhcPass l) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc IdP (GhcPass l)
psyn, Located (IdP (GhcPass r)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (IdP (GhcPass r))
v2]
          PrefixCon [Located (IdP (GhcPass r))]
vs   -> [SDoc] -> SDoc
hsep (IdP (GhcPass l) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IdP (GhcPass l)
psyn SDoc -> [SDoc] -> [SDoc]
forall a. a -> [a] -> [a]
: (Located (IdP (GhcPass r)) -> SDoc)
-> [Located (IdP (GhcPass r))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP (GhcPass r)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [Located (IdP (GhcPass r))]
vs)
          RecCon [RecordPatSynField (Located (IdP (GhcPass r)))]
vs      -> IdP (GhcPass l) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc IdP (GhcPass l)
psyn
                            SDoc -> SDoc -> SDoc
<> SDoc -> SDoc
braces ([SDoc] -> SDoc
sep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((RecordPatSynField (Located (IdP (GhcPass r))) -> SDoc)
-> [RecordPatSynField (Located (IdP (GhcPass r)))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map RecordPatSynField (Located (IdP (GhcPass r))) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [RecordPatSynField (Located (IdP (GhcPass r)))]
vs)))

      ppr_rhs :: SDoc
ppr_rhs = case HsPatSynDir (GhcPass r)
dir of
          HsPatSynDir (GhcPass r)
Unidirectional           -> SDoc -> SDoc
ppr_simple (String -> SDoc
text String
"<-")
          HsPatSynDir (GhcPass r)
ImplicitBidirectional    -> SDoc -> SDoc
ppr_simple SDoc
equals
          ExplicitBidirectional MatchGroup (GhcPass r) (LHsExpr (GhcPass r))
mg -> SDoc -> SDoc
ppr_simple (String -> SDoc
text String
"<-") SDoc -> SDoc -> SDoc
<+> PtrString -> SDoc
ptext (String -> PtrString
sLit String
"where") SDoc -> SDoc -> SDoc
$$
                                      (Int -> SDoc -> SDoc
nest Int
2 (SDoc -> SDoc) -> SDoc -> SDoc
forall a b. (a -> b) -> a -> b
$ MatchGroup (GhcPass r) (LHsExpr (GhcPass r)) -> SDoc
forall (idR :: Pass) body.
(OutputableBndrId idR, Outputable body) =>
MatchGroup (GhcPass idR) body -> SDoc
pprFunBind MatchGroup (GhcPass r) (LHsExpr (GhcPass r))
mg)
  ppr (XPatSynBind XXPatSynBind (GhcPass l) (GhcPass r)
x) = NoExtCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXPatSynBind (GhcPass l) (GhcPass r)
NoExtCon
x

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

{-
************************************************************************
*                                                                      *
                Implicit parameter bindings
*                                                                      *
************************************************************************
-}

-- | Haskell Implicit Parameter Bindings
data HsIPBinds id
  = IPBinds
        (XIPBinds id)
        [LIPBind id]
        -- TcEvBinds       -- Only in typechecker output; binds
        --                 -- uses of the implicit parameters
  | XHsIPBinds (XXHsIPBinds id)

type instance XIPBinds       GhcPs = NoExtField
type instance XIPBinds       GhcRn = NoExtField
type instance XIPBinds       GhcTc = TcEvBinds -- binds uses of the
                                               -- implicit parameters


type instance XXHsIPBinds    (GhcPass p) = NoExtCon

isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
isEmptyIPBindsPR :: HsIPBinds (GhcPass p) -> Bool
isEmptyIPBindsPR (IPBinds XIPBinds (GhcPass p)
_ [LIPBind (GhcPass p)]
is) = [LIPBind (GhcPass p)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIPBind (GhcPass p)]
is
isEmptyIPBindsPR (XHsIPBinds XXHsIPBinds (GhcPass p)
_) = Bool
True

isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool
isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool
isEmptyIPBindsTc (IPBinds XIPBinds GhcTc
ds [LIPBind GhcTc]
is) = [LIPBind GhcTc] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LIPBind GhcTc]
is Bool -> Bool -> Bool
&& TcEvBinds -> Bool
isEmptyTcEvBinds XIPBinds GhcTc
TcEvBinds
ds
isEmptyIPBindsTc (XHsIPBinds XXHsIPBinds GhcTc
_) = Bool
True

-- | Located Implicit Parameter Binding
type LIPBind id = Located (IPBind id)
-- ^ May have 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSemi' when in a
--   list

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

-- | Implicit parameter bindings.
--
-- 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.
--
-- - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnEqual'

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

type instance XCIPBind    (GhcPass p) = NoExtField
type instance XXIPBind    (GhcPass p) = NoExtCon

instance OutputableBndrId p
       => Outputable (HsIPBinds (GhcPass p)) where
  ppr :: HsIPBinds (GhcPass p) -> SDoc
ppr (IPBinds XIPBinds (GhcPass p)
ds [LIPBind (GhcPass p)]
bs) = ([SDoc] -> SDoc) -> [SDoc] -> SDoc
pprDeeperList [SDoc] -> SDoc
vcat ((LIPBind (GhcPass p) -> SDoc) -> [LIPBind (GhcPass p)] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map LIPBind (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr [LIPBind (GhcPass p)]
bs)
                        SDoc -> SDoc -> SDoc
$$ SDoc -> SDoc
whenPprDebug (XIPBinds (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr XIPBinds (GhcPass p)
ds)
  ppr (XHsIPBinds XXHsIPBinds (GhcPass p)
x) = NoExtCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXHsIPBinds (GhcPass p)
NoExtCon
x

instance OutputableBndrId p => Outputable (IPBind (GhcPass p)) where
  ppr :: IPBind (GhcPass p) -> SDoc
ppr (IPBind XCIPBind (GhcPass p)
_ Either (Located HsIPName) (IdP (GhcPass p))
lr LHsExpr (GhcPass p)
rhs) = SDoc
name SDoc -> SDoc -> SDoc
<+> SDoc
equals SDoc -> SDoc -> SDoc
<+> HsExpr (GhcPass p) -> SDoc
forall (p :: Pass).
OutputableBndrId p =>
HsExpr (GhcPass p) -> SDoc
pprExpr (LHsExpr (GhcPass p) -> SrcSpanLess (LHsExpr (GhcPass p))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsExpr (GhcPass p)
rhs)
    where name :: SDoc
name = case Either (Located HsIPName) (IdP (GhcPass p))
lr of
                   Left (L SrcSpan
_ HsIPName
ip) -> BindingSite -> HsIPName -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind HsIPName
ip
                   Right     IdP (GhcPass p)
id  -> BindingSite -> IdP (GhcPass p) -> SDoc
forall a. OutputableBndr a => BindingSite -> a -> SDoc
pprBndr BindingSite
LetBind IdP (GhcPass p)
id
  ppr (XIPBind XXIPBind (GhcPass p)
x) = NoExtCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXIPBind (GhcPass p)
NoExtCon
x

{-
************************************************************************
*                                                                      *
\subsection{@Sig@: type signatures and value-modifying user pragmas}
*                                                                      *
************************************************************************

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

-- | Located Signature
type LSig pass = Located (Sig pass)

-- | Signatures and pragmas
data Sig pass
  =   -- | An ordinary type signature
      --
      -- > f :: Num a => a -> a
      --
      -- After renaming, this list of Names contains the named
      -- wildcards brought into scope by this signature. For a signature
      -- @_ -> _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.
      --
      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDcolon',
      --          'ApiAnnotation.AnnComma'

      -- For details on above see note [Api annotations] in ApiAnnotation
    TypeSig
       (XTypeSig pass)
       [Located (IdP pass)]  -- LHS of the signature; e.g.  f,g,h :: blah
       (LHsSigWcType pass)   -- RHS of the signature; can have wildcards

      -- | A pattern synonym type signature
      --
      -- > pattern Single :: () => (Show a) => a -> [a]
      --
      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnPattern',
      --           'ApiAnnotation.AnnDcolon','ApiAnnotation.AnnForall'
      --           'ApiAnnotation.AnnDot','ApiAnnotation.AnnDarrow'

      -- For details on above see note [Api annotations] in ApiAnnotation
  | PatSynSig (XPatSynSig pass) [Located (IdP pass)] (LHsSigType pass)
      -- P :: forall a b. Req => Prov => ty

      -- | A signature for a class method
      --   False: ordinary class-method signature
      --   True:  generic-default class method signature
      -- e.g.   class C a where
      --          op :: a -> a                   -- Ordinary
      --          default op :: Eq a => a -> a   -- Generic default
      -- No wildcards allowed here
      --
      --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnDefault',
      --           'ApiAnnotation.AnnDcolon'
  | ClassOpSig (XClassOpSig pass) Bool [Located (IdP pass)] (LHsSigType pass)

        -- | A type signature in generated code, notably the code
        -- generated for record selectors.  We simply record
        -- the desired Id itself, replete with its name, type
        -- and IdDetails.  Otherwise it's just like a type
        -- signature: there should be an accompanying binding
  | IdSig (XIdSig pass) Id

        -- | An ordinary fixity declaration
        --
        -- >     infixl 8 ***
        --
        --
        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnInfix',
        --           'ApiAnnotation.AnnVal'

        -- For details on above see note [Api annotations] in ApiAnnotation
  | FixSig (XFixSig pass) (FixitySig pass)

        -- | An inline pragma
        --
        -- > {#- INLINE f #-}
        --
        --  - 'ApiAnnotation.AnnKeywordId' :
        --       'ApiAnnotation.AnnOpen' @'{-\# INLINE'@ and @'['@,
        --       'ApiAnnotation.AnnClose','ApiAnnotation.AnnOpen',
        --       'ApiAnnotation.AnnVal','ApiAnnotation.AnnTilde',
        --       'ApiAnnotation.AnnClose'

        -- For details on above see note [Api annotations] in ApiAnnotation
  | InlineSig   (XInlineSig pass)
                (Located (IdP pass)) -- Function name
                InlinePragma         -- Never defaultInlinePragma

        -- | A specialisation pragma
        --
        -- > {-# SPECIALISE f :: Int -> Int #-}
        --
        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
        --      'ApiAnnotation.AnnOpen' @'{-\# SPECIALISE'@ and @'['@,
        --      'ApiAnnotation.AnnTilde',
        --      'ApiAnnotation.AnnVal',
        --      'ApiAnnotation.AnnClose' @']'@ and @'\#-}'@,
        --      'ApiAnnotation.AnnDcolon'

        -- For details on above see note [Api annotations] in ApiAnnotation
  | SpecSig     (XSpecSig pass)
                (Located (IdP pass)) -- Specialise a function or datatype  ...
                [LHsSigType pass]  -- ... to these types
                InlinePragma       -- The pragma on SPECIALISE_INLINE form.
                                   -- If it's just defaultInlinePragma, then we said
                                   --    SPECIALISE, not SPECIALISE_INLINE

        -- | A specialisation pragma for instance declarations only
        --
        -- > {-# SPECIALISE instance Eq [Int] #-}
        --
        -- (Class tys); should be a specialisation of the
        -- current instance declaration
        --
        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
        --      'ApiAnnotation.AnnInstance','ApiAnnotation.AnnClose'

        -- For details on above see note [Api annotations] in ApiAnnotation
  | SpecInstSig (XSpecInstSig pass) SourceText (LHsSigType pass)
                  -- Note [Pragma source text] in BasicTypes

        -- | A minimal complete definition pragma
        --
        -- > {-# MINIMAL a | (b, c | (d | e)) #-}
        --
        --  - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen',
        --      'ApiAnnotation.AnnVbar','ApiAnnotation.AnnComma',
        --      'ApiAnnotation.AnnClose'

        -- For details on above see note [Api annotations] in ApiAnnotation
  | MinimalSig (XMinimalSig pass)
               SourceText (LBooleanFormula (Located (IdP pass)))
               -- Note [Pragma source text] in BasicTypes

        -- | A "set cost centre" pragma for declarations
        --
        -- > {-# SCC funName #-}
        --
        -- or
        --
        -- > {-# SCC funName "cost_centre_name" #-}

  | SCCFunSig  (XSCCFunSig pass)
               SourceText      -- Note [Pragma source text] in BasicTypes
               (Located (IdP pass))  -- Function name
               (Maybe (Located StringLiteral))
       -- | A complete match pragma
       --
       -- > {-# COMPLETE C, D [:: T] #-}
       --
       -- Used to inform the pattern match checker about additional
       -- complete matchings which, for example, arise from pattern
       -- synonym definitions.
  | CompleteMatchSig (XCompleteMatchSig pass)
                     SourceText
                     (Located [Located (IdP pass)])
                     (Maybe (Located (IdP pass)))
  | XSig (XXSig pass)

type instance XTypeSig          (GhcPass p) = NoExtField
type instance XPatSynSig        (GhcPass p) = NoExtField
type instance XClassOpSig       (GhcPass p) = NoExtField
type instance XIdSig            (GhcPass p) = NoExtField
type instance XFixSig           (GhcPass p) = NoExtField
type instance XInlineSig        (GhcPass p) = NoExtField
type instance XSpecSig          (GhcPass p) = NoExtField
type instance XSpecInstSig      (GhcPass p) = NoExtField
type instance XMinimalSig       (GhcPass p) = NoExtField
type instance XSCCFunSig        (GhcPass p) = NoExtField
type instance XCompleteMatchSig (GhcPass p) = NoExtField
type instance XXSig             (GhcPass p) = NoExtCon

-- | Located Fixity Signature
type LFixitySig pass = Located (FixitySig pass)

-- | Fixity Signature
data FixitySig pass = FixitySig (XFixitySig pass) [Located (IdP pass)] Fixity
                    | XFixitySig (XXFixitySig pass)

type instance XFixitySig  (GhcPass p) = NoExtField
type instance XXFixitySig (GhcPass p) = NoExtCon

-- | Type checker Specialisation Pragmas
--
-- 'TcSpecPrags' conveys @SPECIALISE@ pragmas from the type checker to the desugarer
data TcSpecPrags
  = IsDefaultMethod     -- ^ Super-specialised: a default method should
                        -- be macro-expanded at every call site
  | SpecPrags [LTcSpecPrag]
  deriving Typeable TcSpecPrags
DataType
Constr
Typeable TcSpecPrags
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TcSpecPrags -> c TcSpecPrags)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TcSpecPrags)
-> (TcSpecPrags -> Constr)
-> (TcSpecPrags -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TcSpecPrags))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TcSpecPrags))
-> ((forall b. Data b => b -> b) -> TcSpecPrags -> TcSpecPrags)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TcSpecPrags -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TcSpecPrags -> r)
-> (forall u. (forall d. Data d => d -> u) -> TcSpecPrags -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TcSpecPrags -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags)
-> Data TcSpecPrags
TcSpecPrags -> DataType
TcSpecPrags -> Constr
(forall b. Data b => b -> b) -> TcSpecPrags -> TcSpecPrags
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcSpecPrags -> c TcSpecPrags
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcSpecPrags
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TcSpecPrags -> u
forall u. (forall d. Data d => d -> u) -> TcSpecPrags -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrags -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrags -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcSpecPrags
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcSpecPrags -> c TcSpecPrags
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TcSpecPrags)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TcSpecPrags)
$cSpecPrags :: Constr
$cIsDefaultMethod :: Constr
$tTcSpecPrags :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags
gmapMp :: (forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags
gmapM :: (forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TcSpecPrags -> m TcSpecPrags
gmapQi :: Int -> (forall d. Data d => d -> u) -> TcSpecPrags -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TcSpecPrags -> u
gmapQ :: (forall d. Data d => d -> u) -> TcSpecPrags -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TcSpecPrags -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrags -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrags -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrags -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrags -> r
gmapT :: (forall b. Data b => b -> b) -> TcSpecPrags -> TcSpecPrags
$cgmapT :: (forall b. Data b => b -> b) -> TcSpecPrags -> TcSpecPrags
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TcSpecPrags)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c TcSpecPrags)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TcSpecPrags)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TcSpecPrags)
dataTypeOf :: TcSpecPrags -> DataType
$cdataTypeOf :: TcSpecPrags -> DataType
toConstr :: TcSpecPrags -> Constr
$ctoConstr :: TcSpecPrags -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcSpecPrags
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcSpecPrags
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcSpecPrags -> c TcSpecPrags
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcSpecPrags -> c TcSpecPrags
$cp1Data :: Typeable TcSpecPrags
Data

-- | Located Type checker Specification Pragmas
type LTcSpecPrag = Located TcSpecPrag

-- | Type checker Specification Pragma
data TcSpecPrag
  = SpecPrag
        Id
        HsWrapper
        InlinePragma
  -- ^ The Id to be specialised, a wrapper that specialises the
  -- polymorphic function, and inlining spec for the specialised function
  deriving Typeable TcSpecPrag
DataType
Constr
Typeable TcSpecPrag
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> TcSpecPrag -> c TcSpecPrag)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c TcSpecPrag)
-> (TcSpecPrag -> Constr)
-> (TcSpecPrag -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c TcSpecPrag))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c TcSpecPrag))
-> ((forall b. Data b => b -> b) -> TcSpecPrag -> TcSpecPrag)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> TcSpecPrag -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> TcSpecPrag -> r)
-> (forall u. (forall d. Data d => d -> u) -> TcSpecPrag -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> TcSpecPrag -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag)
-> Data TcSpecPrag
TcSpecPrag -> DataType
TcSpecPrag -> Constr
(forall b. Data b => b -> b) -> TcSpecPrag -> TcSpecPrag
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcSpecPrag -> c TcSpecPrag
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcSpecPrag
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> TcSpecPrag -> u
forall u. (forall d. Data d => d -> u) -> TcSpecPrag -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrag -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrag -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcSpecPrag
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcSpecPrag -> c TcSpecPrag
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TcSpecPrag)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TcSpecPrag)
$cSpecPrag :: Constr
$tTcSpecPrag :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag
gmapMp :: (forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag
gmapM :: (forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> TcSpecPrag -> m TcSpecPrag
gmapQi :: Int -> (forall d. Data d => d -> u) -> TcSpecPrag -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> TcSpecPrag -> u
gmapQ :: (forall d. Data d => d -> u) -> TcSpecPrag -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> TcSpecPrag -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrag -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrag -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrag -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> TcSpecPrag -> r
gmapT :: (forall b. Data b => b -> b) -> TcSpecPrag -> TcSpecPrag
$cgmapT :: (forall b. Data b => b -> b) -> TcSpecPrag -> TcSpecPrag
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TcSpecPrag)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c TcSpecPrag)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c TcSpecPrag)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c TcSpecPrag)
dataTypeOf :: TcSpecPrag -> DataType
$cdataTypeOf :: TcSpecPrag -> DataType
toConstr :: TcSpecPrag -> Constr
$ctoConstr :: TcSpecPrag -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcSpecPrag
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c TcSpecPrag
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcSpecPrag -> c TcSpecPrag
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> TcSpecPrag -> c TcSpecPrag
$cp1Data :: Typeable TcSpecPrag
Data

noSpecPrags :: TcSpecPrags
noSpecPrags :: TcSpecPrags
noSpecPrags = [LTcSpecPrag] -> TcSpecPrags
SpecPrags []

hasSpecPrags :: TcSpecPrags -> Bool
hasSpecPrags :: TcSpecPrags -> Bool
hasSpecPrags (SpecPrags [LTcSpecPrag]
ps) = Bool -> Bool
not ([LTcSpecPrag] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LTcSpecPrag]
ps)
hasSpecPrags TcSpecPrags
IsDefaultMethod = Bool
False

isDefaultMethod :: TcSpecPrags -> Bool
isDefaultMethod :: TcSpecPrags -> Bool
isDefaultMethod TcSpecPrags
IsDefaultMethod = Bool
True
isDefaultMethod (SpecPrags {})  = Bool
False


isFixityLSig :: LSig name -> Bool
isFixityLSig :: LSig name -> Bool
isFixityLSig (L SrcSpan
_ (FixSig {})) = Bool
True
isFixityLSig LSig name
_                 = Bool
False

isTypeLSig :: LSig name -> Bool  -- Type signatures
isTypeLSig :: LSig name -> Bool
isTypeLSig (L SrcSpan
_(TypeSig {}))    = Bool
True
isTypeLSig (L SrcSpan
_(ClassOpSig {})) = Bool
True
isTypeLSig (L SrcSpan
_(IdSig {}))      = Bool
True
isTypeLSig LSig name
_                    = Bool
False

isSpecLSig :: LSig name -> Bool
isSpecLSig :: LSig name -> Bool
isSpecLSig (L SrcSpan
_(SpecSig {})) = Bool
True
isSpecLSig LSig name
_                 = Bool
False

isSpecInstLSig :: LSig name -> Bool
isSpecInstLSig :: LSig name -> Bool
isSpecInstLSig (L SrcSpan
_ (SpecInstSig {})) = Bool
True
isSpecInstLSig LSig name
_                      = Bool
False

isPragLSig :: LSig name -> Bool
-- Identifies pragmas
isPragLSig :: LSig name -> Bool
isPragLSig (L SrcSpan
_ (SpecSig {}))   = Bool
True
isPragLSig (L SrcSpan
_ (InlineSig {})) = Bool
True
isPragLSig (L SrcSpan
_ (SCCFunSig {})) = Bool
True
isPragLSig (L SrcSpan
_ (CompleteMatchSig {})) = Bool
True
isPragLSig LSig name
_                    = Bool
False

isInlineLSig :: LSig name -> Bool
-- Identifies inline pragmas
isInlineLSig :: LSig name -> Bool
isInlineLSig (L SrcSpan
_ (InlineSig {})) = Bool
True
isInlineLSig LSig name
_                    = Bool
False

isMinimalLSig :: LSig name -> Bool
isMinimalLSig :: LSig name -> Bool
isMinimalLSig (L SrcSpan
_ (MinimalSig {})) = Bool
True
isMinimalLSig LSig name
_                     = Bool
False

isSCCFunSig :: LSig name -> Bool
isSCCFunSig :: LSig name -> Bool
isSCCFunSig (L SrcSpan
_ (SCCFunSig {})) = Bool
True
isSCCFunSig LSig name
_                    = Bool
False

isCompleteMatchSig :: LSig name -> Bool
isCompleteMatchSig :: LSig name -> Bool
isCompleteMatchSig (L SrcSpan
_ (CompleteMatchSig {} )) = Bool
True
isCompleteMatchSig LSig name
_                            = Bool
False

hsSigDoc :: Sig name -> SDoc
hsSigDoc :: Sig name -> SDoc
hsSigDoc (TypeSig {})           = String -> SDoc
text String
"type signature"
hsSigDoc (PatSynSig {})         = String -> SDoc
text String
"pattern synonym signature"
hsSigDoc (ClassOpSig XClassOpSig name
_ Bool
is_deflt [Located (IdP name)]
_ LHsSigType name
_)
 | Bool
is_deflt                     = String -> SDoc
text String
"default type signature"
 | Bool
otherwise                    = String -> SDoc
text String
"class method signature"
hsSigDoc (IdSig {})             = String -> SDoc
text String
"id signature"
hsSigDoc (SpecSig XSpecSig name
_ Located (IdP name)
_ [LHsSigType name]
_ InlinePragma
inl)
                                = InlinePragma -> SDoc
forall a. Outputable a => a -> SDoc
ppr InlinePragma
inl SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"pragma"
hsSigDoc (InlineSig XInlineSig name
_ Located (IdP name)
_ InlinePragma
prag)   = InlineSpec -> SDoc
forall a. Outputable a => a -> SDoc
ppr (InlinePragma -> InlineSpec
inlinePragmaSpec InlinePragma
prag) SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"pragma"
hsSigDoc (SpecInstSig XSpecInstSig name
_ SourceText
src LHsSigType name
_)
                                = SourceText -> SDoc -> SDoc
pprWithSourceText SourceText
src SDoc
empty SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"instance pragma"
hsSigDoc (FixSig {})            = String -> SDoc
text String
"fixity declaration"
hsSigDoc (MinimalSig {})        = String -> SDoc
text String
"MINIMAL pragma"
hsSigDoc (SCCFunSig {})         = String -> SDoc
text String
"SCC pragma"
hsSigDoc (CompleteMatchSig {})  = String -> SDoc
text String
"COMPLETE pragma"
hsSigDoc (XSig {})              = String -> SDoc
text String
"XSIG TTG extension"

{-
Check if signatures overlap; this is used when checking for duplicate
signatures. Since some of the signatures contain a list of names, testing for
equality is not enough -- we have to check if they overlap.
-}

instance OutputableBndrId p => Outputable (Sig (GhcPass p)) where
    ppr :: Sig (GhcPass p) -> SDoc
ppr Sig (GhcPass p)
sig = Sig (GhcPass p) -> SDoc
forall (p :: Pass). OutputableBndrId p => Sig (GhcPass p) -> SDoc
ppr_sig Sig (GhcPass p)
sig

ppr_sig :: (OutputableBndrId p) => Sig (GhcPass p) -> SDoc
ppr_sig :: Sig (GhcPass p) -> SDoc
ppr_sig (TypeSig XTypeSig (GhcPass p)
_ [Located (IdP (GhcPass p))]
vars LHsSigWcType (GhcPass p)
ty)  = [IdP (GhcPass p)] -> SDoc -> SDoc
forall id. OutputableBndr id => [id] -> SDoc -> SDoc
pprVarSig ((Located (IdP (GhcPass p)) -> IdP (GhcPass p))
-> [Located (IdP (GhcPass p))] -> [IdP (GhcPass p)]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP (GhcPass p)) -> IdP (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP (GhcPass p))]
vars) (LHsSigWcType (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigWcType (GhcPass p)
ty)
ppr_sig (ClassOpSig XClassOpSig (GhcPass p)
_ Bool
is_deflt [Located (IdP (GhcPass p))]
vars LHsSigType (GhcPass p)
ty)
  | Bool
is_deflt                 = String -> SDoc
text String
"default" SDoc -> SDoc -> SDoc
<+> [IdP (GhcPass p)] -> SDoc -> SDoc
forall id. OutputableBndr id => [id] -> SDoc -> SDoc
pprVarSig ((Located (IdP (GhcPass p)) -> IdP (GhcPass p))
-> [Located (IdP (GhcPass p))] -> [IdP (GhcPass p)]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP (GhcPass p)) -> IdP (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP (GhcPass p))]
vars) (LHsSigType (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType (GhcPass p)
ty)
  | Bool
otherwise                = [IdP (GhcPass p)] -> SDoc -> SDoc
forall id. OutputableBndr id => [id] -> SDoc -> SDoc
pprVarSig ((Located (IdP (GhcPass p)) -> IdP (GhcPass p))
-> [Located (IdP (GhcPass p))] -> [IdP (GhcPass p)]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP (GhcPass p)) -> IdP (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP (GhcPass p))]
vars) (LHsSigType (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType (GhcPass p)
ty)
ppr_sig (IdSig XIdSig (GhcPass p)
_ Id
id)         = [Id] -> SDoc -> SDoc
forall id. OutputableBndr id => [id] -> SDoc -> SDoc
pprVarSig [Id
id] (Type -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Id -> Type
varType Id
id))
ppr_sig (FixSig XFixSig (GhcPass p)
_ FixitySig (GhcPass p)
fix_sig)   = FixitySig (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr FixitySig (GhcPass p)
fix_sig
ppr_sig (SpecSig XSpecSig (GhcPass p)
_ Located (IdP (GhcPass p))
var [LHsSigType (GhcPass p)]
ty inl :: InlinePragma
inl@(InlinePragma { inl_inline :: InlinePragma -> InlineSpec
inl_inline = InlineSpec
spec }))
  = SourceText -> String -> SDoc -> SDoc
pragSrcBrackets (InlinePragma -> SourceText
inl_src InlinePragma
inl) String
pragmaSrc (IdP (GhcPass p) -> SDoc -> InlinePragma -> SDoc
forall id. OutputableBndr id => id -> SDoc -> InlinePragma -> SDoc
pprSpec (Located (IdP (GhcPass p))
-> SrcSpanLess (Located (IdP (GhcPass p)))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP (GhcPass p))
var)
                                             ([LHsSigType (GhcPass p)] -> SDoc
forall a. Outputable a => [a] -> SDoc
interpp'SP [LHsSigType (GhcPass p)]
ty) InlinePragma
inl)
    where
      pragmaSrc :: String
pragmaSrc = case InlineSpec
spec of
        InlineSpec
NoUserInline -> String
"{-# SPECIALISE"
        InlineSpec
_            -> String
"{-# SPECIALISE_INLINE"
ppr_sig (InlineSig XInlineSig (GhcPass p)
_ Located (IdP (GhcPass p))
var InlinePragma
inl)
  = SourceText -> String -> SDoc -> SDoc
pragSrcBrackets (InlinePragma -> SourceText
inl_src InlinePragma
inl) String
"{-# INLINE"  (InlinePragma -> SDoc
pprInline InlinePragma
inl
                                   SDoc -> SDoc -> SDoc
<+> IdP (GhcPass p) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc (Located (IdP (GhcPass p))
-> SrcSpanLess (Located (IdP (GhcPass p)))
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located (IdP (GhcPass p))
var))
ppr_sig (SpecInstSig XSpecInstSig (GhcPass p)
_ SourceText
src LHsSigType (GhcPass p)
ty)
  = SourceText -> String -> SDoc -> SDoc
pragSrcBrackets SourceText
src String
"{-# pragma" (String -> SDoc
text String
"instance" SDoc -> SDoc -> SDoc
<+> LHsSigType (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType (GhcPass p)
ty)
ppr_sig (MinimalSig XMinimalSig (GhcPass p)
_ SourceText
src LBooleanFormula (Located (IdP (GhcPass p)))
bf)
  = SourceText -> String -> SDoc -> SDoc
pragSrcBrackets SourceText
src String
"{-# MINIMAL" (LBooleanFormula (Located (IdP (GhcPass p))) -> SDoc
forall name.
OutputableBndr name =>
LBooleanFormula (Located name) -> SDoc
pprMinimalSig LBooleanFormula (Located (IdP (GhcPass p)))
bf)
ppr_sig (PatSynSig XPatSynSig (GhcPass p)
_ [Located (IdP (GhcPass p))]
names LHsSigType (GhcPass p)
sig_ty)
  = String -> SDoc
text String
"pattern" SDoc -> SDoc -> SDoc
<+> [IdP (GhcPass p)] -> SDoc -> SDoc
forall id. OutputableBndr id => [id] -> SDoc -> SDoc
pprVarSig ((Located (IdP (GhcPass p)) -> IdP (GhcPass p))
-> [Located (IdP (GhcPass p))] -> [IdP (GhcPass p)]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP (GhcPass p)) -> IdP (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc [Located (IdP (GhcPass p))]
names) (LHsSigType (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr LHsSigType (GhcPass p)
sig_ty)
ppr_sig (SCCFunSig XSCCFunSig (GhcPass p)
_ SourceText
src Located (IdP (GhcPass p))
fn Maybe (Located StringLiteral)
mlabel)
  = SourceText -> String -> SDoc -> SDoc
pragSrcBrackets SourceText
src String
"{-# SCC" (Located (IdP (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr Located (IdP (GhcPass p))
fn SDoc -> SDoc -> SDoc
<+> SDoc
-> (Located StringLiteral -> SDoc)
-> Maybe (Located StringLiteral)
-> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
empty Located StringLiteral -> SDoc
forall a. Outputable a => a -> SDoc
ppr Maybe (Located StringLiteral)
mlabel )
ppr_sig (CompleteMatchSig XCompleteMatchSig (GhcPass p)
_ SourceText
src Located [Located (IdP (GhcPass p))]
cs Maybe (Located (IdP (GhcPass p)))
mty)
  = SourceText -> String -> SDoc -> SDoc
pragSrcBrackets SourceText
src String
"{-# COMPLETE"
      (([SDoc] -> SDoc
hsep (SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((Located (IdP (GhcPass p)) -> SDoc)
-> [Located (IdP (GhcPass p))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map Located (IdP (GhcPass p)) -> SDoc
forall a. Outputable a => a -> SDoc
ppr (Located [Located (IdP (GhcPass p))]
-> SrcSpanLess (Located [Located (IdP (GhcPass p))])
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc Located [Located (IdP (GhcPass p))]
cs))))
        SDoc -> SDoc -> SDoc
<+> SDoc
opt_sig)
  where
    opt_sig :: SDoc
opt_sig = SDoc
-> (Located (IdP (GhcPass p)) -> SDoc)
-> Maybe (Located (IdP (GhcPass p)))
-> SDoc
forall b a. b -> (a -> b) -> Maybe a -> b
maybe SDoc
empty ((\IdP (GhcPass p)
t -> SDoc
dcolon SDoc -> SDoc -> SDoc
<+> IdP (GhcPass p) -> SDoc
forall a. Outputable a => a -> SDoc
ppr IdP (GhcPass p)
t) (IdP (GhcPass p) -> SDoc)
-> (Located (IdP (GhcPass p)) -> IdP (GhcPass p))
-> Located (IdP (GhcPass p))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (IdP (GhcPass p)) -> IdP (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) Maybe (Located (IdP (GhcPass p)))
mty
ppr_sig (XSig XXSig (GhcPass p)
x) = NoExtCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXSig (GhcPass p)
NoExtCon
x

instance OutputableBndrId p
       => Outputable (FixitySig (GhcPass p)) where
  ppr :: FixitySig (GhcPass p) -> SDoc
ppr (FixitySig XFixitySig (GhcPass p)
_ [Located (IdP (GhcPass p))]
names Fixity
fixity) = [SDoc] -> SDoc
sep [Fixity -> SDoc
forall a. Outputable a => a -> SDoc
ppr Fixity
fixity, SDoc
pprops]
    where
      pprops :: SDoc
pprops = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((Located (IdP (GhcPass p)) -> SDoc)
-> [Located (IdP (GhcPass p))] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (IdP (GhcPass p) -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprInfixOcc (IdP (GhcPass p) -> SDoc)
-> (Located (IdP (GhcPass p)) -> IdP (GhcPass p))
-> Located (IdP (GhcPass p))
-> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (IdP (GhcPass p)) -> IdP (GhcPass p)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [Located (IdP (GhcPass p))]
names)
  ppr (XFixitySig XXFixitySig (GhcPass p)
x) = NoExtCon -> SDoc
forall a. Outputable a => a -> SDoc
ppr XXFixitySig (GhcPass p)
NoExtCon
x

pragBrackets :: SDoc -> SDoc
pragBrackets :: SDoc -> SDoc
pragBrackets SDoc
doc = String -> SDoc
text String
"{-#" SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"#-}"

-- | Using SourceText in case the pragma was spelled differently or used mixed
-- case
pragSrcBrackets :: SourceText -> String -> SDoc -> SDoc
pragSrcBrackets :: SourceText -> String -> SDoc -> SDoc
pragSrcBrackets (SourceText String
src) String
_   SDoc
doc = String -> SDoc
text String
src SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"#-}"
pragSrcBrackets SourceText
NoSourceText     String
alt SDoc
doc = String -> SDoc
text String
alt SDoc -> SDoc -> SDoc
<+> SDoc
doc SDoc -> SDoc -> SDoc
<+> String -> SDoc
text String
"#-}"

pprVarSig :: (OutputableBndr id) => [id] -> SDoc -> SDoc
pprVarSig :: [id] -> SDoc -> SDoc
pprVarSig [id]
vars SDoc
pp_ty = [SDoc] -> SDoc
sep [SDoc
pprvars SDoc -> SDoc -> SDoc
<+> SDoc
dcolon, Int -> SDoc -> SDoc
nest Int
2 SDoc
pp_ty]
  where
    pprvars :: SDoc
pprvars = [SDoc] -> SDoc
hsep ([SDoc] -> SDoc) -> [SDoc] -> SDoc
forall a b. (a -> b) -> a -> b
$ SDoc -> [SDoc] -> [SDoc]
punctuate SDoc
comma ((id -> SDoc) -> [id] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map id -> SDoc
forall a. OutputableBndr a => a -> SDoc
pprPrefixOcc [id]
vars)

pprSpec :: (OutputableBndr id) => id -> SDoc -> InlinePragma -> SDoc
pprSpec :: id -> SDoc -> InlinePragma -> SDoc
pprSpec id
var SDoc
pp_ty InlinePragma
inl = SDoc
pp_inl SDoc -> SDoc -> SDoc
<+> [id] -> SDoc -> SDoc
forall id. OutputableBndr id => [id] -> SDoc -> SDoc
pprVarSig [id
var] SDoc
pp_ty
  where
    pp_inl :: SDoc
pp_inl | InlinePragma -> Bool
isDefaultInlinePragma InlinePragma
inl = SDoc
empty
           | Bool
otherwise = InlinePragma -> SDoc
pprInline InlinePragma
inl

pprTcSpecPrags :: TcSpecPrags -> SDoc
pprTcSpecPrags :: TcSpecPrags -> SDoc
pprTcSpecPrags TcSpecPrags
IsDefaultMethod = String -> SDoc
text String
"<default method>"
pprTcSpecPrags (SpecPrags [LTcSpecPrag]
ps)  = [SDoc] -> SDoc
vcat ((LTcSpecPrag -> SDoc) -> [LTcSpecPrag] -> [SDoc]
forall a b. (a -> b) -> [a] -> [b]
map (TcSpecPrag -> SDoc
forall a. Outputable a => a -> SDoc
ppr (TcSpecPrag -> SDoc)
-> (LTcSpecPrag -> TcSpecPrag) -> LTcSpecPrag -> SDoc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LTcSpecPrag -> TcSpecPrag
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc) [LTcSpecPrag]
ps)

instance Outputable TcSpecPrag where
  ppr :: TcSpecPrag -> SDoc
ppr (SpecPrag Id
var HsWrapper
_ InlinePragma
inl)
    = String -> SDoc
text String
"SPECIALIZE" SDoc -> SDoc -> SDoc
<+> Id -> SDoc -> InlinePragma -> SDoc
forall id. OutputableBndr id => id -> SDoc -> InlinePragma -> SDoc
pprSpec Id
var (String -> SDoc
text String
"<type>") InlinePragma
inl

pprMinimalSig :: (OutputableBndr name)
              => LBooleanFormula (Located name) -> SDoc
pprMinimalSig :: LBooleanFormula (Located name) -> SDoc
pprMinimalSig (L SrcSpan
_ BooleanFormula (Located name)
bf) = BooleanFormula name -> SDoc
forall a. Outputable a => a -> SDoc
ppr ((Located name -> name)
-> BooleanFormula (Located name) -> BooleanFormula name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Located name -> name
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc BooleanFormula (Located name)
bf)

{-
************************************************************************
*                                                                      *
\subsection[PatSynBind]{A pattern synonym definition}
*                                                                      *
************************************************************************
-}

-- | Haskell Pattern Synonym Details
type HsPatSynDetails arg = HsConDetails arg [RecordPatSynField arg]

-- See Note [Record PatSyn Fields]
-- | Record Pattern Synonym Field
data RecordPatSynField a
  = RecordPatSynField {
      RecordPatSynField a -> a
recordPatSynSelectorId :: a  -- Selector name visible in rest of the file
      , RecordPatSynField a -> a
recordPatSynPatVar :: a
      -- Filled in by renamer, the name used internally
      -- by the pattern
      } deriving (Typeable (RecordPatSynField a)
DataType
Constr
Typeable (RecordPatSynField a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> RecordPatSynField a
    -> c (RecordPatSynField a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (RecordPatSynField a))
-> (RecordPatSynField a -> Constr)
-> (RecordPatSynField a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (RecordPatSynField a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (RecordPatSynField a)))
-> ((forall b. Data b => b -> b)
    -> RecordPatSynField a -> RecordPatSynField a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> RecordPatSynField a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> RecordPatSynField a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> RecordPatSynField a -> m (RecordPatSynField a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecordPatSynField a -> m (RecordPatSynField a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> RecordPatSynField a -> m (RecordPatSynField a))
-> Data (RecordPatSynField a)
RecordPatSynField a -> DataType
RecordPatSynField a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (RecordPatSynField a))
(forall b. Data b => b -> b)
-> RecordPatSynField a -> RecordPatSynField a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecordPatSynField a
-> c (RecordPatSynField a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RecordPatSynField a)
forall a. Data a => Typeable (RecordPatSynField a)
forall a. Data a => RecordPatSynField a -> DataType
forall a. Data a => RecordPatSynField a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b)
-> RecordPatSynField a -> RecordPatSynField a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> RecordPatSynField a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> RecordPatSynField a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RecordPatSynField a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecordPatSynField a
-> c (RecordPatSynField a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RecordPatSynField a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RecordPatSynField a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> RecordPatSynField a -> u
forall u.
(forall d. Data d => d -> u) -> RecordPatSynField a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RecordPatSynField a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecordPatSynField a
-> c (RecordPatSynField a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (RecordPatSynField a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RecordPatSynField a))
$cRecordPatSynField :: Constr
$tRecordPatSynField :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
gmapMp :: (forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
gmapM :: (forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> RecordPatSynField a -> m (RecordPatSynField a)
gmapQi :: Int -> (forall d. Data d => d -> u) -> RecordPatSynField a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> RecordPatSynField a -> u
gmapQ :: (forall d. Data d => d -> u) -> RecordPatSynField a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> RecordPatSynField a -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RecordPatSynField a -> r
gmapT :: (forall b. Data b => b -> b)
-> RecordPatSynField a -> RecordPatSynField a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b)
-> RecordPatSynField a -> RecordPatSynField a
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RecordPatSynField a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (RecordPatSynField a))
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c (RecordPatSynField a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (RecordPatSynField a))
dataTypeOf :: RecordPatSynField a -> DataType
$cdataTypeOf :: forall a. Data a => RecordPatSynField a -> DataType
toConstr :: RecordPatSynField a -> Constr
$ctoConstr :: forall a. Data a => RecordPatSynField a -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RecordPatSynField a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (RecordPatSynField a)
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecordPatSynField a
-> c (RecordPatSynField a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> RecordPatSynField a
-> c (RecordPatSynField a)
$cp1Data :: forall a. Data a => Typeable (RecordPatSynField a)
Data, a -> RecordPatSynField b -> RecordPatSynField a
(a -> b) -> RecordPatSynField a -> RecordPatSynField b
(forall a b.
 (a -> b) -> RecordPatSynField a -> RecordPatSynField b)
-> (forall a b. a -> RecordPatSynField b -> RecordPatSynField a)
-> Functor RecordPatSynField
forall a b. a -> RecordPatSynField b -> RecordPatSynField a
forall a b. (a -> b) -> RecordPatSynField a -> RecordPatSynField b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RecordPatSynField b -> RecordPatSynField a
$c<$ :: forall a b. a -> RecordPatSynField b -> RecordPatSynField a
fmap :: (a -> b) -> RecordPatSynField a -> RecordPatSynField b
$cfmap :: forall a b. (a -> b) -> RecordPatSynField a -> RecordPatSynField b
Functor)



{-
Note [Record PatSyn Fields]

Consider the following two pattern synonyms.

pattern P x y = ([x,True], [y,'v'])
pattern Q{ x, y } =([x,True], [y,'v'])

In P, we just have two local binders, x and y.

In Q, we have local binders but also top-level record selectors
x :: ([Bool], [Char]) -> Bool and similarly for y.

It would make sense to support record-like syntax

pattern Q{ x=x1, y=y1 } = ([x1,True], [y1,'v'])

when we have a different name for the local and top-level binder
the distinction between the two names clear

-}
instance Outputable a => Outputable (RecordPatSynField a) where
    ppr :: RecordPatSynField a -> SDoc
ppr (RecordPatSynField { recordPatSynSelectorId :: forall a. RecordPatSynField a -> a
recordPatSynSelectorId = a
v }) = a -> SDoc
forall a. Outputable a => a -> SDoc
ppr a
v

instance Foldable RecordPatSynField  where
    foldMap :: (a -> m) -> RecordPatSynField a -> m
foldMap a -> m
f (RecordPatSynField { recordPatSynSelectorId :: forall a. RecordPatSynField a -> a
recordPatSynSelectorId = a
visible
                                 , recordPatSynPatVar :: forall a. RecordPatSynField a -> a
recordPatSynPatVar = a
hidden })
      = a -> m
f a
visible m -> m -> m
forall a. Monoid a => a -> a -> a
`mappend` a -> m
f a
hidden

instance Traversable RecordPatSynField where
    traverse :: (a -> f b) -> RecordPatSynField a -> f (RecordPatSynField b)
traverse a -> f b
f (RecordPatSynField { recordPatSynSelectorId :: forall a. RecordPatSynField a -> a
recordPatSynSelectorId =a
visible
                                  , recordPatSynPatVar :: forall a. RecordPatSynField a -> a
recordPatSynPatVar = a
hidden })
      = (\ b
sel_id b
pat_var -> RecordPatSynField :: forall a. a -> a -> RecordPatSynField a
RecordPatSynField { recordPatSynSelectorId :: b
recordPatSynSelectorId = b
sel_id
                                               , recordPatSynPatVar :: b
recordPatSynPatVar = b
pat_var })
          (b -> b -> RecordPatSynField b)
-> f b -> f (b -> RecordPatSynField b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> f b
f a
visible f (b -> RecordPatSynField b) -> f b -> f (RecordPatSynField b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> a -> f b
f a
hidden


-- | Haskell Pattern Synonym Direction
data HsPatSynDir id
  = Unidirectional
  | ImplicitBidirectional
  | ExplicitBidirectional (MatchGroup id (LHsExpr id))