From 531d0d264fafd66aece5ca38d2bfcd266a8fd3e5 Mon Sep 17 00:00:00 2001
From: simonmar <unknown>
Date: Wed, 20 Dec 2000 15:58:35 +0000
Subject: [PATCH] [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.

---
 ghc/compiler/basicTypes/Literal.lhs |    9 +++++++--
 ghc/compiler/coreSyn/CoreUnfold.lhs |    5 ++---
 ghc/compiler/coreSyn/CoreUtils.lhs  |    2 +-
 3 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/ghc/compiler/basicTypes/Literal.lhs b/ghc/compiler/basicTypes/Literal.lhs
index 62a9c30..62ead1c 100644
--- 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
--- 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
--- 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 )
-- 
1.7.10.4