From 1ca40c2037a0e973dd73d98cd20313ecdbfeb6fc Mon Sep 17 00:00:00 2001
From: "simonpj@microsoft.com" <unknown>
Date: Fri, 20 Apr 2007 21:10:23 +0000
Subject: [PATCH] Fix the GHC.Base.inline builtin rule

The BuiltIn rule for GHC.Base.inline wasn't working for two reasons:

 a) inlineIdName wasn't in basicKnownKeyNames
 b) The rule function wasn't taking into account the type argument

Thanks to Brian Alliet for spotting this bug.
---
 compiler/prelude/PrelNames.lhs |    2 +-
 compiler/prelude/PrelRules.lhs |   22 +++++++++++++++++-----
 compiler/specialise/Rules.lhs  |   17 +++++++++++++++++
 3 files changed, 35 insertions(+), 6 deletions(-)

diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 8d571b6..de6e5be 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -188,7 +188,7 @@ basicKnownKeyNames
 	wordTyConName, word8TyConName, word16TyConName, word32TyConName, word64TyConName,
 
 	-- Others
-	otherwiseIdName, 
+	otherwiseIdName, inlineIdName,
 	plusIntegerName, timesIntegerName,
 	eqStringName, assertName, breakpointName, breakpointCondName,
         breakpointAutoName,  opaqueTyConName, unknownTyConName, 
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 747817b..69901d3 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -451,9 +451,12 @@ dataToTagRule other = Nothing
 builtinRules :: [CoreRule]
 -- Rules for non-primops that can't be expressed using a RULE pragma
 builtinRules
-  = [ BuiltinRule FSLIT("AppendLitString") unpackCStringFoldrName 4 match_append_lit,
-      BuiltinRule FSLIT("EqString") eqStringName 2 match_eq_string,
-      BuiltinRule FSLIT("Inline") inlineIdName 1 match_inline
+  = [ BuiltinRule { ru_name = FSLIT("AppendLitString"), ru_fn = unpackCStringFoldrName,
+		    ru_nargs = 4, ru_try = match_append_lit },
+      BuiltinRule { ru_name = FSLIT("EqString"), ru_fn = eqStringName,
+		    ru_nargs = 2, ru_try = match_eq_string },
+      BuiltinRule { ru_name = FSLIT("Inline"), ru_fn = inlineIdName,
+		    ru_nargs = 2, ru_try = match_inline }
     ]
 
 
@@ -494,9 +497,18 @@ match_eq_string other = Nothing
 
 ---------------------------------------------------
 -- The rule is this:
---	inline (f a b c) = <f's unfolding> a b c
+--	inline f_ty (f a b c) = <f's unfolding> a b c
 -- (if f has an unfolding)
-match_inline (e:_)
+--
+-- It's important to allow the argument to 'inline' to have args itself
+-- (a) because its more forgiving to allow the programmer to write
+--	 inline f a b c
+--   or  inline (f a b c)
+-- (b) because a polymorphic f wll get a type argument that the 
+--     programmer can't avoid
+--
+-- Also, don't forget about 'inline's type argument!
+match_inline (Type _ : e : _)
   | (Var f, args1) <- collectArgs e,
     Just unf <- maybeUnfoldingTemplate (idUnfolding f)
   = Just (mkApps unf args1)
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs
index 92d3fbc..758d60d 100644
--- a/compiler/specialise/Rules.lhs
+++ b/compiler/specialise/Rules.lhs
@@ -195,10 +195,27 @@ pprRuleBase rules = vcat [ pprRules (tidyRules emptyTidyEnv rs)
 %*									*
 %************************************************************************
 
+Note [Extra args in rule matching]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+If we find a matching rule, we return (Just (rule, rhs)), 
+but the rule firing has only consumed as many of the input args
+as the ruleArity says.  It's up to the caller to keep track
+of any left-over args.  E.g. if you call
+	lookupRule ... f [e1, e2, e3]
+and it returns Just (r, rhs), where r has ruleArity 2
+then the real rewrite is
+	f e1 e2 e3 ==> rhs e3
+
+You might think it'd be cleaner for lookupRule to deal with the
+leftover arguments, by applying 'rhs' to them, but the main call
+in the Simplifier works better as it is.  Reason: the 'args' passed
+to lookupRule are the result of a lazy substitution
+
 \begin{code}
 lookupRule :: (Activation -> Bool) -> InScopeSet
 	   -> RuleBase	-- Imported rules
 	   -> Id -> [CoreExpr] -> Maybe (CoreRule, CoreExpr)
+-- See Note [Extra argsin rule matching]
 lookupRule is_active in_scope rule_base fn args
   = matchRules is_active in_scope fn args rules
   where
-- 
1.7.10.4