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 c0f1c905314d..9e9a79af8a76 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 ->
@@ -539,6 +539,10 @@ these is around is given by @hasCon2TagFun@.
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
@@ -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 39db2b4cc4b8..e017cf2add05 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)
--
GitLab