HsStringPrim now contains FastBytes, not FastString

9 files changed, 34 insertions, 15 deletions

diff --git a/compiler/deSugar/Check.lhs b/compiler/deSugar/Check.lhs
index 4910e1f4f3..75c3d11b91 100644
--- a/compiler/deSugar/Check.lhs
+++ b/compiler/deSugar/Check.lhs
@@ -445,7 +445,7 @@ get_lit :: Pat id -> Maybe HsLit
 get_lit (LitPat lit)                                      = Just lit
 get_lit (NPat (OverLit { ol_val = HsIntegral i})    mb _) = Just (HsIntPrim   (mb_neg negate              mb i))
 get_lit (NPat (OverLit { ol_val = HsFractional f }) mb _) = Just (HsFloatPrim (mb_neg negateFractionalLit mb f))
-get_lit (NPat (OverLit { ol_val = HsIsString s })   _  _) = Just (HsStringPrim s)
+get_lit (NPat (OverLit { ol_val = HsIsString s })   _  _) = Just (HsStringPrim (fastStringToFastBytes s))
 get_lit _                                                 = Nothing
 
 mb_neg :: (a -> a) -> Maybe b -> a -> a
diff --git a/compiler/deSugar/MatchLit.lhs b/compiler/deSugar/MatchLit.lhs
index a3fe356660..4032093541 100644
--- a/compiler/deSugar/MatchLit.lhs
+++ b/compiler/deSugar/MatchLit.lhs
@@ -69,7 +69,7 @@ See also below where we look for @DictApps@ for \tr{plusInt}, etc.
 
 \begin{code}
 dsLit :: HsLit -> DsM CoreExpr
-dsLit (HsStringPrim s) = return (Lit (MachStr (fastStringToFastBytes s)))
+dsLit (HsStringPrim s) = return (Lit (MachStr s))
 dsLit (HsCharPrim   c) = return (Lit (MachChar c))
 dsLit (HsIntPrim    i) = return (Lit (MachInt i))
 dsLit (HsWordPrim   w) = return (Lit (MachWord w))
@@ -124,7 +124,7 @@ hsLitKey (HsWordPrim    w) = mkMachWord w
 hsLitKey (HsInt64Prim   i) = mkMachInt64  i
 hsLitKey (HsWord64Prim  w) = mkMachWord64 w
 hsLitKey (HsCharPrim    c) = MachChar   c
-hsLitKey (HsStringPrim  s) = MachStr    (fastStringToFastBytes s)
+hsLitKey (HsStringPrim  s) = MachStr    s
 hsLitKey (HsFloatPrim   f) = MachFloat  (fl_value f)
 hsLitKey (HsDoublePrim  d) = MachDouble (fl_value d)
 hsLitKey (HsString s)      = MachStr    (fastStringToFastBytes s)
diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs
index a5839c2406..3ad5aa03fa 100644
--- a/compiler/hsSyn/Convert.lhs
+++ b/compiler/hsSyn/Convert.lhs
@@ -719,7 +719,7 @@ cvtLit (CharL c)       = do { force c; return $ HsChar c }
 cvtLit (StringL s)     = do { let { s' = mkFastString s }
        		       	    ; force s'
        		       	    ; return $ HsString s' }
-cvtLit (StringPrimL s) = do { let { s' = mkFastStringByteList s }
+cvtLit (StringPrimL s) = do { let { s' = mkFastBytesByteList s }
        			    ; force s'
        			    ; return $ HsStringPrim s' }
 cvtLit _ = panic "Convert.cvtLit: Unexpected literal"
diff --git a/compiler/hsSyn/HsLit.lhs b/compiler/hsSyn/HsLit.lhs
index efa61dde67..6ed92eb8a9 100644
--- a/compiler/hsSyn/HsLit.lhs
+++ b/compiler/hsSyn/HsLit.lhs
@@ -60,7 +60,7 @@ data HsLit
   = HsChar	    Char		-- Character
   | HsCharPrim	    Char		-- Unboxed character
   | HsString	    FastString		-- String
-  | HsStringPrim    FastString		-- Packed string
+  | HsStringPrim    FastBytes		-- Packed bytes
   | HsInt	    Integer		-- Genuinely an Int; arises from TcGenDeriv, 
 					--	and from TRANSLATION
   | HsIntPrim       Integer             -- literal Int#
@@ -170,7 +170,7 @@ instance Outputable HsLit where
     ppr (HsChar c)	 = pprHsChar c
     ppr (HsCharPrim c)	 = pprHsChar c <> char '#'
     ppr (HsString s)	 = pprHsString s
-    ppr (HsStringPrim s) = pprHsString s <> char '#'
+    ppr (HsStringPrim s) = pprHsBytes s <> char '#'
     ppr (HsInt i)	 = integer i
     ppr (HsInteger i _)	 = integer i
     ppr (HsRat f _)	 = ppr f
diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x
index 114f7f6b32..24a5a4ad54 100644
--- a/compiler/parser/Lexer.x
+++ b/compiler/parser/Lexer.x
@@ -551,7 +551,7 @@ data Token
   | ITrational   FractionalLit
 
   | ITprimchar   Char
-  | ITprimstring FastString
+  | ITprimstring FastBytes
   | ITprimint    Integer
   | ITprimword   Integer
   | ITprimfloat  FractionalLit
@@ -1227,10 +1227,8 @@ lex_string s = do
                    setInput i
                    if any (> '\xFF') s
                     then failMsgP "primitive string literal must contain only characters <= \'\\xFF\'"
-                    else let s' = mkZFastString (reverse s) in
-                         return (ITprimstring s')
-                        -- mkZFastString is a hack to avoid encoding the
-                        -- string in UTF-8.  We just want the exact bytes.
+                    else let bs = map (fromIntegral . ord) (reverse s)
+                         in return (ITprimstring (mkFastBytesByteList bs))
               _other ->
                 return (ITstring (mkFastString (reverse s)))
           else
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index d27ef98e80..c81243a3d4 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -45,6 +45,7 @@ import NameSet
 import RdrName
 import LoadIface	( loadInterfaceForName )
 import UniqSet
+import Data.Char
 import Data.List
 import Util
 import ListSetOps	( removeDups )
@@ -1167,7 +1168,7 @@ segsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later
 \begin{code}
 srcSpanPrimLit :: DynFlags -> SrcSpan -> HsExpr Name
 srcSpanPrimLit dflags span
-    = HsLit (HsStringPrim (mkFastString (showSDocOneLine dflags (ppr span))))
+    = HsLit (HsStringPrim (mkFastBytesByteList (map (fromIntegral . ord) (showSDocOneLine dflags (ppr span)))))
 
 mkAssertErrorExpr :: RnM (HsExpr Name)
 -- Return an expression for (assertError "Foo.hs:27")
diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 9eb747ad51..8fa67f0705 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -67,6 +67,7 @@ import SrcLoc
 import Util
 
 import Control.Monad
+import Data.Char
 import Maybes     ( orElse )
 \end{code}
 
@@ -1107,7 +1108,7 @@ tcInstanceMethods dfun_id clas tyvars dfun_ev_vars inst_tys
       where
         error_rhs dflags = L loc $ HsApp error_fun (error_msg dflags)
         error_fun    = L loc $ wrapId (WpTyApp meth_tau) nO_METHOD_BINDING_ERROR_ID
-        error_msg dflags = L loc (HsLit (HsStringPrim (mkFastString (error_string dflags))))
+        error_msg dflags = L loc (HsLit (HsStringPrim (mkFastBytesByteList (map (fromIntegral . ord) (error_string dflags)))))
         meth_tau     = funResultTy (applyTys (idType sel_id) inst_tys)
         error_string dflags = showSDoc dflags (hcat [ppr loc, text "|", ppr sel_id ])
         lam_wrapper  = mkWpTyLams tyvars <.> mkWpLams dfun_ev_vars
diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs
index 2872f46a3e..9a694cff4e 100644
--- a/compiler/typecheck/TcTyClsDecls.lhs
+++ b/compiler/typecheck/TcTyClsDecls.lhs
@@ -66,6 +66,7 @@ import BasicTypes
 
 import Bag
 import Control.Monad
+import Data.Char
 import Data.List
 \end{code}
 
@@ -1627,7 +1628,7 @@ mkRecSelBind (tycon, sel_name)
     inst_tys = tyConAppArgs data_ty
 
     unit_rhs = mkLHsTupleExpr []
-    msg_lit = HsStringPrim $ mkFastString $ 
+    msg_lit = HsStringPrim $ mkFastBytesByteList $ map (fromIntegral . ord) $
               occNameString (getOccName sel_name)
 
 ---------------
diff --git a/compiler/utils/FastString.lhs b/compiler/utils/FastString.lhs
index 05a379808e..a340e6eedb 100644
--- a/compiler/utils/FastString.lhs
+++ b/compiler/utils/FastString.lhs
@@ -31,6 +31,7 @@ module FastString
         mkFastStringFastBytes,
         foreignPtrToFastBytes,
         fastStringToFastBytes,
+        mkFastBytesByteList,
         bytesFB,
         hashFB,
         lengthFB,
@@ -109,7 +110,7 @@ import System.IO.Unsafe ( unsafePerformIO )
 import Data.Data
 import Data.IORef       ( IORef, newIORef, readIORef, writeIORef )
 import Data.Maybe       ( isJust )
-import Data.Char        ( ord )
+import Data.Char
 
 import GHC.IO           ( IO(..) )
 
@@ -144,6 +145,14 @@ instance Eq FastBytes where
 instance Ord FastBytes where
     compare = cmpFB
 
+instance Show FastBytes where
+    show fb = show (concatMap escape $ bytesFB fb) ++ "#"
+        where escape :: Word8 -> String
+              escape w = let c = chr (fromIntegral w)
+                         in if isAscii c
+                            then [c]
+                            else '\\' : show w
+
 foreignPtrToFastBytes :: ForeignPtr Word8 -> Int -> FastBytes
 foreignPtrToFastBytes fp len = FastBytes len fp
 
@@ -154,6 +163,15 @@ mkFastStringFastBytes (FastBytes len fp)
 fastStringToFastBytes :: FastString -> FastBytes
 fastStringToFastBytes f = FastBytes (n_bytes f) (buf f)
 
+mkFastBytesByteList :: [Word8] -> FastBytes
+mkFastBytesByteList bs =
+  inlinePerformIO $ do
+    let l = Prelude.length bs
+    buf <- mallocForeignPtrBytes l
+    withForeignPtr buf $ \ptr -> do
+      pokeArray (castPtr ptr) bs
+      return $ foreignPtrToFastBytes buf l
+
 -- | Gives the UTF-8 encoded bytes corresponding to a 'FastString'
 bytesFB :: FastBytes -> [Word8]
 bytesFB (FastBytes n_bytes buf) =