Comments and debug output

[ghc-hetmet.git] / compiler / specialise / SpecConstr.lhs

diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs
index 92e4131..b5ae45f 100644 (file)
--- 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