From 06fa575f4b4c51ab48fc4e7f5bd512b8c30325f9 Mon Sep 17 00:00:00 2001 From: simonpj Date: Thu, 7 Nov 2002 11:42:48 +0000 Subject: [PATCH] [project @ 2002-11-07 11:42:48 by simonpj] ------------------ Fix an obscure bug in implicit parameters, interacting with lazy pattern matching ------------------ MERGE TO STABLE BRANCH The problem was this: data UniqueSupply = US Integer newUnique :: (?uniqueSupply :: UniqueSupply) => Integer newUnique = r where US r = ?uniqueSupply The lazy pattern match in the where clause killed GHC 5.04 because the SourceType {?uniqueSupply::UniqueSupply} of the RHS of the 'where' didn't look like a UniqueSupply. The fix is simple: in DsUtils.mkSelectorBinds, use the pattern, not the rhs, to get the type reqd. More efficient too. Test is typecheck/should_compile/tc164.hs --- ghc/compiler/deSugar/DsUtils.lhs | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/ghc/compiler/deSugar/DsUtils.lhs b/ghc/compiler/deSugar/DsUtils.lhs index 790097c..3411ebf 100644 --- a/ghc/compiler/deSugar/DsUtils.lhs +++ b/ghc/compiler/deSugar/DsUtils.lhs @@ -498,7 +498,25 @@ mkSelectorBinds (VarPat v) val_expr mkSelectorBinds pat val_expr | isSingleton binders || is_simple_pat pat - = newSysLocalDs (exprType val_expr) `thenDs` \ val_var -> + = -- Given p = e, where p binds x,y + -- we are going to make + -- v = p (where v is fresh) + -- x = case v of p -> x + -- y = case v of p -> x + + -- Make up 'v' + -- NB: give it the type of *pattern* p, not the type of the *rhs* e. + -- This does not matter after desugaring, but there's a subtle + -- issue with implicit parameters. Consider + -- (x,y) = ?i + -- Then, ?i is given type {?i :: Int}, a SourceType, which is opaque + -- to the desugarer. (Why opaque? Because newtypes have to be. Why + -- does it get that type? So that when we abstract over it we get the + -- right top-level type (?i::Int) => ...) + -- + -- So to get the type of 'v', use the pattern not the rhs. Often more + -- efficient too. + newSysLocalDs (hsPatType pat) `thenDs` \ val_var -> -- For the error message we make one error-app, to avoid duplication. -- But we need it at different types... so we use coerce for that -- 1.7.10.4