[project @ 2000-08-29 16:56:26 by simonpj]
authorsimonpj <unknown>
Tue, 29 Aug 2000 16:56:26 +0000 (16:56 +0000)
committersimonpj <unknown>
Tue, 29 Aug 2000 16:56:26 +0000 (16:56 +0000)
Fix a bug reported by Jose Emilio Labra Gayo

newtype Foo a => T = MkT (out :: a)

The selector 'out' was being given an incorrect RHS.
(Core Lint spotted it.)

ghc/compiler/basicTypes/MkId.lhs

index e18985c..0bb7540 100644 (file)
@@ -422,15 +422,12 @@ mkRecordSelId tycon field_label unpack_id unpackUtf8_id
     default_alt | all isJust alts = [] -- No default needed
                | otherwise       = [(DEFAULT, [], error_expr)]
 
-    sel_rhs | isNewTyCon tycon = new_sel_rhs
-           | otherwise        = data_sel_rhs
+    sel_rhs = mkLams tyvars $ mkLams field_tyvars $ 
+             mkLams dict_ids $ Lam data_id $
+             sel_body
 
-    data_sel_rhs = mkLams tyvars $ mkLams field_tyvars $ 
-                  mkLams dict_ids $ Lam data_id $
-                  Case (Var data_id) data_id (the_alts ++ default_alt)
-
-    new_sel_rhs  = mkLams tyvars $ mkLams field_tyvars $ Lam data_id $
-                   Note (Coerce (unUsgTy field_tau) (unUsgTy data_ty)) (Var data_id)
+    sel_body | isNewTyCon tycon = Note (Coerce (unUsgTy field_tau) (unUsgTy data_ty)) (Var data_id)
+            | otherwise        = Case (Var data_id) data_id (the_alts ++ default_alt)
 
     mk_maybe_alt data_con 
          = case maybe_the_arg_id of