[project @ 1999-04-27 15:20:20 by simonm]

deriving fixes.

diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index c0f1c90..9e9a79a 100644 (file)
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -211,7 +211,7 @@ tcDeriving modname fixs rn_name_supply inst_decl_infos_in
        -- Now augment the InstInfos, adding in the rather boring
        -- actual-code-to-do-the-methods binds.  We may also need to
        -- generate extra not-one-inst-decl-specific binds, notably
-       -- the "con2tag" function.  We do these
+       -- "con2tag" and/or "tag2con" functions.  We do these
        -- separately.
 
     gen_taggery_Names new_inst_infos           `thenTc` \ nm_alist_etc ->
@@ -540,6 +540,10 @@ The examples under the different sections below will make this
 clearer.
 
 \item
+Much less often (really just for deriving @Ix@), we use a
+@_tag2con_<tycon>@ function.  See the examples.
+
+\item
 We use the renamer!!!  Reason: we're supposed to be
 producing @RenamedMonoBinds@ for the methods, but that means
 producing correctly-uniquified code on the fly.  This is entirely
@@ -601,7 +605,7 @@ gen_inst_info modname
 
 %************************************************************************
 %*                                                                     *
-\subsection[TcDeriv-taggery-Names]{What con2tag functions are available?}
+\subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}
 %*                                                                     *
 %************************************************************************
 
@@ -609,6 +613,7 @@ gen_inst_info modname
 data Foo ... = ...
 
 con2tag_Foo :: Foo ... -> Int#
+tag2con_Foo :: Int -> Foo ...  -- easier if Int, not Int#
 maxtag_Foo  :: Int             -- ditto (NB: not unboxed)
 
 
@@ -622,6 +627,14 @@ Or: we're deriving @Ord@ (unless single-constructor), @Enum@, @Ix@
 (enum type only????)
 \end{itemize}
 
+We have a @tag2con@ function for a tycon if:
+\begin{itemize}
+\item
+We're deriving @Enum@, or @Ix@ (enum type only???)
+\end{itemize}
+
+If we have a @tag2con@ function, we also generate a @maxtag@ constant.
+
 \begin{code}
 gen_taggery_Names :: [InstInfo]
                  -> TcM s [(RdrName,   -- for an assoc list
@@ -631,7 +644,7 @@ gen_taggery_Names :: [InstInfo]
 gen_taggery_Names inst_infos
   = --pprTrace "gen_taggery:\n" (vcat [hsep [ppr c, ppr t] | (c,t) <- all_CTs]) $
     foldlTc do_con2tag []           tycons_of_interest `thenTc` \ names_so_far ->
-    foldlTc do_maxtag names_so_far tycons_of_interest
+    foldlTc do_tag2con names_so_far tycons_of_interest
   where
     all_CTs = [ (c, get_tycon ty) | (InstInfo c _ [ty] _ _ _ _ _) <- inst_infos ]
                    
@@ -654,11 +667,12 @@ gen_taggery_Names inst_infos
       | otherwise
       = returnTc acc_Names
 
-    do_maxtag acc_Names tycon
+    do_tag2con acc_Names tycon
       | isDataTyCon tycon &&
          (we_are_deriving enumClassKey tycon ||
          we_are_deriving ixClassKey   tycon)
-      = returnTc ( (maxtag_RDR  tycon, tycon, GenMaxTag)
+      = returnTc ( (tag2con_RDR tycon, tycon, GenTag2Con)
+                : (maxtag_RDR  tycon, tycon, GenMaxTag)
                 : acc_Names)
       | otherwise
       = returnTc acc_Names

diff --git a/ghc/compiler/typecheck/TcGenDeriv.lhs b/ghc/compiler/typecheck/TcGenDeriv.lhs
index 39db2b4..e017cf2 100644 (file)
--- a/ghc/compiler/typecheck/TcGenDeriv.lhs
+++ b/ghc/compiler/typecheck/TcGenDeriv.lhs
@@ -28,7 +28,7 @@ module TcGenDeriv (
 
 import HsSyn           ( InPat(..), HsExpr(..), MonoBinds(..),
                          Match(..), GRHSs(..), Stmt(..), HsLit(..),
-                         HsBinds(..), StmtCtxt(..),
+                         HsBinds(..), StmtCtxt(..), HsType(..),
                          unguardedRHS, mkSimpleMatch
                        )
 import RdrHsSyn                ( mkOpApp, RdrNameMonoBinds, RdrNameHsExpr, RdrNamePat )
@@ -1083,7 +1083,9 @@ gen_tag_n_con_monobind (rdr_name, tycon, GenCon2Tag)
 
 gen_tag_n_con_monobind (rdr_name, tycon, GenTag2Con)
   = mk_FunMonoBind (getSrcLoc tycon) rdr_name 
-       ([([VarPatIn a_RDR], HsApp tagToEnum_Expr a_Expr)])
+       [([ConPatIn mkInt_RDR [VarPatIn a_RDR]], 
+          ExprWithTySig (HsApp tagToEnum_Expr a_Expr) 
+                        (MonoTyVar (qual_orig_name tycon)))]
 
 gen_tag_n_con_monobind (rdr_name, tycon, GenMaxTag)
   = mk_easy_FunMonoBind (getSrcLoc tycon)