X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fspecialise%2FSpecConstr.lhs;h=b5ae45f0137d2a62c27d5472a8ab934af5b9ba18;hb=8d4bb83f1c3c6abb12e3ae1204034149349f047d;hp=92e4131c95f58ccb16f56cbf18390082f49639d2;hpb=b20a90d8b487a14439e2567f44d27fde5430ac97;p=ghc-hetmet.git

diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 92e4131..b5ae45f 100644
--- a/compiler/specialise/SpecConstr.lhs
+++ b/compiler/specialise/SpecConstr.lhs
@@ -783,8 +783,13 @@ specialise env calls (fn, rhs, arg_occs)
 	; let good_pats :: [([Var], [CoreArg])]
 	      good_pats = catMaybes mb_pats
 	      in_scope = mkInScopeSet $ unionVarSets $
-			 [ exprsFreeVars pats `delVarSetList` vs 
+			 [ exprsFreeVars pats
 			 | (vs,pats) <- good_pats ]
+		-- This in-scope set is used when matching to see if
+		-- we have identical patterns.  We want to treat the
+		-- forall'd variables of each pattern as "in scope",
+		-- because each in turn serves as the match target for
+		-- a matchN call.  So don't remove the 'vs' from the free vars!
 	      uniq_pats = nubBy (same_pat in_scope) good_pats
 --	; pprTrace "specialise" (vcat [ppr fn <+> ppr arg_occs,
 --	  				text "calls" <+> ppr all_calls,
@@ -802,8 +807,8 @@ specialise env calls (fn, rhs, arg_occs)
   where
 	-- Two pats are the same if they match both ways
     same_pat in_scope (vs1,as1)(vs2,as2)
-	 =  isJust (matchN in_scope vs1 as1 as2)
- 	 && isJust (matchN in_scope vs2 as2 as1)
+	=  isJust (matchN in_scope vs1 as1 as2)
+	&& isJust (matchN in_scope vs2 as2 as1)
 
 callToPats :: InScopeEnv -> [ArgOcc] -> Call
 	   -> UniqSM (Maybe ([Var], [CoreExpr]))
@@ -925,6 +930,15 @@ argToPat :: InScopeEnv			-- What's in scope at the fn defn site
 argToPat in_scope con_env arg@(Type ty) arg_occ
   = return (False, arg)
 
+argToPat in_scope con_env (Note n arg) arg_occ
+  = argToPat in_scope con_env arg arg_occ
+	-- Note [Notes in call patterns]
+	-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+	-- Ignore Notes.  In particular, we want to ignore any InlineMe notes
+	-- Perhaps we should not ignore profiling notes, but I'm going to
+	-- ride roughshod over them all for now.
+	--- See Note [Notes in RULE matching] in Rules
+
 argToPat in_scope con_env (Let _ arg) arg_occ
   = argToPat in_scope con_env arg arg_occ
 	-- Look through let expressions
@@ -972,12 +986,18 @@ argToPat in_scope con_env (Var v) arg_occ
     isValueUnfolding (idUnfolding v)			-- (b)
   = return (True, Var v)
 
+{-	I'm really not sure what this comment means
+	And by not wild-carding we tend to get forall'd 
+	variables that are in soope, which in turn can
+	expose the weakness in let-matching
+	See Note [Matching lets] in Rules
   -- Check for a variable bound inside the function. 
   -- Don't make a wild-card, because we may usefully share
   --	e.g.  f a = let x = ... in f (x,x)
   -- NB: this case follows the lambda and con-app cases!!
 argToPat in_scope con_env (Var v) arg_occ
   = return (False, Var v)
+-}
 
   -- The default case: make a wild-card
 argToPat in_scope con_env arg arg_occ