From 6758ba711a3f9f3100a9dba1818b131c32e62106 Mon Sep 17 00:00:00 2001
From: "andy@galois.com" <unknown>
Date: Wed, 11 Jul 2007 06:35:20 +0000
Subject: [PATCH] Stoping constant folding of calls to chr# that are invalid

import GHC.Exts
main = print (C# (chr# 0xffffffff#))

This crashed at compile time (with or without hpc)
Tickled by pending cross-module hpc inlining patch.
---
 compiler/basicTypes/Literal.lhs |    7 +++++++
 compiler/prelude/PrelRules.lhs  |    9 +++++++--
 2 files changed, 14 insertions(+), 2 deletions(-)

diff --git a/compiler/basicTypes/Literal.lhs b/compiler/basicTypes/Literal.lhs
index 598b5a4..a5c413a 100644
--- a/compiler/basicTypes/Literal.lhs
+++ b/compiler/basicTypes/Literal.lhs
@@ -16,6 +16,7 @@ module Literal
 
 	, inIntRange, inWordRange, tARGET_MAX_INT, inCharRange
 	, isZeroLit
+	, litFitsInChar
 
 	, word2IntLit, int2WordLit
 	, narrow8IntLit, narrow16IntLit, narrow32IntLit
@@ -284,6 +285,12 @@ litIsDupable :: Literal -> Bool
 litIsDupable (MachStr _) = False
 litIsDupable other	 = True
 
+litFitsInChar :: Literal -> Bool
+litFitsInChar (MachInt i)
+    		         = fromInteger i <= ord minBound 
+                        && fromInteger i >= ord maxBound 
+litFitsInChar _         = False
+
 litSize :: Literal -> Int
 -- Used by CoreUnfold.sizeExpr
 litSize (MachStr str) = 1 + ((lengthFS str + 3) `div` 4)
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs
index 165d008..a03aff2 100644
--- a/compiler/prelude/PrelRules.lhs
+++ b/compiler/prelude/PrelRules.lhs
@@ -28,7 +28,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 )
@@ -119,7 +119,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)
@@ -199,6 +199,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
-- 
1.7.10.4