[project @ 2000-12-20 15:58:35 by simonmar]

Don't duplicate strings semi-willy-nilly.  Literal strings now have a
size dependent on their length.

diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
index 62a9c30..62ead1c 100644 (file)
--- a/ghc/compiler/basicTypes/Literal.lhs
+++ b/ghc/compiler/basicTypes/Literal.lhs
@@ -8,7 +8,7 @@ module Literal
        ( Literal(..)           -- Exported to ParseIface
        , mkMachInt, mkMachWord
        , mkMachInt64, mkMachWord64
-       , isLitLitLit, maybeLitLit, litIsDupable,
+       , isLitLitLit, maybeLitLit, litSize, litIsDupable,
        , literalType, literalPrimRep
        , hashLiteral
 
@@ -34,7 +34,7 @@ import FastTypes
 import Util            ( thenCmp )
 
 import Ratio           ( numerator )
-import FastString      ( uniqueOfFS )
+import FastString      ( uniqueOfFS, lengthFS )
 import Char            ( ord, chr )
 \end{code}
 
@@ -190,6 +190,11 @@ litIsDupable :: Literal -> Bool
        -- False principally of strings
 litIsDupable (MachStr _) = False
 litIsDupable other      = True
+
+litSize :: Literal -> Int
+       -- used by CoreUnfold.sizeExpr
+litSize (MachStr str) = lengthFS str `div` 4
+litSize _other       = 1
 \end{code}
 
        Types

diff --git a/ghc/compiler/coreSyn/CoreUnfold.lhs b/ghc/compiler/coreSyn/CoreUnfold.lhs
index 102d8bc..d86b864 100644 (file)
--- a/ghc/compiler/coreSyn/CoreUnfold.lhs
+++ b/ghc/compiler/coreSyn/CoreUnfold.lhs
@@ -47,7 +47,7 @@ import Id             ( Id, idType, idFlavour, isId,
                          isPrimOpId_maybe
                        )
 import VarSet
-import Literal         ( isLitLitLit, litIsDupable )
+import Literal         ( isLitLitLit, litSize )
 import PrimOp          ( PrimOp(..), primOpIsDupable, primOpOutOfLine, ccallIsCasm )
 import IdInfo          ( InlinePragInfo(..), OccInfo(..), IdFlavour(..),
                          isNeverInlinePrag
@@ -193,8 +193,7 @@ sizeExpr bOMB_OUT_SIZE top_args expr
     size_up (App fun (Type t)) = size_up fun
     size_up (App fun arg)      = size_up_app fun [arg]
 
-    size_up (Lit lit) | litIsDupable lit = sizeOne
-                     | otherwise        = sizeN opt_UF_DearOp  -- For lack of anything better
+    size_up (Lit lit)         = sizeN (litSize lit)
 
     size_up (Lam b e) | isId b    = lamScrutDiscount (size_up e `addSizeN` 1)
                      | otherwise = size_up e

diff --git a/ghc/compiler/coreSyn/CoreUtils.lhs b/ghc/compiler/coreSyn/CoreUtils.lhs
index 3c0b8aa..78230bc 100644 (file)
--- a/ghc/compiler/coreSyn/CoreUtils.lhs
+++ b/ghc/compiler/coreSyn/CoreUtils.lhs
@@ -44,7 +44,7 @@ import Var            ( Var, isId, isTyVar )
 import VarSet
 import VarEnv
 import Name            ( hashName )
-import Literal         ( hashLiteral, literalType, litIsDupable )
+import Literal         ( hashLiteral, literalType, litSize, litIsDupable )
 import DataCon         ( DataCon, dataConRepArity )
 import PrimOp          ( primOpOkForSpeculation, primOpIsCheap, 
                          primOpIsDupable )