[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.

4 files changed, 64 insertions, 63 deletions

diff --git a/ghc/compiler/parser/Lex.lhs b/ghc/compiler/parser/Lex.lhs
index 6c497cb894..26bcf9dac1 100644
--- a/ghc/compiler/parser/Lex.lhs
+++ b/ghc/compiler/parser/Lex.lhs
@@ -169,31 +169,31 @@ data Token
   | ITunderscore
   | ITbackquote
 
-  | ITvarid   FAST_STRING	-- identifiers
-  | ITconid   FAST_STRING
-  | ITvarsym  FAST_STRING
-  | ITconsym  FAST_STRING
-  | ITqvarid  (FAST_STRING,FAST_STRING)
-  | ITqconid  (FAST_STRING,FAST_STRING)
-  | ITqvarsym (FAST_STRING,FAST_STRING)
-  | ITqconsym (FAST_STRING,FAST_STRING)
-
-  | ITdupipvarid   FAST_STRING	-- GHC extension: implicit param: ?x
-  | ITsplitipvarid FAST_STRING	-- GHC extension: implicit param: %x
+  | ITvarid   FastString	-- identifiers
+  | ITconid   FastString
+  | ITvarsym  FastString
+  | ITconsym  FastString
+  | ITqvarid  (FastString,FastString)
+  | ITqconid  (FastString,FastString)
+  | ITqvarsym (FastString,FastString)
+  | ITqconsym (FastString,FastString)
+
+  | ITdupipvarid   FastString	-- GHC extension: implicit param: ?x
+  | ITsplitipvarid FastString	-- GHC extension: implicit param: %x
 
   | ITpragma StringBuffer
 
   | ITchar       Int
-  | ITstring     FAST_STRING
+  | ITstring     FastString
   | ITinteger    Integer
   | ITrational   Rational
 
   | ITprimchar   Int
-  | ITprimstring FAST_STRING
+  | ITprimstring FastString
   | ITprimint    Integer
   | ITprimfloat  Rational
   | ITprimdouble Rational
-  | ITlitlit     FAST_STRING
+  | ITlitlit     FastString
 
   | ITunknown String		-- Used when the lexer can't make sense of it
   | ITeof			-- end of file token
@@ -205,7 +205,7 @@ Keyword Lists
 
 \begin{code}
 pragmaKeywordsFM = listToUFM $
-      map (\ (x,y) -> (_PK_ x,y))
+      map (\ (x,y) -> (mkFastString x,y))
        [( "SPECIALISE", ITspecialise_prag ),
 	( "SPECIALIZE", ITspecialise_prag ),
 	( "SOURCE",	ITsource_prag ),
@@ -220,7 +220,7 @@ pragmaKeywordsFM = listToUFM $
  	]
 
 haskellKeywordsFM = listToUFM $
-      map (\ (x,y) -> (_PK_ x,y))
+      map (\ (x,y) -> (mkFastString x,y))
        [( "_",		ITunderscore ),
 	( "as",		ITas ),
 	( "case",	ITcase ),     
@@ -270,7 +270,7 @@ isSpecial _             = False
 
 -- IMPORTANT: Keep this in synch with ParseIface.y's var_fs production! (SUP)
 ghcExtensionKeywordsFM = listToUFM $
-	map (\ (x,y) -> (_PK_ x,y))
+	map (\ (x,y) -> (mkFastString x,y))
      [	( "forall",	ITforall ),
 	( "foreign",	ITforeign ),
 	( "export",	ITexport ),
@@ -291,7 +291,7 @@ ghcExtensionKeywordsFM = listToUFM $
 
 
 haskellKeySymsFM = listToUFM $
-	map (\ (x,y) -> (_PK_ x,y))
+	map (\ (x,y) -> (mkFastString x,y))
       [ ("..",		ITdotdot)
        ,("::",		ITdcolon)
        ,("=",		ITequal)
@@ -873,7 +873,7 @@ lex_id cont exts buf =
  let lexeme  = lexemeToFastString buf' in
 
  case _scc_ "haskellKeyword" lookupUFM haskellKeywordsFM lexeme of {
- 	Just kwd_token -> --trace ("hkeywd: "++_UNPK_(lexeme)) $
+ 	Just kwd_token -> --trace ("hkeywd: "++unpackFS(lexeme)) $
 			  cont kwd_token buf';
  	Nothing        -> 
 
@@ -934,7 +934,7 @@ maybe_qualified cont exts mod buf just_a_conid =
  case currentChar# buf of
   '['# -> 	-- Special case for []
     case lookAhead# buf 1# of
-     ']'# -> cont (ITqconid  (mod,SLIT("[]"))) (setCurrentPos# buf 2#)
+     ']'# -> cont (ITqconid  (mod,FSLIT("[]"))) (setCurrentPos# buf 2#)
      _    -> just_a_conid
 
   '('# ->  -- Special case for (,,,)
@@ -944,12 +944,12 @@ maybe_qualified cont exts mod buf just_a_conid =
 		','# -> lex_ubx_tuple cont mod (setCurrentPos# buf 3#) 
 				just_a_conid
 		_    -> just_a_conid
-     ')'# -> cont (ITqconid (mod,SLIT("()"))) (setCurrentPos# buf 2#)
+     ')'# -> cont (ITqconid (mod,FSLIT("()"))) (setCurrentPos# buf 2#)
      ','# -> lex_tuple cont mod (setCurrentPos# buf 2#) just_a_conid
      _    -> just_a_conid
 
   '-'# -> case lookAhead# buf 1# of
-            '>'# -> cont (ITqconid (mod,SLIT("(->)"))) (setCurrentPos# buf 2#)
+            '>'# -> cont (ITqconid (mod,FSLIT("(->)"))) (setCurrentPos# buf 2#)
             _    -> lex_id3 cont exts mod buf just_a_conid
 
   _    -> lex_id3 cont exts mod buf just_a_conid
@@ -1011,7 +1011,7 @@ mk_var_token pk_str
   | f `eqChar#` ':'#	= ITconsym pk_str
   | otherwise		= ITvarsym pk_str
   where
-      (C# f) = _HEAD_ pk_str
+      (C# f) = headFS pk_str
       -- tl     = _TAIL_ pk_str
 
 mk_qvar_token m token =
@@ -1112,7 +1112,7 @@ setSrcLocP new_loc p buf s =
       POk _ a   -> POk s a
       PFailed e -> PFailed e
   
-getSrcFile :: P FAST_STRING
+getSrcFile :: P FastString
 getSrcFile buf s@(PState{ loc = loc }) = POk s (srcLocFile loc)
 
 pushContext :: LayoutContext -> P ()
diff --git a/ghc/compiler/parser/ParseUtil.lhs b/ghc/compiler/parser/ParseUtil.lhs
index 6314914683..a9ae3ffb1b 100644
--- a/ghc/compiler/parser/ParseUtil.lhs
+++ b/ghc/compiler/parser/ParseUtil.lhs
@@ -15,11 +15,11 @@ module ParseUtil (
 
 	, CallConv(..)
 	, mkImport            -- CallConv -> Safety 
-			      -- -> (FAST_STRING, RdrName, RdrNameHsType)
+			      -- -> (FastString, RdrName, RdrNameHsType)
 			      -- -> SrcLoc 
 			      -- -> P RdrNameHsDecl
 	, mkExport            -- CallConv
-			      -- -> (FAST_STRING, RdrName, RdrNameHsType)
+			      -- -> (FastString, RdrName, RdrNameHsType)
 			      -- -> SrcLoc 
 			      -- -> P RdrNameHsDecl
 	, mkExtName           -- RdrName -> CLabelString
@@ -52,7 +52,7 @@ import PrelNames	( unitTyCon_RDR )
 import OccName  	( dataName, varName, tcClsName, isDataOcc,
 			  occNameSpace, setOccNameSpace, occNameUserString )
 import CStrings		( CLabelString )
-import FastString	( nullFastString )
+import FastString
 import Outputable
 
 -----------------------------------------------------------------------------
@@ -319,7 +319,7 @@ data CallConv = CCall  CCallConv	-- ccall or stdcall
 --
 mkImport :: CallConv 
 	 -> Safety 
-	 -> (FAST_STRING, RdrName, RdrNameHsType) 
+	 -> (FastString, RdrName, RdrNameHsType) 
 	 -> SrcLoc 
 	 -> P RdrNameHsDecl
 mkImport (CCall  cconv) safety (entity, v, ty) loc =
@@ -331,7 +331,7 @@ mkImport (DNCall      ) _      (entity, v, ty) loc =
 -- parse the entity string of a foreign import declaration for the `ccall' or
 -- `stdcall' calling convention'
 --
-parseCImport :: FAST_STRING 
+parseCImport :: FastString 
 	     -> CCallConv 
 	     -> Safety 
 	     -> RdrName 
@@ -339,43 +339,43 @@ parseCImport :: FAST_STRING
 parseCImport entity cconv safety v
   -- FIXME: we should allow white space around `dynamic' and `wrapper' -=chak
   | entity == FSLIT ("dynamic") = 
-    returnP $ CImport cconv safety _NIL_ _NIL_ (CFunction DynamicTarget)
+    returnP $ CImport cconv safety nilFS nilFS (CFunction DynamicTarget)
   | entity == FSLIT ("wrapper") =
-    returnP $ CImport cconv safety _NIL_ _NIL_ CWrapper
-  | otherwise		       = parse0 (_UNPK_ entity)
+    returnP $ CImport cconv safety nilFS nilFS CWrapper
+  | otherwise		       = parse0 (unpackFS entity)
     where
       -- using the static keyword?
       parse0 (' ':                    rest) = parse0 rest
       parse0 ('s':'t':'a':'t':'i':'c':rest) = parse1 rest
       parse0                          rest  = parse1 rest
       -- check for header file name
-      parse1     ""               = parse4 ""    _NIL_        False _NIL_
+      parse1     ""               = parse4 ""    nilFS        False nilFS
       parse1     (' ':rest)       = parse1 rest
-      parse1 str@('&':_   )       = parse2 str   _NIL_
-      parse1 str@('[':_   )       = parse3 str   _NIL_        False
+      parse1 str@('&':_   )       = parse2 str   nilFS
+      parse1 str@('[':_   )       = parse3 str   nilFS        False
       parse1 str
-	| ".h" `isSuffixOf` first = parse2 rest  (_PK_ first)
-        | otherwise               = parse4 str   _NIL_        False _NIL_
+	| ".h" `isSuffixOf` first = parse2 rest  (mkFastString first)
+        | otherwise               = parse4 str   nilFS        False nilFS
         where
 	  (first, rest) = break (\c -> c == ' ' || c == '&' || c == '[') str
       -- check for address operator (indicating a label import)
-      parse2     ""         header = parse4 ""   header False _NIL_
+      parse2     ""         header = parse4 ""   header False nilFS
       parse2     (' ':rest) header = parse2 rest header
       parse2     ('&':rest) header = parse3 rest header True
       parse2 str@('[':_   ) header = parse3 str	 header False
-      parse2 str	    header = parse4 str	 header False _NIL_
+      parse2 str	    header = parse4 str	 header False nilFS
       -- check for library object name
       parse3 (' ':rest) header isLbl = parse3 rest header isLbl
       parse3 ('[':rest) header isLbl = 
         case break (== ']') rest of 
-	  (lib, ']':rest)           -> parse4 rest header isLbl (_PK_ lib)
+	  (lib, ']':rest)           -> parse4 rest header isLbl (mkFastString lib)
 	  _			    -> parseError "Missing ']' in entity"
-      parse3 str	header isLbl = parse4 str  header isLbl _NIL_
+      parse3 str	header isLbl = parse4 str  header isLbl nilFS
       -- check for name of C function
       parse4 ""         header isLbl lib = build (mkExtName v) header isLbl lib
       parse4 (' ':rest) header isLbl lib = parse4 rest         header isLbl lib
       parse4 str	header isLbl lib
-        | all (== ' ') rest              = build (_PK_ first)  header isLbl lib
+        | all (== ' ') rest              = build (mkFastString first)  header isLbl lib
 	| otherwise			 = parseError "Malformed entity string"
         where
 	  (first, rest) = break (== ' ') str
@@ -388,7 +388,7 @@ parseCImport entity cconv safety v
 -- construct a foreign export declaration
 --
 mkExport :: CallConv
-         -> (FAST_STRING, RdrName, RdrNameHsType) 
+         -> (FastString, RdrName, RdrNameHsType) 
 	 -> SrcLoc 
 	 -> P RdrNameHsDecl
 mkExport (CCall  cconv) (entity, v, ty) loc = returnP $ 
@@ -407,7 +407,7 @@ mkExport DNCall (entity, v, ty) loc =
 -- (This is why we use occNameUserString.)
 --
 mkExtName :: RdrName -> CLabelString
-mkExtName rdrNm = _PK_ (occNameUserString (rdrNameOcc rdrNm))
+mkExtName rdrNm = mkFastString (occNameUserString (rdrNameOcc rdrNm))
 
 -----------------------------------------------------------------------------
 -- group function bindings into equation groups
diff --git a/ghc/compiler/parser/Parser.y b/ghc/compiler/parser/Parser.y
index 39f3335c6c..3ecaff1a42 100644
--- a/ghc/compiler/parser/Parser.y
+++ b/ghc/compiler/parser/Parser.y
@@ -1,6 +1,6 @@
 {-								-*-haskell-*-
 -----------------------------------------------------------------------------
-$Id: Parser.y,v 1.95 2002/04/02 13:56:32 simonmar Exp $
+$Id: Parser.y,v 1.96 2002/04/29 14:03:57 simonmar Exp $
 
 Haskell grammar.
 
@@ -597,7 +597,7 @@ fdecl1DEPRECATED :: { Bool -> SrcLoc -> ForeignDecl RdrName }
 fdecl1DEPRECATED 
   ----------- DEPRECATED label decls ------------
   : 'label' ext_name varid '::' sigtype
-    { ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) _NIL_ _NIL_ 
+    { ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS 
 				   (CLabel ($2 `orElse` mkExtName $3))) }
 
   ----------- DEPRECATED ccall/stdcall decls ------------
@@ -611,7 +611,7 @@ fdecl1DEPRECATED
     { let
 	target = StaticTarget ($2 `orElse` mkExtName $4)
       in
-      ForeignImport $4 $6 (CImport defaultCCallConv $3 _NIL_ _NIL_ 
+      ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS 
 				   (CFunction target)) }
 
     -- DEPRECATED variant #2: external name consists of two separate strings
@@ -623,7 +623,7 @@ fdecl1DEPRECATED
            let
 	     imp = CFunction (StaticTarget $4)
 	   in
-	   ForeignImport $6 $8 (CImport cconv $5 _NIL_ _NIL_ imp) }
+	   ForeignImport $6 $8 (CImport cconv $5 nilFS nilFS imp) }
 
     -- DEPRECATED variant #3: `unsafe' after entity
   | 'import' callconv STRING 'unsafe' varid_no_unsafe '::' sigtype
@@ -633,12 +633,12 @@ fdecl1DEPRECATED
            let
 	     imp = CFunction (StaticTarget $3)
 	   in
-	   ForeignImport $5 $7 (CImport cconv PlayRisky _NIL_ _NIL_ imp) }
+	   ForeignImport $5 $7 (CImport cconv PlayRisky nilFS nilFS imp) }
 
     -- DEPRECATED variant #4: use of the special identifier `dynamic' without
     --			      an explicit calling convention (import)
   | 'import' {-no callconv-} 'dynamic' safety varid_no_unsafe '::' sigtype
-    { ForeignImport $4 $6 (CImport defaultCCallConv $3 _NIL_ _NIL_ 
+    { ForeignImport $4 $6 (CImport defaultCCallConv $3 nilFS nilFS 
 				   (CFunction DynamicTarget)) }
 
     -- DEPRECATED variant #5: use of the special identifier `dynamic' (import)
@@ -646,7 +646,7 @@ fdecl1DEPRECATED
     {% case $2 of
          DNCall      -> parseError "Illegal format of .NET foreign import"
 	 CCall cconv -> returnP $
-	   ForeignImport $5 $7 (CImport cconv $4 _NIL_ _NIL_ 
+	   ForeignImport $5 $7 (CImport cconv $4 nilFS nilFS 
 					(CFunction DynamicTarget)) }
 
     -- DEPRECATED variant #6: lack of a calling convention specification
@@ -667,7 +667,7 @@ fdecl1DEPRECATED
     -- DEPRECATED variant #8: use of the special identifier `dynamic' without
     --			      an explicit calling convention (export)
   | 'export' {-no callconv-} 'dynamic' varid '::' sigtype
-    { ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) _NIL_ _NIL_ 
+    { ForeignImport $3 $5 (CImport defaultCCallConv (PlaySafe False) nilFS nilFS 
 				   CWrapper) }
 
     -- DEPRECATED variant #9: use of the special identifier `dynamic' (export)
@@ -675,7 +675,7 @@ fdecl1DEPRECATED
     {% case $2 of
          DNCall      -> parseError "Illegal format of .NET foreign import"
 	 CCall cconv -> returnP $
-	   ForeignImport $4 $6 (CImport cconv (PlaySafe False) _NIL_ _NIL_ CWrapper) }
+	   ForeignImport $4 $6 (CImport cconv (PlaySafe False) nilFS nilFS CWrapper) }
 
   ----------- DEPRECATED .NET decls ------------
   -- NB: removed the .NET call declaration, as it is entirely subsumed
@@ -706,9 +706,9 @@ safety1 :: { Safety }
 	| 'threadsafe'			{ PlaySafe  True }
 	  -- only needed to avoid conflicts with the DEPRECATED rules
 
-fspec :: { (FAST_STRING, RdrName, RdrNameHsType) }
+fspec :: { (FastString, RdrName, RdrNameHsType) }
        : STRING varid '::' sigtype      { ($1      , $2, $4) }
-       |        varid '::' sigtype      { (SLIT(""), $1, $3) }
+       |        varid '::' sigtype      { (nilFS, $1, $3) }
          -- if the entity string is missing, it defaults to the empty string;
          -- the meaning of an empty entity string depends on the calling
          -- convention
@@ -981,11 +981,11 @@ exp10 :: { RdrNameHsExpr }
 
 	| fexp					{ $1 }
 
-scc_annot :: { FAST_STRING }
+scc_annot :: { FastString }
 	: '_scc_' STRING			{ $2 }
 	| '{-# SCC' STRING '#-}'		{ $2 }
 
-ccallid :: { FAST_STRING }
+ccallid :: { FastString }
 	:  VARID				{ $1 }
 	|  CONID				{ $1 }
 
diff --git a/ghc/compiler/parser/ParserCore.y b/ghc/compiler/parser/ParserCore.y
index e24779a28b..bcedf8c7f4 100644
--- a/ghc/compiler/parser/ParserCore.y
+++ b/ghc/compiler/parser/ParserCore.y
@@ -15,6 +15,7 @@ import Literal
 import BasicTypes
 import Type
 import SrcLoc
+import FastString
 
 #include "../HsVersions.h"
 
@@ -203,10 +204,10 @@ lit	:: { Literal }
 	: '(' INTEGER '::' aty ')'	{ MachInt $2 }
 	| '(' RATIONAL '::' aty ')'	{ MachDouble $2 }
 	| '(' CHAR '::' aty ')'		{ MachChar (fromEnum $2) }
-	| '(' STRING '::' aty ')'	{ MachStr (_PK_ $2) }
+	| '(' STRING '::' aty ')'	{ MachStr (mkFastString $2) }
 
 name	:: { RdrName }
-	: NAME	{ mkRdrUnqual (mkVarOccEncoded (_PK_ $1)) }
+	: NAME	{ mkRdrUnqual (mkVarOccEncoded (mkFastString $1)) }
 
 cname	:: { String }
 	: CNAME	{ $1 }
@@ -215,22 +216,22 @@ mname	:: { String }
 	: CNAME	{ $1 }
 
 modid	:: { ModuleName }
-	: CNAME	{ mkSysModuleNameFS (_PK_ $1) }
+	: CNAME	{ mkSysModuleNameFS (mkFastString $1) }
 
 qname	:: { RdrName }
 	: name	{ $1 }
 	| mname '.' NAME
-	  { mkIfaceOrig varName (_PK_ $1,_PK_ $3) }
+	  { mkIfaceOrig varName (mkFastString $1,mkFastString $3) }
 
 -- Type constructor
 q_tc_name	:: { RdrName }
         : mname '.' cname 
-		{ mkIfaceOrig tcName (_PK_ $1,_PK_ $3) }
+		{ mkIfaceOrig tcName (mkFastString $1,mkFastString $3) }
 
 -- Data constructor
 q_d_name	:: { RdrName }
         : mname '.' cname 
-		{ mkIfaceOrig dataName (_PK_ $1,_PK_ $3) }
+		{ mkIfaceOrig dataName (mkFastString $1,mkFastString $3) }
 
 
 {