From f1e626d0add71aa523457c55c28c8e53d77e5a58 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Tue, 29 Aug 2000 16:56:26 +0000
Subject: [PATCH] [project @ 2000-08-29 16:56:26 by simonpj] 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 | 13 +++++--------
1 file changed, 5 insertions(+), 8 deletions(-)
diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index e18985c45e6d..0bb7540f570f 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -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
--
GitLab