X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprelude%2FPrelRules.lhs;h=cb77b633a560aa3dca518a97fe800e278fe65694;hp=747817b248b6649767bcb9a7675bbbe8fec5c226;hb=ad94d40948668032189ad22a0ad741ac1f645f50;hpb=317fc69d18eda68fd65f5ba634feafbe4a3923da

diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 747817b..cb77b63 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -15,6 +15,13 @@ ToDo:
 
 {-# OPTIONS -optc-DNON_POSIX_SOURCE #-}
 
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
+-- for details
+
 module PrelRules ( primOpRules, builtinRules ) where
 
 #include "HsVersions.h"
@@ -28,7 +35,7 @@ import Literal		( Literal(..), mkMachInt, mkMachWord
 			, narrow8WordLit, narrow16WordLit, narrow32WordLit
 			, char2IntLit, int2CharLit
 			, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
-			, float2DoubleLit, double2FloatLit
+			, float2DoubleLit, double2FloatLit, litFitsInChar
 			)
 import PrimOp		( PrimOp(..), tagToEnumKey )
 import TysWiredIn	( boolTy, trueDataConId, falseDataConId )
@@ -44,9 +51,7 @@ import Name		( Name, nameOccName )
 import Outputable
 import FastString
 import StaticFlags      ( opt_SimplExcessPrecision )
-
-import Data.Bits as Bits	( Bits(..), shiftL, shiftR )
-	-- shiftL and shiftR were not always methods of Bits
+import Data.Bits as Bits
 import Data.Word	( Word )
 \end{code}
 
@@ -121,7 +126,7 @@ primOpRules op op_name = primop_rule op
     primop_rule Narrow16WordOp 	= one_lit (litCoerce narrow16WordLit)
     primop_rule Narrow32WordOp 	= one_lit (litCoerce narrow32WordLit)
     primop_rule OrdOp   	= one_lit (litCoerce char2IntLit)
-    primop_rule ChrOp    	= one_lit (litCoerce int2CharLit)
+    primop_rule ChrOp    	= one_lit (predLitCoerce litFitsInChar int2CharLit)
     primop_rule Float2IntOp	= one_lit (litCoerce float2IntLit)
     primop_rule Int2FloatOp	= one_lit (litCoerce int2FloatLit)
     primop_rule Double2IntOp	= one_lit (litCoerce double2IntLit)
@@ -201,6 +206,11 @@ so this could be cleaned up.
 litCoerce :: (Literal -> Literal) -> Literal -> Maybe CoreExpr
 litCoerce fn lit = Just (Lit (fn lit))
 
+predLitCoerce :: (Literal -> Bool) -> (Literal -> Literal) -> Literal -> Maybe CoreExpr
+predLitCoerce p fn lit
+   | p lit     = Just (Lit (fn lit))
+   | otherwise = Nothing
+
 --------------------------
 cmpOp :: (Ordering -> Bool) -> Literal -> Literal -> Maybe CoreExpr
 cmpOp cmp l1 l2
@@ -447,13 +457,43 @@ dataToTagRule other = Nothing
 %*									*
 %************************************************************************
 
+Note [Scoping for Builtin rules]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+When compiling a (base-package) module that defines one of the
+functions mentioned in the RHS of a built-in rule, there's a danger
+that we'll see
+
+	f = ...(eq String x)....
+
+	....and lower down...
+
+	eqString = ...
+
+Then a rewrite would give
+
+	f = ...(eqString x)...
+	....and lower down...
+	eqString = ...
+
+and lo, eqString is not in scope.  This only really matters when we get to code
+generation.  With -O we do a GlomBinds step that does a new SCC analysis on the whole
+set of bindings, which sorts out the dependency.  Without -O we don't do any rule
+rewriting so again we are fine.
+
+(This whole thing doesn't show up for non-built-in rules because their dependencies
+are explicit.)
+
+
 \begin{code}
 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 +534,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)