diff options
| author | simonpj@microsoft.com <unknown> | 2006-09-25 12:13:51 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2006-09-25 12:13:51 +0000 |
| commit | 171d4582f4b9a8e0f11f8738079accbb22bafdcb (patch) | |
| tree | e9e9d42e1fa23dc65b560f7057309c481b57ed93 /compiler/deSugar/Check.lhs | |
| parent | 57610c7b3369dfc0fcf1ee311a1ed10cfe13f7d4 (diff) | |
| download | haskell-171d4582f4b9a8e0f11f8738079accbb22bafdcb.tar.gz | |
Fix newtype deriving properly (un-doing Audreys patch)
The newtype-deriving mechanism generates a HsSyn case expression looking
like this
case (d `cast` co) of { ... }
That is, the case expression scrutinises a dictionary. This is
otherwise never seen in HsSyn, and it made the desugarer
(Check.get_unused_cons) crash in tcTyConAppTyCon.
It would really be better to generate Core in TcInstDecls (the newtype
deriving part) but I'm not going to do that today. Instead, I made
Check.get_unused_cons a bit more robust.
Audrey tried to fix this over the weekend, but her fix was, alas, utterly
bogus, which caused mysterious failures later. I completely undid this
change.
Anyway it should work now!
Diffstat (limited to 'compiler/deSugar/Check.lhs')
| -rw-r--r-- | compiler/deSugar/Check.lhs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs index 7562083293..85b8f9ddd9 100644 --- a/compiler/deSugar/Check.lhs +++ b/compiler/deSugar/Check.lhs @@ -438,12 +438,12 @@ mb_neg (Just _) v = -v get_unused_cons :: [Pat Id] -> [DataCon] get_unused_cons used_cons = unused_cons where - (ConPatOut { pat_ty = ty }) = head used_cons - ty_con = tcTyConAppTyCon ty -- Newtype observable - all_cons = tyConDataCons ty_con - used_cons_as_id = map (\ (ConPatOut{ pat_con = L _ d}) -> d) used_cons - unused_cons = uniqSetToList - (mkUniqSet all_cons `minusUniqSet` mkUniqSet used_cons_as_id) + (ConPatOut { pat_con = l_con, pat_ty = ty }) = head used_cons + ty_con = dataConTyCon (unLoc l_con) -- Newtype observable + all_cons = tyConDataCons ty_con + used_cons_as_id = map (\ (ConPatOut{ pat_con = L _ d}) -> d) used_cons + unused_cons = uniqSetToList + (mkUniqSet all_cons `minusUniqSet` mkUniqSet used_cons_as_id) all_vars :: [Pat Id] -> Bool all_vars [] = True |