[project @ 2000-07-17 11:15:07 by simonmar]

[ghc-hetmet.git] / ghc / compiler / basicTypes / MkId.lhs

diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 2643dff..3504caa 100644 (file)
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -47,7 +47,6 @@ import Type           ( Type, ClassContext, mkDictTy, mkDictTys, mkTyConApp, mkTyVarTys,
                          splitFunTys, splitForAllTys, unUsgTy,
                          mkUsgTy, UsageAnn(..)
                        )
-import PprType         ( pprParendType )
 import Module          ( Module )
 import CoreUtils       ( exprType, mkInlineMe )
 import CoreUnfold      ( mkTopUnfolding, mkCompulsoryUnfolding, mkOtherCon )
@@ -89,12 +88,10 @@ import FieldLabel   ( FieldLabel, FieldLabelTag, mkFieldLabel, fieldLabelName,
                        )
 import CoreSyn
 import Maybes
-import BasicTypes      ( Arity )
 import Unique
 import Maybe            ( isJust )
 import Outputable
 import Util            ( assoc )
-import List            ( nub )
 \end{code}             
 
 
@@ -324,8 +321,8 @@ mkDataConWrapId data_con
                MarkedUnboxed con tys ->
                   Case (Var arg) arg [(DataAlt con, con_args,
                                        body i' (reverse con_args++rep_args))]
-                  where n_tys = length tys
-                        (con_args,i') = mkLocals i tys
+                  where 
+                       (con_args,i') = mkLocals i tys
 \end{code}
 
 
@@ -384,7 +381,6 @@ mkRecordSelId tycon field_label unpack_id
     sel_id     = mkId (fieldLabelName field_label) selector_ty info
 
     field_ty   = fieldLabelType field_label
-    field_name = fieldLabelName field_label
     data_cons  = tyConDataCons tycon
     tyvars     = tyConTyVars tycon     -- These scope over the types in 
                                        -- the FieldLabels of constructors of this type
@@ -576,15 +572,15 @@ mkDictFunId :: Name               -- Name to use for the dict fun;
 mkDictFunId dfun_name clas inst_tyvars inst_tys inst_decl_theta
   = mkVanillaId dfun_name dfun_ty
   where
-    (class_tyvars, sc_theta, _, _) = classBigSig clas
-    sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
-
     dfun_theta = classesToPreds inst_decl_theta
 
 {-  1 dec 99: disable the Mark Jones optimisation for the sake
     of compatibility with Hugs.
     See `types/InstEnv' for a discussion related to this.
 
+    (class_tyvars, sc_theta, _, _) = classBigSig clas
+    not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
+    sc_theta' = substClasses (mkTopTyVarSubst class_tyvars inst_tys) sc_theta
     dfun_theta = case inst_decl_theta of
                   []    -> []  -- If inst_decl_theta is empty, then we don't
                                -- want to have any dict arguments, so that we can
@@ -606,8 +602,6 @@ mkDictFunId dfun_name clas inst_tyvars inst_tys inst_decl_theta
                                -- Now sc_theta' has Foo T
 -}
     dfun_ty = mkSigmaTy inst_tyvars dfun_theta (mkDictTy clas inst_tys)
-
-    not_const (clas, tys) = not (isEmptyVarSet (tyVarsOfTypes tys))
 \end{code}