[project @ 2001-02-26 15:06:57 by simonmar]

[ghc-hetmet.git] / ghc / compiler / typecheck / TcDeriv.lhs

diff --git a/ghc/compiler/typecheck/TcDeriv.lhs b/ghc/compiler/typecheck/TcDeriv.lhs
index e068f8a..103af50 100644 (file)
--- a/ghc/compiler/typecheck/TcDeriv.lhs
+++ b/ghc/compiler/typecheck/TcDeriv.lhs
@@ -17,7 +17,7 @@ import RnHsSyn                ( RenamedHsBinds, RenamedMonoBinds, RenamedTyClDecl )
 import CmdLineOpts     ( DynFlag(..), DynFlags )
 
 import TcMonad
-import TcEnv           ( TcEnv, tcSetInstEnv, newDFunName, InstInfo(..), pprInstInfo,
+import TcEnv           ( tcSetInstEnv, newDFunName, InstInfo(..), pprInstInfo,
                          tcLookupClass, tcLookupTyCon
                        )
 import TcGenDeriv      -- Deriv stuff
@@ -26,8 +26,7 @@ import TcSimplify     ( tcSimplifyThetas )
 
 import RnBinds         ( rnMethodBinds, rnTopMonoBinds )
 import RnEnv           ( bindLocatedLocalsRn )
-import RnMonad         ( --RnNameSupply, 
-                         renameSourceCode, thenRn, mapRn, returnRn )
+import RnMonad         ( renameDerivedCode, thenRn, mapRn, returnRn )
 import HscTypes                ( DFunId, PersistentRenamerState )
 
 import BasicTypes      ( Fixity )
@@ -45,7 +44,8 @@ import TyCon          ( tyConTyVars, tyConDataCons,
                          tyConTheta, maybeTyConSingleCon, isDataTyCon,
                          isEnumerationTyCon, TyCon
                        )
-import Type            ( TauType, PredType(..), mkTyVarTys, mkTyConApp, isUnboxedType )
+import Type            ( TauType, PredType(..), mkTyVarTys, mkTyConApp, 
+                         isUnLiftedType )
 import Var             ( TyVar )
 import PrelNames
 import Util            ( zipWithEqual, sortLt )
@@ -194,7 +194,7 @@ tcDeriving prs mod inst_env_in get_fixity tycl_decls
 
        -- Fish the "deriving"-related information out of the TcEnv
        -- and make the necessary "equations".
-    makeDerivEqns mod tycl_decls               `thenTc` \ eqns ->
+    makeDerivEqns tycl_decls           `thenTc` \ eqns ->
     if null eqns then
        returnTc ([], EmptyBinds)
     else
@@ -224,7 +224,7 @@ tcDeriving prs mod inst_env_in get_fixity tycl_decls
        -- The only tricky bit is that the extra_binds must scope over the
        -- method bindings for the instances.
        (rn_method_binds_s, rn_extra_binds)
-               = renameSourceCode dflags mod prs (
+               = renameDerivedCode dflags mod prs (
                        bindLocatedLocalsRn (ptext (SLIT("deriving"))) mbinders $ \ _ ->
                        rnTopMonoBinds extra_mbinds []          `thenRn` \ (rn_extra_binds, _) ->
                        mapRn rn_meths method_binds_s           `thenRn` \ rn_method_binds_s ->
@@ -247,7 +247,7 @@ tcDeriving prs mod inst_env_in get_fixity tycl_decls
        -- Make a Real dfun instead of the dummy one we have so far
     gen_inst_info :: DFunId -> RenamedMonoBinds -> InstInfo
     gen_inst_info dfun binds
-      = InstInfo { iLocal = True,  iDFunId = dfun, 
+      = InstInfo { iDFunId = dfun, 
                   iBinds = binds, iPrags = [] }
 
     rn_meths meths = rnMethodBinds [] meths `thenRn` \ (meths', _) -> returnRn meths'
@@ -277,9 +277,9 @@ or} has just one data constructor (e.g., tuples).
 all those.
 
 \begin{code}
-makeDerivEqns :: Module -> [RenamedTyClDecl] -> TcM [DerivEqn]
+makeDerivEqns :: [RenamedTyClDecl] -> TcM [DerivEqn]
 
-makeDerivEqns this_mod tycl_decls
+makeDerivEqns tycl_decls
   = mapTc mk_eqn derive_these          `thenTc` \ maybe_eqns ->
     returnTc (catMaybes maybe_eqns)
   where
@@ -288,7 +288,7 @@ makeDerivEqns this_mod tycl_decls
        -- Find the (Class,TyCon) pairs that must be `derived'
        -- NB: only source-language decls have deriving, no imported ones do
     derive_these = [ (clas,tycon) 
-                  | TyData _ _ tycon _ _ _ (Just classes) _ _ _ <- tycl_decls,
+                  | TyData {tcdName = tycon, tcdDerivs = Just classes} <- tycl_decls,
                     clas <- nub classes ]
 
     ------------------------------------------------------------------
@@ -318,13 +318,13 @@ makeDerivEqns this_mod tycl_decls
            mk_constraints data_con
               = [ (clas, [arg_ty])
                 | arg_ty <- dataConArgTys data_con tyvar_tys,
-                  not (isUnboxedType arg_ty)   -- No constraints for unboxed types?
+                  not (isUnLiftedType arg_ty)  -- No constraints for unlifted types?
                 ]
        in
        case chk_out clas tycon of
           Just err ->  addErrTc err                            `thenNF_Tc_` 
                        returnNF_Tc Nothing
-          Nothing  ->  newDFunName this_mod clas [ty] locn `thenNF_Tc` \ dfun_name ->
+          Nothing  ->  newDFunName clas [ty] locn `thenNF_Tc` \ dfun_name ->
                        returnNF_Tc (Just (dfun_name, clas, tycon, tyvars, constraints))
 
 
@@ -538,7 +538,7 @@ data Foo ... = ...
 
 con2tag_Foo :: Foo ... -> Int#
 tag2con_Foo :: Int -> Foo ...  -- easier if Int, not Int#
-maxtag_Foo  :: Int             -- ditto (NB: not unboxed)
+maxtag_Foo  :: Int             -- ditto (NB: not unlifted)
 
 
 We have a @con2tag@ function for a tycon if: