Flip direction of newtype coercions, fix some comments
[ghc-hetmet.git] / compiler / typecheck / TcDeriv.lhs
index 46e702c..2563b09 100644 (file)
@@ -42,7 +42,7 @@ import NameSet                ( duDefs )
 import Type            ( splitKindFunTys )
 import TyCon           ( tyConTyVars, tyConDataCons, tyConArity, tyConHasGenerics,
                          tyConStupidTheta, isProductTyCon, isDataTyCon, newTyConRhs,
-                         isEnumerationTyCon, isRecursiveTyCon, TyCon
+                         isEnumerationTyCon, isRecursiveTyCon, TyCon, isNewTyCon
                        )
 import TcType          ( TcType, ThetaType, mkTyVarTys, mkTyConApp, tcTyConAppTyCon,
                          isUnLiftedType, mkClassPred, tyVarsOfType,
@@ -313,6 +313,29 @@ or} has just one data constructor (e.g., tuples).
 [See Appendix~E in the Haskell~1.2 report.] This code here deals w/
 all those.
 
+Note [Newtype deriving superclasses]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The 'tys' here come from the partial application
+in the deriving clause. The last arg is the new
+instance type.
+
+We must pass the superclasses; the newtype might be an instance
+of them in a different way than the representation type
+E.g.           newtype Foo a = Foo a deriving( Show, Num, Eq )
+Then the Show instance is not done via isomorphism; it shows
+       Foo 3 as "Foo 3"
+The Num instance is derived via isomorphism, but the Show superclass
+dictionary must the Show instance for Foo, *not* the Show dictionary
+gotten from the Num dictionary. So we must build a whole new dictionary
+not just use the Num one.  The instance we want is something like:
+     instance (Num a, Show (Foo a), Eq (Foo a)) => Num (Foo a) where
+       (+) = ((+)@a)
+       ...etc...
+There may be a coercion needed which we get from the tycon for the newtype
+when the dict is constructed in TcInstDcls.tcInstDecl2
+
+
 \begin{code}
 makeDerivEqns :: OverlapFlag
              -> [LTyClDecl Name] 
@@ -367,7 +390,7 @@ makeDerivEqns overlap_flag tycl_decls
           traceTc (text "newtype deriving:" <+> ppr tycon <+> ppr rep_tys)     `thenM_`
                   new_dfun_name clas tycon             `thenM` \ dfun_name ->
           returnM (Nothing, Just (InstInfo { iSpec  = mk_inst_spec dfun_name,
-                                             iBinds = NewTypeDerived rep_tys }))
+                                             iBinds = NewTypeDerived tycon rep_tys }))
       | std_class gla_exts clas
       = mk_eqn_help gla_exts DataType tycon deriv_tvs clas tys -- Go via bale-out route
 
@@ -429,26 +452,11 @@ makeDerivEqns overlap_flag tycl_decls
        rep_pred = mkClassPred clas rep_tys
                -- rep_pred is the representation dictionary, from where
                -- we are gong to get all the methods for the newtype dictionary
+        -- here we are figuring out what superclass dictionaries to use
+        -- see Note [Newtype deriving superclasses] above
 
        inst_tys = (tys ++ [mkTyConApp tycon (mkTyVarTys tyvars_to_keep)])
-               -- The 'tys' here come from the partial application
-               -- in the deriving clause. The last arg is the new
-               -- instance type.
-
-               -- We must pass the superclasses; the newtype might be an instance
-               -- of them in a different way than the representation type
-               -- E.g.         newtype Foo a = Foo a deriving( Show, Num, Eq )
-               -- Then the Show instance is not done via isomorphism; it shows
-               --      Foo 3 as "Foo 3"
-               -- The Num instance is derived via isomorphism, but the Show superclass
-               -- dictionary must the Show instance for Foo, *not* the Show dictionary
-               -- gotten from the Num dictionary. So we must build a whole new dictionary
-               -- not just use the Num one.  The instance we want is something like:
-               --      instance (Num a, Show (Foo a), Eq (Foo a)) => Num (Foo a) where
-               --              (+) = ((+)@a)
-               --              ...etc...
-               -- There's no 'corece' needed because after the type checker newtypes
-               -- are transparent.
+
 
        sc_theta = substTheta (zipOpenTvSubst clas_tyvars inst_tys)
                              (classSCTheta clas)
@@ -456,7 +464,7 @@ makeDerivEqns overlap_flag tycl_decls
                -- If there are no tyvars, there's no need
                -- to abstract over the dictionaries we need
        dict_tvs = deriv_tvs ++ tc_tvs
-       dict_args | null dict_tvs = []
+       dict_args -- | null dict_tvs = []
                  | otherwise     = rep_pred : sc_theta
 
                -- Finally! Here's where we build the dictionary Id