[project @ 2002-04-29 14:03:38 by simonmar]

FastString cleanup, stage 1.

The FastString type is no longer a mixture of hashed strings and
literal strings, it contains hashed strings only with O(1) comparison
(except for UnicodeStr, but that will also go away in due course).  To
create a literal instance of FastString, use FSLIT("..").

By far the most common use of the old literal version of FastString
was in the pattern

	  ptext SLIT("...")

this combination still works, although it doesn't go via FastString
any more.  The next stage will be to remove the need to use this
special combination at all, using a RULE.

To convert a FastString into an SDoc, now use 'ftext' instead of
'ptext'.

I've also removed all the FAST_STRING related macros from HsVersions.h
except for SLIT and FSLIT, just use the relevant functions from
FastString instead.

7 files changed, 33 insertions, 29 deletions

diff --git a/ghc/compiler/hsSyn/HsBinds.lhs b/ghc/compiler/hsSyn/HsBinds.lhs
index b5456d2352..bb2c8b2bb7 100644
--- a/ghc/compiler/hsSyn/HsBinds.lhs
+++ b/ghc/compiler/hsSyn/HsBinds.lhs
@@ -317,13 +317,13 @@ isPragSig other		      = False
 \end{code}
 
 \begin{code}
-hsSigDoc (Sig        _ _ loc) 	      = (SLIT("type signature"),loc)
-hsSigDoc (ClassOpSig _ _ _ loc)       = (SLIT("class-method type signature"), loc)
-hsSigDoc (SpecSig    _ _ loc) 	      = (SLIT("SPECIALISE pragma"),loc)
-hsSigDoc (InlineSig True  _ _ loc)    = (SLIT("INLINE pragma"),loc)
-hsSigDoc (InlineSig False _ _ loc)    = (SLIT("NOINLINE pragma"),loc)
-hsSigDoc (SpecInstSig _ loc)	      = (SLIT("SPECIALISE instance pragma"),loc)
-hsSigDoc (FixSig (FixitySig _ _ loc)) = (SLIT("fixity declaration"), loc)
+hsSigDoc (Sig        _ _ loc) 	      = (ptext SLIT("type signature"),loc)
+hsSigDoc (ClassOpSig _ _ _ loc)       = (ptext SLIT("class-method type signature"), loc)
+hsSigDoc (SpecSig    _ _ loc) 	      = (ptext SLIT("SPECIALISE pragma"),loc)
+hsSigDoc (InlineSig True  _ _ loc)    = (ptext SLIT("INLINE pragma"),loc)
+hsSigDoc (InlineSig False _ _ loc)    = (ptext SLIT("NOINLINE pragma"),loc)
+hsSigDoc (SpecInstSig _ loc)	      = (ptext SLIT("SPECIALISE instance pragma"),loc)
+hsSigDoc (FixSig (FixitySig _ _ loc)) = (ptext SLIT("fixity declaration"), loc)
 \end{code}
 
 \begin{code}
diff --git a/ghc/compiler/hsSyn/HsCore.lhs b/ghc/compiler/hsSyn/HsCore.lhs
index 8d1da8f751..0f5a020370 100644
--- a/ghc/compiler/hsSyn/HsCore.lhs
+++ b/ghc/compiler/hsSyn/HsCore.lhs
@@ -50,6 +50,7 @@ import FiniteMap	( lookupFM )
 import CostCentre
 import Util		( eqListBy, lengthIs )
 import Outputable
+import FastString
 \end{code}
 
 %************************************************************************
@@ -69,7 +70,7 @@ data UfExpr name
   | UfLet	(UfBinding name)  (UfExpr name)
   | UfNote	(UfNote name) (UfExpr name)
   | UfLit	Literal
-  | UfLitLit	FAST_STRING (HsType name)
+  | UfLitLit	FastString (HsType name)
   | UfFCall	ForeignCall (HsType name)
 
 data UfNote name = UfSCC CostCentre
@@ -83,7 +84,7 @@ data UfConAlt name = UfDefault
  		   | UfDataAlt name
 		   | UfTupleAlt (HsTupCon name)
 		   | UfLitAlt Literal
-		   | UfLitLitAlt FAST_STRING (HsType name)
+		   | UfLitLitAlt FastString (HsType name)
 
 data UfBinding name
   = UfNonRec	(UfBinder name)
diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index 848ef57f26..036a427318 100644
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -829,10 +829,10 @@ instance Outputable ForeignImport where
     char '"' <> pprCEntity header lib spec <> char '"'
     where
       pprCEntity header lib (CLabel lbl) = 
-        ptext SLIT("static") <+> ptext header <+> char '&' <>
+        ptext SLIT("static") <+> ftext header <+> char '&' <>
 	pprLib lib <> ppr lbl
       pprCEntity header lib (CFunction (StaticTarget lbl)) = 
-        ptext SLIT("static") <+> ptext header <+> char '&' <>
+        ptext SLIT("static") <+> ftext header <+> char '&' <>
 	pprLib lib <> ppr lbl
       pprCEntity header lib (CFunction (DynamicTarget)) = 
         ptext SLIT("dynamic")
@@ -905,7 +905,7 @@ instance (NamedThing name, Ord name) => Eq (RuleDecl name pat) where
 instance (NamedThing name, Outputable name, Outputable pat)
 	      => Outputable (RuleDecl name pat) where
   ppr (HsRule name act ns lhs rhs loc)
-	= sep [text "{-# RULES" <+> doubleQuotes (ptext name) <+> ppr act,
+	= sep [text "{-# RULES" <+> doubleQuotes (ftext name) <+> ppr act,
 	       pp_forall, ppr lhs, equals <+> ppr rhs,
                text "#-}" ]
 	where
@@ -913,7 +913,7 @@ instance (NamedThing name, Outputable name, Outputable pat)
 		    | otherwise	= text "forall" <+> fsep (map ppr ns) <> dot
 
   ppr (IfaceRule name act tpl_vars fn tpl_args rhs loc) 
-    = hsep [ doubleQuotes (ptext name), ppr act,
+    = hsep [ doubleQuotes (ftext name), ppr act,
 	   ptext SLIT("__forall") <+> braces (interppSP tpl_vars),
 	   ppr fn <+> sep (map (pprUfExpr parens) tpl_args),
 	   ptext SLIT("=") <+> ppr rhs
@@ -938,7 +938,7 @@ We use exported entities for things to deprecate.
 \begin{code}
 data DeprecDecl name = Deprecation name DeprecTxt SrcLoc
 
-type DeprecTxt = FAST_STRING	-- reason/explanation for deprecation
+type DeprecTxt = FastString	-- reason/explanation for deprecation
 
 instance Outputable name => Outputable (DeprecDecl name) where
     ppr (Deprecation thing txt _)
diff --git a/ghc/compiler/hsSyn/HsExpr.lhs b/ghc/compiler/hsSyn/HsExpr.lhs
index 2e899c08ea..fa81775785 100644
--- a/ghc/compiler/hsSyn/HsExpr.lhs
+++ b/ghc/compiler/hsSyn/HsExpr.lhs
@@ -27,6 +27,7 @@ import DataCon		( DataCon )
 import CStrings		( CLabelString, pprCLabelString )
 import BasicTypes	( IPName, Boxity, tupleParens )
 import SrcLoc		( SrcLoc )
+import FastString
 \end{code}
 
 %************************************************************************
@@ -160,7 +161,7 @@ data HsExpr id pat
 		PostTcType	-- The result type; will be *bottom*
 				-- until the typechecker gets ahold of it
 
-  | HsSCC	FAST_STRING	-- "set cost centre" (_scc_) annotation
+  | HsSCC	FastString	-- "set cost centre" (_scc_) annotation
 		(HsExpr id pat) -- expr whose cost is to be measured
 
 \end{code}
@@ -356,7 +357,7 @@ ppr_expr (HsCCall fun args _ is_asm result_ty)
        4 (sep (map pprParendExpr args))
 
 ppr_expr (HsSCC lbl expr)
-  = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ptext lbl), pprParendExpr expr ]
+  = sep [ ptext SLIT("_scc_") <+> doubleQuotes (ftext lbl), pprParendExpr expr ]
 
 ppr_expr (TyLam tyvars expr)
   = hang (hsep [ptext SLIT("/\\"), interppSP tyvars, ptext SLIT("->")])
@@ -554,7 +555,7 @@ pprGRHS ctxt (GRHS guarded locn)
     ResultStmt expr _ = last guarded	-- Last stmt should be a ResultStmt for guards
     guards	      = init guarded
 
-pp_rhs ctxt rhs = ptext (matchSeparator ctxt) <+> pprDeeper (ppr rhs)
+pp_rhs ctxt rhs = matchSeparator ctxt <+> pprDeeper (ppr rhs)
 \end{code}
 
 
@@ -708,11 +709,11 @@ isDoExpr other 		 = False
 \end{code}
 
 \begin{code}
-matchSeparator (FunRhs _)   = SLIT("=")
-matchSeparator CaseAlt      = SLIT("->") 
-matchSeparator LambdaExpr   = SLIT("->") 
-matchSeparator PatBindRhs   = SLIT("=") 
-matchSeparator (DoCtxt _)   = SLIT("<-")  
+matchSeparator (FunRhs _)   = ptext SLIT("=")
+matchSeparator CaseAlt      = ptext SLIT("->") 
+matchSeparator LambdaExpr   = ptext SLIT("->") 
+matchSeparator PatBindRhs   = ptext SLIT("=") 
+matchSeparator (DoCtxt _)   = ptext SLIT("<-")  
 matchSeparator RecUpd       = panic "When is this used?"
 \end{code}
 
diff --git a/ghc/compiler/hsSyn/HsImpExp.lhs b/ghc/compiler/hsSyn/HsImpExp.lhs
index e483914619..b33fb2bcd7 100644
--- a/ghc/compiler/hsSyn/HsImpExp.lhs
+++ b/ghc/compiler/hsSyn/HsImpExp.lhs
@@ -11,6 +11,7 @@ module HsImpExp where
 import Name 		( isLexSym )
 import Module		( ModuleName, WhereFrom )
 import Outputable
+import FastString
 import SrcLoc		( SrcLoc )
 \end{code}
 
@@ -99,7 +100,7 @@ ppr_var v | isOperator v = parens (ppr v)
 
 \begin{code}
 isOperator :: Outputable a => a -> Bool
-isOperator v = isLexSym (_PK_ (showSDocUnqual (ppr v)))
+isOperator v = isLexSym (mkFastString (showSDocUnqual (ppr v)))
 	-- We use (showSDoc (ppr v)), rather than isSymOcc (getOccName v) simply so
 	-- that we don't need NamedThing in the context of all these functions.
 	-- Gruesome, but simple.
diff --git a/ghc/compiler/hsSyn/HsLit.lhs b/ghc/compiler/hsSyn/HsLit.lhs
index aa19b64164..2675810465 100644
--- a/ghc/compiler/hsSyn/HsLit.lhs
+++ b/ghc/compiler/hsSyn/HsLit.lhs
@@ -12,6 +12,7 @@ import Type	( Type )
 import Name	( Name )
 import HsTypes	( PostTcType )
 import Outputable
+import FastString
 import Ratio	( Rational )
 \end{code}
 
@@ -27,8 +28,8 @@ import Ratio	( Rational )
 data HsLit
   = HsChar	    Int			-- Character
   | HsCharPrim	    Int			-- Unboxed character
-  | HsString	    FAST_STRING		-- String
-  | HsStringPrim    FAST_STRING		-- Packed string
+  | HsString	    FastString		-- String
+  | HsStringPrim    FastString		-- Packed string
   | HsInt	    Integer		-- Genuinely an Int; arises from TcGenDeriv, 
 					--	and from TRANSLATION
   | HsIntPrim	    Integer		-- Unboxed Int
@@ -36,7 +37,7 @@ data HsLit
   | HsRat	    Rational Type	-- Genuinely a rational; arises only from TRANSLATION
   | HsFloatPrim	    Rational		-- Unboxed Float
   | HsDoublePrim    Rational		-- Unboxed Double
-  | HsLitLit	    FAST_STRING PostTcType	-- to pass ``literal literals'' through to C
+  | HsLitLit	    FastString PostTcType	-- to pass ``literal literals'' through to C
 						-- also: "overloaded" type; but
 						-- must resolve to boxed-primitive!
 	-- The Type in HsLitLit is needed when desuaring;
@@ -86,7 +87,7 @@ instance Outputable HsLit where
     ppr (HsFloatPrim f)	 = rational f <> char '#'
     ppr (HsDoublePrim d) = rational d <> text "##"
     ppr (HsIntPrim i)	 = integer i  <> char '#'
-    ppr (HsLitLit s _)	 = hcat [text "``", ptext s, text "''"]
+    ppr (HsLitLit s _)	 = hcat [text "``", ftext s, text "''"]
 
 instance Outputable HsOverLit where
   ppr (HsIntegral i _)   = integer i
diff --git a/ghc/compiler/hsSyn/HsTypes.lhs b/ghc/compiler/hsSyn/HsTypes.lhs
index 3c4262989c..837dc91b45 100644
--- a/ghc/compiler/hsSyn/HsTypes.lhs
+++ b/ghc/compiler/hsSyn/HsTypes.lhs
@@ -115,8 +115,8 @@ data HsType name
 
 -----------------------
 hsUsOnce, hsUsMany :: HsType RdrName
-hsUsOnce = HsTyVar (mkUnqual tvName SLIT("."))  -- deep magic
-hsUsMany = HsTyVar (mkUnqual tvName SLIT("!"))  -- deep magic
+hsUsOnce = HsTyVar (mkUnqual tvName FSLIT("."))  -- deep magic
+hsUsMany = HsTyVar (mkUnqual tvName FSLIT("!"))  -- deep magic
 
 hsUsOnce_Name, hsUsMany_Name :: HsType Name
 hsUsOnce_Name = HsTyVar usOnceTyConName