Commit 3248fd92 authored by Ian Lynagh's avatar Ian Lynagh

HsStringPrim now contains FastBytes, not FastString

parent 7ae1bec5
......@@ -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
......
......@@ -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)
......
......@@ -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"
......
......@@ -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
......
......@@ -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
......
......@@ -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")
......
......@@ -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
......
......@@ -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)
---------------
......
......@@ -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) =
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment