From: simonmar Date: Wed, 27 Feb 2002 14:33:09 +0000 (+0000) Subject: [project @ 2002-02-27 14:33:09 by simonmar] X-Git-Tag: nhc98-1-18-release~1096 X-Git-Url: http://git.megacz.com/?p=ghc-base.git;a=commitdiff_plain;h=b222d0eedeb4303082df2b066a15b9028ec1ee70 [project @ 2002-02-27 14:33:09 by simonmar] Move the Float/Double constant folding rules from GHC.Float to GHC.Base, thus returning GHC.Float to its non-orphan status. --- diff --git a/GHC/Base.lhs b/GHC/Base.lhs index d5fcfcd..bafd6c3 100644 --- a/GHC/Base.lhs +++ b/GHC/Base.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: Base.lhs,v 1.6 2002/02/12 09:39:19 simonmar Exp $ +% $Id: Base.lhs,v 1.7 2002/02/27 14:33:09 simonmar Exp $ % % (c) The University of Glasgow, 1992-2002 % @@ -85,7 +85,7 @@ module GHC.Base ) where -import {-# SOURCE #-} GHC.Prim +import GHC.Prim import {-# SOURCE #-} GHC.Err infixr 9 . @@ -692,6 +692,30 @@ gtInt, geInt, eqInt, neInt, ltInt, leInt :: Int -> Int -> Bool "x# <=# x#" forall x#. x# <=# x# = True #-} +{-# RULES +"plusFloat x 0.0" forall x#. plusFloat# x# 0.0# = x# +"plusFloat 0.0 x" forall x#. plusFloat# 0.0# x# = x# +"minusFloat x 0.0" forall x#. minusFloat# x# 0.0# = x# +"minusFloat x x" forall x#. minusFloat# x# x# = 0.0# +"timesFloat x 0.0" forall x#. timesFloat# x# 0.0# = 0.0# +"timesFloat0.0 x" forall x#. timesFloat# 0.0# x# = 0.0# +"timesFloat x 1.0" forall x#. timesFloat# x# 1.0# = x# +"timesFloat 1.0 x" forall x#. timesFloat# 1.0# x# = x# +"divideFloat x 1.0" forall x#. divideFloat# x# 1.0# = x# + #-} + +{-# RULES +"plusDouble x 0.0" forall x#. (+##) x# 0.0## = x# +"plusDouble 0.0 x" forall x#. (+##) 0.0## x# = x# +"minusDouble x 0.0" forall x#. (-##) x# 0.0## = x# +"minusDouble x x" forall x#. (-##) x# x# = 0.0## +"timesDouble x 0.0" forall x#. (*##) x# 0.0## = 0.0## +"timesDouble 0.0 x" forall x#. (*##) 0.0## x# = 0.0## +"timesDouble x 1.0" forall x#. (*##) x# 1.0## = x# +"timesDouble 1.0 x" forall x#. (*##) 1.0## x# = x# +"divideDouble x 1.0" forall x#. (/##) x# 1.0## = x# + #-} + -- Wrappers for the shift operations. The uncheckedShift# family are -- undefined when the amount being shifted by is greater than the size -- in bits of Int#, so these wrappers perform a check and return diff --git a/GHC/Float.lhs b/GHC/Float.lhs index ec27a12..d16ebeb 100644 --- a/GHC/Float.lhs +++ b/GHC/Float.lhs @@ -1,5 +1,5 @@ % ------------------------------------------------------------------------------ -% $Id: Float.lhs,v 1.4 2002/02/05 17:32:26 simonmar Exp $ +% $Id: Float.lhs,v 1.5 2002/02/27 14:33:09 simonmar Exp $ % % (c) The University of Glasgow, 1994-2000 % @@ -768,18 +768,6 @@ minusFloat (F# x) (F# y) = F# (minusFloat# x y) timesFloat (F# x) (F# y) = F# (timesFloat# x y) divideFloat (F# x) (F# y) = F# (divideFloat# x y) -{-# RULES -"plusFloat x 0.0" forall x#. plusFloat# x# 0.0# = x# -"plusFloat 0.0 x" forall x#. plusFloat# 0.0# x# = x# -"minusFloat x 0.0" forall x#. minusFloat# x# 0.0# = x# -"minusFloat x x" forall x#. minusFloat# x# x# = 0.0# -"timesFloat x 0.0" forall x#. timesFloat# x# 0.0# = 0.0# -"timesFloat0.0 x" forall x#. timesFloat# 0.0# x# = 0.0# -"timesFloat x 1.0" forall x#. timesFloat# x# 1.0# = x# -"timesFloat 1.0 x" forall x#. timesFloat# 1.0# x# = x# -"divideFloat x 1.0" forall x#. divideFloat# x# 1.0# = x# - #-} - negateFloat :: Float -> Float negateFloat (F# x) = F# (negateFloat# x) @@ -826,18 +814,6 @@ minusDouble (D# x) (D# y) = D# (x -## y) timesDouble (D# x) (D# y) = D# (x *## y) divideDouble (D# x) (D# y) = D# (x /## y) -{-# RULES -"plusDouble x 0.0" forall x#. (+##) x# 0.0## = x# -"plusDouble 0.0 x" forall x#. (+##) 0.0## x# = x# -"minusDouble x 0.0" forall x#. (-##) x# 0.0## = x# -"minusDouble x x" forall x#. (-##) x# x# = 0.0## -"timesDouble x 0.0" forall x#. (*##) x# 0.0## = 0.0## -"timesDouble 0.0 x" forall x#. (*##) 0.0## x# = 0.0## -"timesDouble x 1.0" forall x#. (*##) x# 1.0## = x# -"timesDouble 1.0 x" forall x#. (*##) 1.0## x# = x# -"divideDouble x 1.0" forall x#. (/##) x# 1.0## = x# - #-} - negateDouble :: Double -> Double negateDouble (D# x) = D# (negateDouble# x)