X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcInstDcls.lhs;h=d7aafc1f11736bbebd7ba500aedcd84538254277;hb=b9235325e1dfc23cc489aa478aef852e76c4075f;hp=d4100d00243abdf1ec7c7d008da70d9d004220aa;hpb=193627349898ca7d7b44a3b583d895f23851b038;p=ghc-hetmet.git

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index d4100d0..d7aafc1 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -197,14 +197,15 @@ a top-level axiom:
 
    df :: forall a. C a => C [a]
    {-# NOINLINE df   DFun[ $cop_list ] #-}
-   df = /\a. \d. MkD ($cop_list a d)
+   df = /\a. \d. MkC ($cop_list a d)
 
-   $cop_list :: forall a. C a => a -> a
+   $cop_list :: forall a. C a => [a] -> [a]
    $cop_list = <blah>
 
-The "constructor" MkD expands to a cast, as does the class-op selector.
+The "constructor" MkC expands to a cast, as does the class-op selector.
 The RULE works just like for multi-field dictionaries:
-  * (df a d) returns (Just (MkD,..,[$cop_list a d])) 
+
+  * (df a d) returns (Just (MkC,..,[$cop_list a d])) 
     to exprIsConApp_Maybe
 
   * The RULE for op picks the right result
@@ -214,18 +215,25 @@ application.  But it works just fine in this case, exprIsConApp_maybe
 is otherwise used only when we hit a case expression which will have
 a real data constructor in it.
 
-The biggest reason for doing it this way, apart form uniformity, is
+The biggest reason for doing it this way, apart from uniformity, is
 that we want to be very careful when we have
     instance C a => C [a] where
       {-# INLINE op #-}
       op = ...
-then we'll get an INLINE pragma on $cop_list.  The danger is that
-we'll get something like
-      foo = /\a.\d. $cop_list a d
+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
+dictionary and the list argument
+
+The danger is that we'll get something like
+      op_list :: C a => [a] -> [a]
+      op_list = /\a.\d. $cop_list a d
 and then we'll eta expand, and then we'll inline TOO EARLY. This happened in 
-Trac #3772 and I spent far too long fiddling arond trying to fix it.
+Trac #3772 and I spent far too long fiddling around trying to fix it.
 Look at the test for Trac #3772.
 
+     (Note: re-reading the above, I can't see how using the
+            uniform story solves the problem.)
+
 Note [Subtle interaction of recursion and overlap]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider this
@@ -531,13 +539,17 @@ tcInstDecls2 tycl_decls inst_decls
   = do  { -- (a) Default methods from class decls
           let class_decls = filter (isClassDecl . unLoc) tycl_decls
         ; dm_binds_s <- mapM tcClassDecl2 class_decls
+        ; let dm_binds = unionManyBags dm_binds_s
                                     
           -- (b) instance declarations
-        ; inst_binds_s <- mapM tcInstDecl2 inst_decls
+	; let dm_ids = collectHsBindsBinders dm_binds
+	      -- Add the default method Ids (again)
+	      -- See Note [Default methods and instances]
+        ; inst_binds_s <- tcExtendIdEnv dm_ids $
+                          mapM tcInstDecl2 inst_decls
 
           -- Done
-        ; return (unionManyBags dm_binds_s `unionBags`
-                  unionManyBags inst_binds_s) }
+        ; return (dm_binds `unionBags` unionManyBags inst_binds_s) }
 
 tcInstDecl2 :: InstInfo Name -> TcM (LHsBinds Id)
 tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
@@ -550,6 +562,18 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
     loc     = getSrcSpan dfun_id
 \end{code}
 
+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).
+
+So right here in tcInstDecl2 we must re-extend the type envt with
+the default method Ids replete with their INLINE pragmas.  Urk.
 
 \begin{code}
 tc_inst_decl2 :: Id -> InstBindings Name -> TcM (LHsBinds Id)