diff options
| author | andy@galois.com <unknown> | 2007-07-11 06:35:20 +0000 |
|---|---|---|
| committer | andy@galois.com <unknown> | 2007-07-11 06:35:20 +0000 |
| commit | 6758ba711a3f9f3100a9dba1818b131c32e62106 (patch) | |
| tree | 7133b67ec35a30a25a2e97929ec82a4768e0bce0 /compiler | |
| parent | 72b5392f4103dc895d569bfad647ddec2de67dec (diff) | |
| download | haskell-6758ba711a3f9f3100a9dba1818b131c32e62106.tar.gz | |
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.
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/basicTypes/Literal.lhs | 7 | ||||
| -rw-r--r-- | 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 598b5a4917..a5c413ad16 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 165d0088a7..a03aff2e8e 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 |