From e0955d957e76edcbfaf22e24a86027cfe9a0f8e2 Mon Sep 17 00:00:00 2001
From: simonm <unknown>
Date: Tue, 27 Apr 1999 15:20:22 +0000
Subject: [PATCH] [project @ 1999-04-27 15:20:20 by simonm] deriving fixes.

---
 ghc/compiler/typecheck/TcDeriv.lhs    |   24 +++++++++++++++++++-----
 ghc/compiler/typecheck/TcGenDeriv.lhs |    6 ++++--
 2 files changed, 23 insertions(+), 7 deletions(-)

diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index c0f1c90..9e9a79a 100644
--- 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
--- 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) 
-- 
1.7.10.4