TcInstDcls.lhs 67 KB
Newer Older
1
%
2
% (c) The University of Glasgow 2006
3
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4
%
5 6

TcInstDecls: Typechecking instance declarations
7 8

\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
9 10 11 12 13 14 15
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

16
module TcInstDcls ( tcInstDecls1, tcInstDecls2 ) where
17

dterei's avatar
dterei committed
18 19
#include "HsVersions.h"

20
import HsSyn
21
import TcBinds
22 23 24
import TcTyClsDecls( tcAddImplicits, tcAddTyFamInstCtxt, tcAddDataFamInstCtxt,
                     tcAddFamInstCtxt, tcSynFamInstDecl, 
                     wrongKindOfFamily, tcFamTyPats, kcDataDefn, dataDeclChecks,
25 26 27 28
                     tcConDecls, checkValidTyCon, badATErr, wrongATArgErr )
import TcClassDcl( tcClassDecl2, 
                   HsSigFun, lookupHsSig, mkHsSigFun, emptyHsSigs,
                   findMethodBind, instantiateMethod, tcInstanceMethodBody )
dterei's avatar
dterei committed
29
import TcPat      ( addInlinePrags )
Ian Lynagh's avatar
Ian Lynagh committed
30
import TcRnMonad
31
import TcValidity
32 33
import TcMType
import TcType
Simon Peyton Jones's avatar
Simon Peyton Jones committed
34
import Coercion( mkSingleCoAxiom, mkBranchedCoAxiom, pprCoAxBranch )
35
import BuildTyCl
36 37 38 39 40 41 42 43
import Inst
import InstEnv
import FamInst
import FamInstEnv
import TcDeriv
import TcEnv
import TcHsType
import TcUnify
44
import Unify      ( tcMatchTyX )
dterei's avatar
dterei committed
45
import MkCore     ( nO_METHOD_BINDING_ERROR_ID )
46
import CoreSyn    ( DFunArg(..) )
47
import Type
48
import TcEvidence
49
import TyCon
50
import CoAxiom
51 52 53
import DataCon
import Class
import Var
54
import VarEnv
55
import VarSet     ( mkVarSet, subVarSet, varSetElems )
56
import Pair
57
import CoreUnfold ( mkDFunUnfolding )
58
import CoreSyn    ( Expr(Var), CoreExpr )
59
import PrelNames  ( typeableClassNames )
dterei's avatar
dterei committed
60 61 62 63

import Bag
import BasicTypes
import DynFlags
64
import ErrUtils
dterei's avatar
dterei committed
65
import FastString
66
import Id
67 68 69
import MkId
import Name
import NameSet
dterei's avatar
dterei committed
70
import Outputable
71 72
import SrcLoc
import Util
dterei's avatar
dterei committed
73

74
import Control.Monad
dterei's avatar
dterei committed
75
import Maybes     ( orElse )
76 77 78
\end{code}

Typechecking instance declarations is done in two passes. The first
79 80
pass, made by @tcInstDecls1@, collects information to be used in the
second pass.
81 82 83 84 85 86 87

This pre-processed info includes the as-yet-unprocessed bindings
inside the instance declaration.  These are type-checked in the second
pass, when the class-instance envs and GVE contain all the info from
all the instance and value decls.  Indeed that's the reason we need
two passes over the instance decls.

88 89 90 91 92 93

Note [How instance declarations are translated]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Here is how we translation instance declarations into Core

Running example:
dterei's avatar
dterei committed
94 95 96
        class C a where
           op1, op2 :: Ix b => a -> b -> b
           op2 = <dm-rhs>
97

dterei's avatar
dterei committed
98 99 100
        instance C a => C [a]
           {-# INLINE [2] op1 #-}
           op1 = <rhs>
101
===>
dterei's avatar
dterei committed
102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
        -- Method selectors
        op1,op2 :: forall a. C a => forall b. Ix b => a -> b -> b
        op1 = ...
        op2 = ...

        -- Default methods get the 'self' dictionary as argument
        -- so they can call other methods at the same type
        -- Default methods get the same type as their method selector
        $dmop2 :: forall a. C a => forall b. Ix b => a -> b -> b
        $dmop2 = /\a. \(d:C a). /\b. \(d2: Ix b). <dm-rhs>
               -- NB: type variables 'a' and 'b' are *both* in scope in <dm-rhs>
               -- Note [Tricky type variable scoping]

        -- A top-level definition for each instance method
        -- Here op1_i, op2_i are the "instance method Ids"
        -- The INLINE pragma comes from the user pragma
        {-# INLINE [2] op1_i #-}  -- From the instance decl bindings
        op1_i, op2_i :: forall a. C a => forall b. Ix b => [a] -> b -> b
dterei's avatar
dterei committed
120
        op1_i = /\a. \(d:C a).
dterei's avatar
dterei committed
121 122 123 124 125 126 127 128 129 130 131 132
               let this :: C [a]
                   this = df_i a d
                     -- Note [Subtle interaction of recursion and overlap]

                   local_op1 :: forall b. Ix b => [a] -> b -> b
                   local_op1 = <rhs>
                     -- Source code; run the type checker on this
                     -- NB: Type variable 'a' (but not 'b') is in scope in <rhs>
                     -- Note [Tricky type variable scoping]

               in local_op1 a d

dterei's avatar
dterei committed
133
        op2_i = /\a \d:C a. $dmop2 [a] (df_i a d)
dterei's avatar
dterei committed
134 135 136 137 138 139 140

        -- The dictionary function itself
        {-# NOINLINE CONLIKE df_i #-}   -- Never inline dictionary functions
        df_i :: forall a. C a -> C [a]
        df_i = /\a. \d:C a. MkC (op1_i a d) (op2_i a d)
                -- But see Note [Default methods in instances]
                -- We can't apply the type checker to the default-method call
141

142
        -- Use a RULE to short-circuit applications of the class ops
dterei's avatar
dterei committed
143
        {-# RULE "op1@C[a]" forall a, d:C a.
144 145
                            op1 [a] (df_i d) = op1_i a d #-}

146 147
Note [Instances and loop breakers]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
148
* Note that df_i may be mutually recursive with both op1_i and op2_i.
dterei's avatar
dterei committed
149
  It's crucial that df_i is not chosen as the loop breaker, even
150 151 152 153 154 155
  though op1_i has a (user-specified) INLINE pragma.

* Instead the idea is to inline df_i into op1_i, which may then select
  methods from the MkC record, and thereby break the recursion with
  df_i, leaving a *self*-recurisve op1_i.  (If op1_i doesn't call op at
  the same type, it won't mention df_i, so there won't be recursion in
dterei's avatar
dterei committed
156
  the first place.)
157 158 159

* If op1_i is marked INLINE by the user there's a danger that we won't
  inline df_i in it, and that in turn means that (since it'll be a
dterei's avatar
dterei committed
160
  loop-breaker because df_i isn't), op1_i will ironically never be
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
161 162 163 164
  inlined.  But this is OK: the recursion breaking happens by way of
  a RULE (the magic ClassOp rule above), and RULES work inside InlineRule
  unfoldings. See Note [RULEs enabled in SimplGently] in SimplUtils

165 166 167 168 169 170 171 172 173 174
Note [ClassOp/DFun selection]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
One thing we see a lot is stuff like
    op2 (df d1 d2)
where 'op2' is a ClassOp and 'df' is DFun.  Now, we could inline *both*
'op2' and 'df' to get
     case (MkD ($cop1 d1 d2) ($cop2 d1 d2) ... of
       MkD _ op2 _ _ _ -> op2
And that will reduce to ($cop2 d1 d2) which is what we wanted.

dterei's avatar
dterei committed
175
But it's tricky to make this work in practice, because it requires us to
176
inline both 'op2' and 'df'.  But neither is keen to inline without having
dterei's avatar
dterei committed
177
seen the other's result; and it's very easy to get code bloat (from the
178 179 180
big intermediate) if you inline a bit too much.

Instead we use a cunning trick.
dterei's avatar
dterei committed
181
 * We arrange that 'df' and 'op2' NEVER inline.
182 183 184 185 186 187 188 189

 * We arrange that 'df' is ALWAYS defined in the sylised form
      df d1 d2 = MkD ($cop1 d1 d2) ($cop2 d1 d2) ...

 * We give 'df' a magical unfolding (DFunUnfolding [$cop1, $cop2, ..])
   that lists its methods.

 * We make CoreUnfold.exprIsConApp_maybe spot a DFunUnfolding and return
dterei's avatar
dterei committed
190
   a suitable constructor application -- inlining df "on the fly" as it
191 192 193 194 195 196
   were.

 * We give the ClassOp 'op2' a BuiltinRule that extracts the right piece
   iff its argument satisfies exprIsConApp_maybe.  This is done in
   MkId mkDictSelId

Gabor Greif's avatar
Gabor Greif committed
197
 * We make 'df' CONLIKE, so that shared uses still match; eg
198 199 200 201 202
      let d = df d1 d2
      in ...(op2 d)...(op1 d)...

Note [Single-method classes]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
203
If the class has just one method (or, more accurately, just one element
204
of {superclasses + methods}), then we use a different strategy.
205 206 207 208

   class C a where op :: a -> a
   instance C a => C [a] where op = <blah>

209 210 211
We translate the class decl into a newtype, which just gives a
top-level axiom. The "constructor" MkC expands to a cast, as does the
class-op selector.
212 213 214 215 216 217

   axiom Co:C a :: C a ~ (a->a)

   op :: forall a. C a -> (a -> a)
   op a d = d |> (Co:C a)

218 219 220
   MkC :: forall a. (a->a) -> C a
   MkC = /\a.\op. op |> (sym Co:C a)

221
The clever RULE stuff doesn't work now, because ($df a d) isn't
dterei's avatar
dterei committed
222
a constructor application, so exprIsConApp_maybe won't return
223
Just <blah>.
224

225
Instead, we simply rely on the fact that casts are cheap:
226

227
   $df :: forall a. C a => C [a]
228
   {-# INLINE df #-}  -- NB: INLINE this
229 230
   $df = /\a. \d. MkC [a] ($cop_list a d)
       = $cop_list |> forall a. C a -> (sym (Co:C [a]))
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
231

232 233
   $cop_list :: forall a. C a => [a] -> [a]
   $cop_list = <blah>
234

235 236 237 238
So if we see
   (op ($df a d))
we'll inline 'op' and '$df', since both are simply casts, and
good things happen.
239

240 241 242 243 244
Why do we use this different strategy?  Because otherwise we
end up with non-inlined dictionaries that look like
    $df = $cop |> blah
which adds an extra indirection to every use, which seems stupid.  See
Trac #4138 for an example (although the regression reported there
Simon Peyton Jones's avatar
Simon Peyton Jones committed
245
wasn't due to the indirection).
246

dterei's avatar
dterei committed
247
There is an awkward wrinkle though: we want to be very
248
careful when we have
249 250 251
    instance C a => C [a] where
      {-# INLINE op #-}
      op = ...
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
252 253
then we'll get an INLINE pragma on $cop_list but it's important that
$cop_list only inlines when it's applied to *two* arguments (the
Gabor Greif's avatar
Gabor Greif committed
254
dictionary and the list argument).  So we must not eta-expand $df
dterei's avatar
dterei committed
255
above.  We ensure that this doesn't happen by putting an INLINE
256 257
pragma on the dfun itself; after all, it ends up being just a cast.

dterei's avatar
dterei committed
258
There is one more dark corner to the INLINE story, even more deeply
259 260 261 262 263 264 265
buried.  Consider this (Trac #3772):

    class DeepSeq a => C a where
      gen :: Int -> a

    instance C a => C [a] where
      gen n = ...
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
266

267 268
    class DeepSeq a where
      deepSeq :: a -> b -> b
269

270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296
    instance DeepSeq a => DeepSeq [a] where
      {-# INLINE deepSeq #-}
      deepSeq xs b = foldr deepSeq b xs

That gives rise to these defns:

    $cdeepSeq :: DeepSeq a -> [a] -> b -> b
    -- User INLINE( 3 args )!
    $cdeepSeq a (d:DS a) b (x:[a]) (y:b) = ...

    $fDeepSeq[] :: DeepSeq a -> DeepSeq [a]
    -- DFun (with auto INLINE pragma)
    $fDeepSeq[] a d = $cdeepSeq a d |> blah

    $cp1 a d :: C a => DeepSep [a]
    -- We don't want to eta-expand this, lest
    -- $cdeepSeq gets inlined in it!
    $cp1 a d = $fDeepSep[] a (scsel a d)

    $fC[] :: C a => C [a]
    -- Ordinary DFun
    $fC[] a d = MkC ($cp1 a d) ($cgen a d)

Here $cp1 is the code that generates the superclass for C [a].  The
issue is this: we must not eta-expand $cp1 either, or else $fDeepSeq[]
and then $cdeepSeq will inline there, which is definitely wrong.  Like
on the dfun, we solve this by adding an INLINE pragma to $cp1.
simonpj@microsoft.com's avatar
simonpj@microsoft.com committed
297

298 299 300 301 302 303 304
Note [Subtle interaction of recursion and overlap]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Consider this
  class C a where { op1,op2 :: a -> a }
  instance C a => C [a] where
    op1 x = op2 x ++ op2 x
    op2 x = ...
305
  instance C [Int] where
306 307 308 309 310 311 312
    ...

When type-checking the C [a] instance, we need a C [a] dictionary (for
the call of op2).  If we look up in the instance environment, we find
an overlap.  And in *general* the right thing is to complain (see Note
[Overlapping instances] in InstEnv).  But in *this* case it's wrong to
complain, because we just want to delegate to the op2 of this same
dterei's avatar
dterei committed
313
instance.
314

dterei's avatar
dterei committed
315
Why is this justified?  Because we generate a (C [a]) constraint in
316
a context in which 'a' cannot be instantiated to anything that matches
Gabor Greif's avatar
Gabor Greif committed
317
other overlapping instances, or else we would not be executing this
318 319 320 321 322 323 324 325 326 327 328 329 330
version of op1 in the first place.

It might even be a bit disguised:

  nullFail :: C [a] => [a] -> [a]
  nullFail x = op2 x ++ op2 x

  instance C a => C [a] where
    op1 x = nullFail x

Precisely this is used in package 'regex-base', module Context.hs.
See the overlapping instances for RegexContext, and the fact that they
call 'nullFail' just like the example above.  The DoCon package also
Gabor Greif's avatar
Gabor Greif committed
331
does the same thing; it shows up in module Fraction.hs.
332

333 334 335 336 337 338
Conclusion: when typechecking the methods in a C [a] instance, we want to
treat the 'a' as an *existential* type variable, in the sense described
by Note [Binding when looking up instances].  That is why isOverlappableTyVar
responds True to an InstSkol, which is the kind of skolem we use in
tcInstDecl2.

339

340 341 342
Note [Tricky type variable scoping]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
In our example
dterei's avatar
dterei committed
343 344 345
        class C a where
           op1, op2 :: Ix b => a -> b -> b
           op2 = <dm-rhs>
346

dterei's avatar
dterei committed
347 348 349
        instance C a => C [a]
           {-# INLINE [2] op1 #-}
           op1 = <rhs>
350 351 352 353 354 355 356 357

note that 'a' and 'b' are *both* in scope in <dm-rhs>, but only 'a' is
in scope in <rhs>.  In particular, we must make sure that 'b' is in
scope when typechecking <dm-rhs>.  This is achieved by subFunTys,
which brings appropriate tyvars into scope. This happens for both
<dm-rhs> and for <rhs>, but that doesn't matter: the *renamer* will have
complained if 'b' is mentioned in <rhs>.

358

359 360

%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
361
%*                                                                      *
362
\subsection{Extracting instance decls}
Ian Lynagh's avatar
Ian Lynagh committed
363
%*                                                                      *
364 365 366 367
%************************************************************************

Gather up the instance declarations from their various sources

368
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
369 370 371 372 373
tcInstDecls1    -- Deal with both source-code and imported instance decls
   :: [LTyClDecl Name]          -- For deriving stuff
   -> [LInstDecl Name]          -- Source code instance decls
   -> [LDerivDecl Name]         -- Source code stand-alone deriving decls
   -> TcM (TcGblEnv,            -- The full inst env
374
           [InstInfo Name],     -- Source-code instance decls to process;
Ian Lynagh's avatar
Ian Lynagh committed
375 376
                                -- contains all dfuns for this module
           HsValBinds Name)     -- Supporting bindings for derived instances
377

378
tcInstDecls1 tycl_decls inst_decls deriv_decls 
379
  = checkNoErrs $
380 381 382 383
    do {    -- Stop if addInstInfos etc discovers any errors
            -- (they recover, so that we get more than one error each
            -- round)

384
            -- Do class and family instance declarations
385 386 387 388 389 390
       ; stuff <- mapAndRecoverM tcLocalInstDecl inst_decls
       ; let (local_infos_s, fam_insts_s) = unzip stuff
             local_infos = concat local_infos_s
             fam_insts   = concat fam_insts_s
       ; addClsInsts local_infos $
         addFamInsts fam_insts   $ 
391

392
    do {    -- Compute instances from "deriving" clauses;
393 394 395 396
            -- This stuff computes a context for the derived instance
            -- decl, so it needs to know about all the instances possible
            -- NB: class instance declarations can contain derivings as
            --     part of associated data type declarations
397
         failIfErrsM    -- If the addInsts stuff gave any errors, don't
dterei's avatar
dterei committed
398 399
                        -- try the deriving stuff, because that may give
                        -- more errors still
dreixel's avatar
dreixel committed
400

401
       ; traceTc "tcDeriving" empty
402
       ; th_stage <- getStage   -- See Note [Deriving inside TH brackets ]
403
       ; (gbl_env, deriv_inst_info, deriv_binds)
404
              <- if isBrackStage th_stage 
405 406
                 then do { gbl_env <- getGblEnv
                         ; return (gbl_env, emptyBag, emptyValBindsOut) }
407 408
                 else tcDeriving tycl_decls inst_decls deriv_decls

409

410 411
       -- Check that if the module is compiled with -XSafe, there are no
       -- hand written instances of Typeable as then unsafe casts could be
dreixel's avatar
dreixel committed
412
       -- performed. Derived instances are OK.
413
       ; dflags <- getDynFlags
414
       ; when (safeLanguageOn dflags) $
415
             mapM_ (\x -> when (typInstCheck x)
416
                               (addErrAt (getSrcSpan $ iSpec x) typInstErr))
417
                   local_infos
418 419
       -- As above but for Safe Inference mode.
       ; when (safeInferOn dflags) $
420
             mapM_ (\x -> when (typInstCheck x) recordUnsafeInfer) local_infos
421

dreixel's avatar
dreixel committed
422
       ; return ( gbl_env
423
                , bagToList deriv_inst_info ++ local_infos
424
                , deriv_binds)
425
    }}
dterei's avatar
dterei committed
426
  where
427
    typInstCheck ty = is_cls_nm (iSpec ty) `elem` typeableClassNames
dterei's avatar
dterei committed
428 429
    typInstErr = ptext $ sLit $ "Can't create hand written instances of Typeable in Safe"
                              ++ " Haskell! Can only derive them"
430

431 432
addClsInsts :: [InstInfo Name] -> TcM a -> TcM a
addClsInsts infos thing_inside
433
  = tcExtendLocalInstEnv (map iSpec infos) thing_inside
434

435
addFamInsts :: [FamInst Branched] -> TcM a -> TcM a
436 437 438 439
-- Extend (a) the family instance envt
--        (b) the type envt with stuff from data type decls
addFamInsts fam_insts thing_inside
  = tcExtendLocalFamInstEnv fam_insts $ 
440
    tcExtendGlobalEnv things  $ 
441 442
    do { traceTc "addFamInsts" (pprFamInsts fam_insts)
       ; tcg_env <- tcAddImplicits things
443 444 445 446 447
       ; setGblEnv tcg_env thing_inside }
  where
    axioms = map famInstAxiom fam_insts
    tycons = famInstsRepTyCons fam_insts
    things = map ATyCon tycons ++ map ACoAxiom axioms 
SamB's avatar
SamB committed
448
\end{code}
449

450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466
Note [Deriving inside TH brackets]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Given a declaration bracket
  [d| data T = A | B deriving( Show ) |]

there is really no point in generating the derived code for deriving(
Show) and then type-checking it. This will happen at the call site
anyway, and the type check should never fail!  Moreover (Trac #6005)
the scoping of the generated code inside the bracket does not seem to 
work out.  

The easy solution is simply not to generate the derived instances at
all.  (A less brutal solution would be to generate them with no
bindings.)  This will become moot when we shift to the new TH plan, so 
the brutal solution will do.


467
\begin{code}
468
tcLocalInstDecl :: LInstDecl Name
469
                -> TcM ([InstInfo Name], [FamInst Branched])
Ian Lynagh's avatar
Ian Lynagh committed
470 471 472 473
        -- A source-file instance declaration
        -- Type-check all the stuff before the "where"
        --
        -- We check for respectable instance type, and context
474
tcLocalInstDecl (L loc (TyFamInstD { tfid_inst = decl }))
475
  = setSrcSpan loc      $
476 477
    tcAddTyFamInstCtxt decl  $
    do { fam_tc <- tcFamInstDeclCombined TopLevel (tyFamInstDeclLName decl)
478
       ; fam_inst <- tcTyFamInstDecl Nothing fam_tc (L loc decl)
479 480
       ; return ([], [fam_inst]) }

481 482 483 484
tcLocalInstDecl (L loc (DataFamInstD { dfid_inst = decl }))
  = setSrcSpan loc      $
    tcAddDataFamInstCtxt decl  $
    do { fam_tc <- tcFamInstDeclCombined TopLevel (dfid_tycon decl)
485
       ; fam_inst <- tcDataFamInstDecl Nothing fam_tc (L loc decl)
486 487 488 489 490 491 492 493 494 495 496 497
       ; return ([], [toBranchedFamInst fam_inst]) }

tcLocalInstDecl (L loc (ClsInstD { cid_inst = decl }))
  = setSrcSpan loc $
    do { (insts, fam_insts) <- tcClsInstDecl decl
       ; return (insts, map toBranchedFamInst fam_insts) }

tcClsInstDecl :: ClsInstDecl Name -> TcM ([InstInfo Name], [FamInst Unbranched])
tcClsInstDecl (ClsInstDecl { cid_poly_ty = poly_ty, cid_binds = binds
                           , cid_sigs = uprags, cid_tyfam_insts = ats
                           , cid_datafam_insts = adts })
  = addErrCtxt (instDeclCtxt1 poly_ty)  $
Ian Lynagh's avatar
Ian Lynagh committed
498 499 500 501 502

    do  { is_boot <- tcIsHsBoot
        ; checkTc (not is_boot || (isEmptyLHsBinds binds && null uprags))
                  badBootDeclErr

dreixel's avatar
dreixel committed
503
        ; (tyvars, theta, clas, inst_tys) <- tcHsInstHead InstDeclCtxt poly_ty
504 505 506
        ; let mini_env   = mkVarEnv (classTyVars clas `zip` inst_tys)
              mini_subst = mkTvSubst (mkInScopeSet (mkVarSet tyvars)) mini_env
                           
507
        -- Next, process any associated types.
508
        ; traceTc "tcLocalInstDecl" (ppr poly_ty)
509
        ; tyfam_insts0 <- tcExtendTyVarEnv tyvars $
510
                          mapAndRecoverM (tcAssocTyDecl clas mini_env) ats
511
        ; datafam_insts <- tcExtendTyVarEnv tyvars $
512
                           mapAndRecoverM (tcAssocDataDecl clas mini_env) adts
513

dreixel's avatar
dreixel committed
514
        -- Check for missing associated types and build them
515
        -- from their defaults (if available)
516 517
        ; let defined_ats = mkNameSet $ map (tyFamInstDeclName . unLoc) ats
              defined_adts = mkNameSet $ map (unLoc . dfid_tycon . unLoc) adts
518

519
              mk_deflt_at_instances :: ClassATItem -> TcM [FamInst Unbranched]
520
              mk_deflt_at_instances (fam_tc, defs)
521
                 -- User supplied instances ==> everything is OK
522 523
                | tyConName fam_tc `elemNameSet` defined_ats
                   || tyConName fam_tc `elemNameSet` defined_adts
524 525
                = return []

526
                 -- No defaults ==> generate a warning
527 528 529 530
                | null defs
                = do { warnMissingMethodOrAT "associated type" (tyConName fam_tc)
                     ; return [] }

531
                 -- No user instance, have defaults ==> instatiate them
532 533 534 535
                 -- Example:   class C a where { type F a b :: *; type F a b = () }
                 --            instance C [x]
                 -- Then we want to generate the decl:   type F [x] b = ()
                | otherwise 
536
                = forM defs $ \(CoAxBranch { cab_lhs = pat_tys, cab_rhs = rhs }) ->
537 538 539 540 541
                  do { let pat_tys' = substTys mini_subst pat_tys
                           rhs'     = substTy  mini_subst rhs
                           tv_set'  = tyVarsOfTypes pat_tys'
                           tvs'     = varSetElems tv_set'
                     ; rep_tc_name <- newFamInstTyConName (noLoc (tyConName fam_tc)) pat_tys'
542
                     ; let axiom = mkSingleCoAxiom rep_tc_name tvs' fam_tc pat_tys' rhs'
543
                     ; ASSERT( tyVarsOfType rhs' `subVarSet` tv_set' ) 
544
                       newFamInst SynFamilyInst False {- group -} axiom }
545

546
        ; tyfam_insts1 <- mapM mk_deflt_at_instances (classATItems clas)
547
        
Ian Lynagh's avatar
Ian Lynagh committed
548 549
        -- Finally, construct the Core representation of the instance.
        -- (This no longer includes the associated types.)
550
        ; dfun_name <- newDFunName clas inst_tys (getLoc poly_ty)
dterei's avatar
dterei committed
551
                -- Dfun location is that of instance *header*
552

Ian Lynagh's avatar
Ian Lynagh committed
553
        ; overlap_flag <- getOverlapFlag
554
        ; (subst, tyvars') <- tcInstSkolTyVars tyvars
555
        ; let dfun  	= mkDictFunId dfun_name tyvars theta clas inst_tys
556 557 558
              ispec 	= mkLocalInstance dfun overlap_flag tyvars' clas (substTys subst inst_tys)
                            -- Be sure to freshen those type variables, 
                            -- so they are sure not to appear in any lookup
559 560
              inst_info = InstInfo { iSpec  = ispec, iBinds = VanillaInst binds uprags False }

561
        ; return ( [inst_info], tyfam_insts0 ++ concat tyfam_insts1 ++ datafam_insts) }
562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584

--------------
tcAssocTyDecl :: Class                   -- Class of associated type
              -> VarEnv Type             -- Instantiation of class TyVars
              -> LTyFamInstDecl Name     
              -> TcM (FamInst Unbranched)
tcAssocTyDecl clas mini_env ldecl@(L loc decl)
  = setSrcSpan loc $
    tcAddTyFamInstCtxt decl $
    do { fam_tc <- tcFamInstDeclCombined NotTopLevel (tyFamInstDeclLName decl)
       ; fam_inst <- tcTyFamInstDecl (Just (clas, mini_env)) fam_tc ldecl
       ; return $ toUnbranchedFamInst fam_inst }

--------------
tcAssocDataDecl :: Class                 -- ^ Class of associated type
                -> VarEnv Type           -- ^ Instantiation of class TyVars
                -> LDataFamInstDecl Name -- ^ RHS
                -> TcM (FamInst Unbranched)
tcAssocDataDecl clas mini_env ldecl@(L loc decl)
  = setSrcSpan loc $
    tcAddDataFamInstCtxt decl $
    do { fam_tc <- tcFamInstDeclCombined NotTopLevel (dfid_tycon decl)
       ; tcDataFamInstDecl (Just (clas, mini_env)) fam_tc ldecl }
585 586
\end{code}

587 588 589 590 591 592 593 594 595 596 597 598
%************************************************************************
%*                                                                      *
               Type checking family instances
%*                                                                      *
%************************************************************************

Family instances are somewhat of a hybrid.  They are processed together with
class instance heads, but can contain data constructors and hence they share a
lot of kinding and type checking code with ordinary algebraic data types (and
GADTs).

\begin{code}
599 600
tcFamInstDeclCombined :: TopLevelFlag -> Located Name -> TcM TyCon
tcFamInstDeclCombined top_lvl fam_tc_lname
601
  = do { -- Type family instances require -XTypeFamilies
602
         -- and can't (currently) be in an hs-boot file
603
       ; traceTc "tcFamInstDecl" (ppr fam_tc_lname)
604 605 606 607 608 609 610 611 612 613 614
       ; type_families <- xoptM Opt_TypeFamilies
       ; is_boot <- tcIsHsBoot   -- Are we compiling an hs-boot file?
       ; checkTc type_families $ badFamInstDecl fam_tc_lname
       ; checkTc (not is_boot) $ badBootFamInstDeclErr

       -- Look up the family TyCon and check for validity including
       -- check that toplevel type instances are not for associated types.
       ; fam_tc <- tcLookupLocatedTyCon fam_tc_lname
       ; when (isTopLevel top_lvl && isTyConAssoc fam_tc)
              (addErr $ assocInClassErr fam_tc_lname)

615
       ; return fam_tc }
616

617 618
tcTyFamInstDecl :: Maybe (Class, VarEnv Type) -- the class & mini_env if applicable
                -> TyCon -> LTyFamInstDecl Name -> TcM (FamInst Branched)
619
  -- "type instance"
620
tcTyFamInstDecl mb_clsinfo fam_tc (L loc decl@(TyFamInstDecl { tfid_group = group }))
621
  = do { -- (0) Check it's an open type family
Simon Peyton Jones's avatar
Simon Peyton Jones committed
622 623 624
         checkTc (isFamilyTyCon fam_tc) (notFamily fam_tc)
       ; checkTc (isSynTyCon fam_tc) (wrongKindOfFamily fam_tc)
       ; checkTc (isOpenSynFamilyTyCon fam_tc)
625 626
                 (notOpenFamily fam_tc)

627
         -- (1) do the work of verifying the synonym group
628
       ; co_ax_branches <- tcSynFamInstDecl fam_tc decl
629

630
         -- (2) check for validity and inaccessibility
631
       ; foldlM_ check_valid_branch [] co_ax_branches
632

633
         -- (3) construct coercion axiom
634 635
       ; rep_tc_name <- newFamInstAxiomName loc
                                            (tyFamInstDeclName decl)
636 637 638
                                            (map cab_lhs co_ax_branches)
       ; let axiom = mkBranchedCoAxiom rep_tc_name fam_tc co_ax_branches
       ; newFamInst SynFamilyInst group axiom }
639
    where 
640 641 642 643 644 645
      check_valid_branch :: [CoAxBranch]     -- previous
                         -> CoAxBranch       -- current
                         -> TcM [CoAxBranch] -- current : previous
      check_valid_branch prev_branches
          cur_branch@(CoAxBranch { cab_tvs = t_tvs, cab_lhs = t_typats
                                 , cab_rhs = t_rhs, cab_loc = loc })
646
        = setSrcSpan loc $
647
          do { -- Check the well-formedness of the instance
648 649
               checkValidTyFamInst fam_tc t_tvs t_typats t_rhs

650 651
               -- Check that type patterns match the class instance head
             ; checkConsistentFamInst mb_clsinfo (ptext (sLit "type")) fam_tc t_tvs t_typats
652

653 654 655 656
               -- Check whether the branch is dominated by earlier
               -- ones and hence is inaccessible
             ; when (t_typats `isDominatedBy` prev_branches) $
               addErrTc $ inaccessibleCoAxBranch fam_tc cur_branch
657 658 659

             ; return $ cur_branch : prev_branches }

660 661
tcDataFamInstDecl :: Maybe (Class, VarEnv Type)
                  -> TyCon -> LDataFamInstDecl Name -> TcM (FamInst Unbranched)
662
  -- "newtype instance" and "data instance"
663 664 665 666 667 668
tcDataFamInstDecl mb_clsinfo fam_tc 
    (L loc (DataFamInstDecl
             { dfid_pats = pats
             , dfid_tycon = fam_tc_name
             , dfid_defn = defn@HsDataDefn { dd_ND = new_or_data, dd_cType = cType
                                           , dd_ctxt = ctxt, dd_cons = cons } }))
669 670
  = setSrcSpan loc $
    do { -- Check that the family declaration is for the right kind
671 672 673
         checkTc (isFamilyTyCon fam_tc) (notFamily fam_tc)
       ; checkTc (isAlgTyCon fam_tc) (wrongKindOfFamily fam_tc)

dreixel's avatar
dreixel committed
674
         -- Kind check type patterns
675
       ; tcFamTyPats fam_tc pats (kcDataDefn defn) $ 
676
           \tvs' pats' res_kind -> do
677

678
       { -- Check that left-hand side contains no type family applications
dreixel's avatar
dreixel committed
679
         -- (vanilla synonyms are fine, though, and we checked for
680 681 682 683
         --  foralls earlier)
         checkValidFamPats fam_tc tvs' pats'
         -- Check that type patterns match class instance head, if any
       ; checkConsistentFamInst mb_clsinfo (ppr new_or_data) fam_tc tvs' pats'
dreixel's avatar
dreixel committed
684 685
         
         -- Result kind must be '*' (otherwise, we have too few patterns)
686
       ; checkTc (isLiftedTypeKind res_kind) $ tooFewParmsErr (tyConArity fam_tc)
687

688
       ; stupid_theta <- tcHsContext ctxt
689
       ; h98_syntax <- dataDeclChecks (tyConName fam_tc) new_or_data stupid_theta cons
690

dreixel's avatar
dreixel committed
691
         -- Construct representation tycon
692
       ; rep_tc_name <- newFamInstTyConName fam_tc_name pats'
693
       ; axiom_name  <- newImplicitBinder rep_tc_name mkInstTyCoOcc
694
       ; let orig_res_ty = mkTyConApp fam_tc pats'
695 696

       ; (rep_tc, fam_inst) <- fixM $ \ ~(rec_rep_tc, _) ->
697
           do { data_cons <- tcConDecls new_or_data rec_rep_tc
dreixel's avatar
dreixel committed
698
                                       (tvs', orig_res_ty) cons
699 700 701 702
              ; tc_rhs <- case new_or_data of
                     DataType -> return (mkDataTyConRhs data_cons)
                     NewType  -> ASSERT( not (null data_cons) )
                                 mkNewTyConRhs rep_tc_name rec_rep_tc (head data_cons)
703
              -- freshen tyvars
704 705 706 707
              ; let axiom    = mkSingleCoAxiom axiom_name tvs' fam_tc pats' 
                                               (mkTyConApp rep_tc (mkTyVarTys tvs'))
                    parent   = FamInstTyCon axiom fam_tc pats'
                    rep_tc   = buildAlgTyCon rep_tc_name tvs' cType stupid_theta tc_rhs 
708 709 710
                                             Recursive 
                                             False      -- No promotable to the kind level
                                             h98_syntax parent
711 712 713 714 715
                 -- We always assume that indexed types are recursive.  Why?
                 -- (1) Due to their open nature, we can never be sure that a
                 -- further instance might not introduce a new recursive
                 -- dependency.  (2) They are always valid loop breakers as
                 -- they involve a coercion.
716
              ; fam_inst <- newFamInst (DataFamilyInst rep_tc) False axiom
717 718 719 720 721
              ; return (rep_tc, fam_inst) }

         -- Remember to check validity; no recursion to worry about here
       ; checkValidTyCon rep_tc
       ; return fam_inst } }
722
\end{code}
723 724


725 726 727 728 729 730 731 732 733 734 735 736 737 738 739
Note [Associated type instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We allow this:
  class C a where
    type T x a
  instance C Int where
    type T (S y) Int = y
    type T Z     Int = Char

Note that 
  a) The variable 'x' is not bound by the class decl
  b) 'x' is instantiated to a non-type-variable in the instance
  c) There are several type instance decls for T in the instance

All this is fine.  Of course, you can't give any *more* instances
Gabor Greif's avatar
typos  
Gabor Greif committed
740
for (T ty Int) elsewhere, because it's an *associated* type.
741 742 743 744 745 746 747 748 749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765 766 767 768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798

Note [Checking consistent instantiation]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  class C a b where
    type T a x b

  instance C [p] Int
    type T [p] y Int = (p,y,y)  -- Induces the family instance TyCon
                                --    type TR p y = (p,y,y)

So we 
  * Form the mini-envt from the class type variables a,b
    to the instance decl types [p],Int:   [a->[p], b->Int]

  * Look at the tyvars a,x,b of the type family constructor T
    (it shares tyvars with the class C)

  * Apply the mini-evnt to them, and check that the result is
    consistent with the instance types [p] y Int

We do *not* assume (at this point) the the bound variables of 
the assoicated type instance decl are the same as for the parent
instance decl. So, for example,

  instance C [p] Int
    type T [q] y Int = ...

would work equally well. Reason: making the *kind* variables line
up is much harder. Example (Trac #7282):
  class Foo (xs :: [k]) where
     type Bar xs :: *

   instance Foo '[] where
     type Bar '[] = Int
Here the instance decl really looks like
   instance Foo k ('[] k) where
     type Bar k ('[] k) = Int
but the k's are not scoped, and hence won't match Uniques.

So instead we just match structure, with tcMatchTyX, and check
that distinct type variales match 1-1 with distinct type variables.

HOWEVER, we *still* make the instance type variables scope over the
type instances, to pick up non-obvious kinds.  Eg
   class Foo (a :: k) where
      type F a
   instance Foo (b :: k -> k) where
      type F b = Int
Here the instance is kind-indexed and really looks like
      type F (k->k) (b::k->k) = Int
But if the 'b' didn't scope, we would make F's instance too
poly-kinded.

\begin{code}
checkConsistentFamInst 
               :: Maybe ( Class
                        , VarEnv Type )  -- ^ Class of associated type
                                         -- and instantiation of class TyVars
799 800
               -> SDoc               -- ^ "flavor" of the instance
               -> TyCon              -- ^ Family tycon
801
               -> [TyVar]            -- ^ Type variables of the family instance
802
               -> [Type]             -- ^ Type patterns from instance
803
               -> TcM ()
804 805 806 807 808 809
-- See Note [Checking consistent instantiation]

checkConsistentFamInst Nothing _ _ _ _ = return ()
checkConsistentFamInst (Just (clas, mini_env)) flav fam_tc at_tvs at_tys
  = tcAddFamInstCtxt flav (tyConName fam_tc) $
    do { -- Check that the associated type indeed comes from this class
810
         checkTc (Just clas == tyConAssoc_maybe fam_tc)
811
                 (badATErr (className clas) (tyConName fam_tc))
812

813 814 815 816 817
         -- See Note [Checking consistent instantiation] in TcTyClsDecls
         -- Check right to left, so that we spot type variable
         -- inconsistencies before (more confusing) kind variables
       ; discardResult $ foldrM check_arg emptyTvSubst $
                         tyConTyVars fam_tc `zip` at_tys }
818
  where
819 820 821 822
    at_tv_set = mkVarSet at_tvs

    check_arg :: (TyVar, Type) -> TvSubst -> TcM TvSubst
    check_arg (fam_tc_tv, at_ty) subst
823
      | Just inst_ty <- lookupVarEnv mini_env fam_tc_tv
824 825 826
      = case tcMatchTyX at_tv_set subst at_ty inst_ty of
           Just subst | all_distinct subst -> return subst
           _ -> failWithTc $ wrongATArgErr at_ty inst_ty
Gabor Greif's avatar
typos  
Gabor Greif committed
827
                -- No need to instantiate here, because the axiom
828
                -- uses the same type variables as the assocated class
829
      | otherwise
830 831 832 833 834 835 836 837 838 839 840 841 842 843 844
      = return subst   -- Allow non-type-variable instantiation
                       -- See Note [Associated type instances]

    all_distinct :: TvSubst -> Bool
    -- True if all the variables mapped the substitution 
    -- map to *distinct* type *variables*
    all_distinct subst = go [] at_tvs
       where
         go _   []       = True
         go acc (tv:tvs) = case lookupTyVar subst tv of
                             Nothing -> go acc tvs
                             Just ty | Just tv' <- tcGetTyVar_maybe ty
                                     , tv' `notElem` acc
                                     -> go (tv' : acc) tvs
                             _other -> False
845 846 847
\end{code}


848
%************************************************************************
Ian Lynagh's avatar
Ian Lynagh committed
849
%*                                                                      *
850
      Type-checking instance declarations, pass 2
Ian Lynagh's avatar
Ian Lynagh committed
851
%*                                                                      *
852 853 854
%************************************************************************

\begin{code}
855
tcInstDecls2 :: [LTyClDecl Name] -> [InstInfo Name]
856
             -> TcM (LHsBinds Id)
Ian Lynagh's avatar
Ian Lynagh committed
857 858
-- (a) From each class declaration,
--      generate any default-method bindings
859
-- (b) From each instance decl
Ian Lynagh's avatar
Ian Lynagh committed
860
--      generate the dfun binding
861 862

tcInstDecls2 tycl_decls inst_decls
Ian Lynagh's avatar
Ian Lynagh committed
863
  = do  { -- (a) Default methods from class decls
864
          let class_decls = filter (isClassDecl . unLoc) tycl_decls
865
        ; dm_binds_s <- mapM tcClassDecl2 class_decls
866
        ; let dm_binds = unionManyBags dm_binds_s
dterei's avatar
dterei committed
867

Ian Lynagh's avatar
Ian Lynagh committed
868
          -- (b) instance declarations
dterei's avatar
dterei committed
869 870 871
        ; let dm_ids = collectHsBindsBinders dm_binds
              -- Add the default method Ids (again)
              -- See Note [Default methods and instances]
872
        ; inst_binds_s <- tcExtendLetEnv TopLevel dm_ids $
873
                          mapM tcInstDecl2 inst_decls
Ian Lynagh's avatar
Ian Lynagh committed
874 875

          -- Done
876
        ; return (dm_binds `unionBags` unionManyBags inst_binds_s) }
877 878
\end{code}

879 880 881 882 883 884 885 886 887 888
See Note [Default methods and instances]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The default method Ids are already in the type environment (see Note
[Default method Ids and Template Haskell] in TcTyClsDcls), BUT they
don't have their InlinePragmas yet.  Usually that would not matter,
because the simplifier propagates information from binding site to
use.  But, unusually, when compiling instance decls we *copy* the
INLINE pragma from the default method to the method for that
particular operation (see Note [INLINE and default methods] below).

889
So right here in tcInstDecls2 we must re-extend the type envt with
890
the default method Ids replete with their INLINE pragmas.  Urk.
891

892
\begin{code}
893 894 895 896 897 898

tcInstDecl2 :: InstInfo Name -> TcM (LHsBinds Id)
            -- Returns a binding for the dfun
tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
  = recoverM (return emptyLHsBinds)             $
    setSrcSpan loc                              $
dterei's avatar
dterei committed
899
    addErrCtxt (instDeclCtxt2 (idType dfun_id)) $
900
    do {  -- Instantiate the instance decl with skolem constants
901
       ; (inst_tyvars, dfun_theta, inst_head) <- tcSkolDFunType (idType dfun_id)
dimitris's avatar
dimitris committed
902 903 904
                     -- We instantiate the dfun_id with superSkolems.
                     -- See Note [Subtle interaction of recursion and overlap]
                     -- and Note [Binding when looking up instances]
905
       ; let (clas, inst_tys) = tcSplitDFunHead inst_head
906
             (class_tyvars, sc_theta, _, op_items) = classBigSig clas
907
             sc_theta' = substTheta (zipOpenTvSubst class_tyvars inst_tys) sc_theta
908

909
       ; dfun_ev_vars <- newEvVars dfun_theta
910

911 912
       ; (sc_binds, sc_ev_vars, sc_dfun_args) 
            <- tcSuperClasses dfun_id inst_tyvars dfun_ev_vars sc_theta'
913 914 915

       -- Deal with 'SPECIALISE instance' pragmas
       -- See Note [SPECIALISE instance pragmas]
916
       ; spec_inst_info <- tcSpecInstPrags dfun_id ibinds
917 918

        -- Typecheck the methods
dterei's avatar
dterei committed
919
       ; (meth_ids, meth_binds)
920 921 922 923 924
           <- tcExtendTyVarEnv inst_tyvars $
                -- The inst_tyvars scope over the 'where' part
                -- Those tyvars are inside the dfun_id's type, which is a bit
                -- bizarre, but OK so long as you realise it!
              tcInstanceMethods dfun_id clas inst_tyvars dfun_ev_vars
925
                                inst_tys spec_inst_info
926
                                op_items ibinds
927

928
       -- Create the result bindings
batterseapower's avatar
batterseapower committed
929
       ; self_dict <- newDict clas inst_tys
930 931
       ; let class_tc      = classTyCon clas
             [dict_constr] = tyConDataCons class_tc
Simon Peyton Jones's avatar
Simon Peyton Jones committed
932 933
             dict_bind     = mkVarBind self_dict (L loc con_app_args)

934 935 936 937
                     -- We don't produce a binding for the dict_constr; instead we
                     -- rely on the simplifier to unfold this saturated application
                     -- We do this rather than generate an HsCon directly, because
                     -- it means that the special cases (e.g. dictionary with only one
dterei's avatar
dterei committed
938
                     -- member) are dealt with by the common MkId.mkDataConWrapId
dterei's avatar
dterei committed
939 940 941 942
                     -- code rather than needing to be repeated here.
                     --    con_app_tys  = MkD ty1 ty2
                     --    con_app_scs  = MkD ty1 ty2 sc1 sc2
                     --    con_app_args = MkD ty1 ty2 sc1 sc2 op1 op2
Simon Peyton Jones's avatar
Simon Peyton Jones committed
943 944
             con_app_tys  = wrapId (mkWpTyApps inst_tys)
                                   (dataConWrapId dict_constr)
945
             con_app_scs  = mkHsWrap (mkWpEvApps (map EvId sc_ev_vars)) con_app_tys
Simon Peyton Jones's avatar
Simon Peyton Jones committed
946 947 948 949 950 951
             con_app_args = foldl mk_app con_app_scs $
                            map (wrapId arg_wrapper) meth_ids

             mk_app :: HsExpr Id -> HsExpr Id -> HsExpr Id
             mk_app fun arg = HsApp (L loc fun) (L loc arg)

952
             inst_tv_tys = mkTyVarTys inst_tyvars
Simon Peyton Jones's avatar
Simon Peyton Jones committed
953
             arg_wrapper = mkWpEvVarApps dfun_ev_vars <.> mkWpTyApps inst_tv_tys
954

dterei's avatar
dterei committed
955 956 957
                -- Do not inline the dfun; instead give it a magic DFunFunfolding
                -- See Note [ClassOp/DFun selection]
                -- See also note [Single-method classes]
958 959 960 961
             dfun_id_w_fun
                | isNewTyCon class_tc
                = dfun_id `setInlinePragma` alwaysInlinePragma { inl_sat = Just 0 }
                | otherwise
Simon Peyton Jones's avatar
Simon Peyton Jones committed
962
                = dfun_id `setIdUnfolding`  mkDFunUnfolding dfun_ty dfun_args
963
                          `setInlinePragma` dfunInlinePragma
Simon Peyton Jones's avatar
Simon Peyton Jones committed
964

965 966
             dfun_args :: [DFunArg CoreExpr]
             dfun_args = sc_dfun_args ++ map (DFunPolyArg . Var) meth_ids
967

968
             export = ABE { abe_wrap = idHsWrapper, abe_poly = dfun_id_w_fun
<