From 2a0ffd1c424b2c076506841a55fa6f45d85329bb Mon Sep 17 00:00:00 2001
From: panne <unknown>
Date: Sun, 2 Jul 2000 18:59:10 +0000
Subject: [PATCH] [project @ 2000-07-02 18:59:10 by panne] Don't use
addr2Integer for large integral literals anymore, use a Horner schema with
numbers in the Int range instead. This improves constant folding, so e.g.
(0x87654321 :: Word32) is evaluated at compile time now. In theory we can
completely say Good-bye to addr2Integer, but for the time being it's still
there. Feel free to nuke it... >:-)
---
ghc/compiler/basicTypes/Literal.lhs | 2 +-
ghc/compiler/rename/RnExpr.lhs | 20 ++++++++++++++++++++
2 files changed, 21 insertions(+), 1 deletion(-)
diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
index 016cc8e332ab..907eba3ce04e 100644
--- a/ghc/compiler/basicTypes/Literal.lhs
+++ b/ghc/compiler/basicTypes/Literal.lhs
@@ -12,7 +12,7 @@ module Literal
, literalType, literalPrimRep
, hashLiteral
- , inIntRange, inWordRange
+ , inIntRange, inWordRange, tARGET_MAX_INT
, word2IntLit, int2WordLit, char2IntLit, int2CharLit
, float2IntLit, int2FloatLit, double2IntLit, int2DoubleLit
diff --git a/ghc/compiler/rename/RnExpr.lhs b/ghc/compiler/rename/RnExpr.lhs
index 7bfa40982100..5102f544a1fc 100644
--- a/ghc/compiler/rename/RnExpr.lhs
+++ b/ghc/compiler/rename/RnExpr.lhs
@@ -50,6 +50,9 @@ import Util ( removeDups )
import ListSetOps ( unionLists )
import Maybes ( maybeToBool )
import Outputable
+import Literal ( inIntRange, tARGET_MAX_INT )
+import RdrName ( mkSrcUnqual )
+import OccName ( varName )
\end{code}
@@ -288,6 +291,12 @@ rnExpr (HsIPVar v)
= getIPName v `thenRn` \ name ->
returnRn (HsIPVar name, emptyFVs)
+-- Special case for integral literals with a large magnitude:
+-- They are transformed into an expression involving only smaller
+-- integral literals. This improves constant folding.
+rnExpr (HsLit (HsInt i))
+ | not (inIntRange i) = rnExpr (horner tARGET_MAX_INT i)
+
rnExpr (HsLit lit)
= litOccurrence lit `thenRn` \ fvs ->
returnRn (HsLit lit, fvs)
@@ -468,6 +477,17 @@ rnExpr e@(EAsPat _ _) = addErrRn (patSynErr e) `thenRn_`
rnExpr e@(ELazyPat _) = addErrRn (patSynErr e) `thenRn_`
returnRn (EWildPat, emptyFVs)
+
+-- Transform i into (x1 + (x2 + (x3 + (...) * b) * b) * b) with abs xi <= b
+horner :: Integer -> Integer -> RdrNameHsExpr
+horner b i | abs q <= 1 = if r == 0 || r == i then mkInt i else mkInt r `plus` mkInt (i-r)
+ | r == 0 = horner b q `times` mkInt b
+ | otherwise = mkInt r `plus` (horner b q `times` mkInt b)
+ where (q,r) = i `quotRem` b
+ mkInt i = HsLit (HsInt i)
+ plus = mkOp "+"
+ times = mkOp "*"
+ mkOp op = \x y -> OpApp x (HsVar (mkSrcUnqual varName (_PK_ op))) (panic "fixity") y
\end{code}
%************************************************************************
--
GitLab