Commit 68ee44b8 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Small refactoring for FastZStrings

parent 28d13243
......@@ -1227,8 +1227,8 @@ lex_string s = do
setInput i
if any (> '\xFF') s
then failMsgP "primitive string literal must contain only characters <= \'\\xFF\'"
else let bs = map (fromIntegral . ord) (reverse s)
in return (ITprimstring (mkFastBytesByteList bs))
else let fb = unsafeMkFastBytesString (reverse s)
in return (ITprimstring fb)
_other ->
return (ITstring (mkFastString (reverse s)))
else
......
......@@ -45,7 +45,6 @@ import NameSet
import RdrName
import LoadIface ( loadInterfaceForName )
import UniqSet
import Data.Char
import Data.List
import Util
import ListSetOps ( removeDups )
......@@ -1168,7 +1167,7 @@ segsToStmts empty_rec_stmt ((defs, uses, fwds, ss) : segs) fvs_later
\begin{code}
srcSpanPrimLit :: DynFlags -> SrcSpan -> HsExpr Name
srcSpanPrimLit dflags span
= HsLit (HsStringPrim (mkFastBytesByteList (map (fromIntegral . ord) (showSDocOneLine dflags (ppr span)))))
= HsLit (HsStringPrim (unsafeMkFastBytesString (showSDocOneLine dflags (ppr span))))
mkAssertErrorExpr :: RnM (HsExpr Name)
-- Return an expression for (assertError "Foo.hs:27")
......
......@@ -67,7 +67,6 @@ import SrcLoc
import Util
import Control.Monad
import Data.Char
import Maybes ( orElse )
\end{code}
......@@ -1108,7 +1107,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 (mkFastBytesByteList (map (fromIntegral . ord) (error_string dflags)))))
error_msg dflags = L loc (HsLit (HsStringPrim (unsafeMkFastBytesString (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,7 +66,6 @@ import BasicTypes
import Bag
import Control.Monad
import Data.Char
import Data.List
\end{code}
......@@ -1628,7 +1627,7 @@ mkRecSelBind (tycon, sel_name)
inst_tys = tyConAppArgs data_ty
unit_rhs = mkLHsTupleExpr []
msg_lit = HsStringPrim $ mkFastBytesByteList $ map (fromIntegral . ord) $
msg_lit = HsStringPrim $ unsafeMkFastBytesString $
occNameString (getOccName sel_name)
---------------
......
......@@ -33,6 +33,7 @@ module FastString
fastStringToFastBytes,
fastZStringToFastBytes,
mkFastBytesByteList,
unsafeMkFastBytesString,
bytesFB,
hashFB,
lengthFB,
......@@ -179,6 +180,24 @@ mkFastBytesByteList bs =
pokeArray (castPtr ptr) bs
return $ foreignPtrToFastBytes buf l
-- This will drop information if any character > '\xFF'
unsafeMkFastBytesString :: String -> FastBytes
unsafeMkFastBytesString str =
inlinePerformIO $ do
let l = Prelude.length str
buf <- mallocForeignPtrBytes l
withForeignPtr buf $ \ptr -> do
pokeCAString (castPtr ptr) str
return $ foreignPtrToFastBytes buf l
pokeCAString :: Ptr CChar -> String -> IO ()
pokeCAString ptr str =
let
go [] !_ = return ()
go (c:cs) n = do pokeElemOff ptr n (castCharToCChar c); go cs (n+1)
in
go str 0
-- | Gives the UTF-8 encoded bytes corresponding to a 'FastString'
bytesFB :: FastBytes -> [Word8]
bytesFB (FastBytes n_bytes buf) =
......@@ -226,6 +245,9 @@ zString (FastZString (FastBytes n_bytes buf)) =
lengthFZS :: FastZString -> Int
lengthFZS (FastZString fb) = lengthFB fb
mkFastZStringString :: String -> FastZString
mkFastZStringString str = FastZString (unsafeMkFastBytesString str)
-- -----------------------------------------------------------------------------
{-|
......@@ -395,8 +417,7 @@ mkFastStringByteList str =
-- | Creates a Z-encoded 'FastString' from a 'String'
mkZFastString :: String -> FastZString
mkZFastString str = FastZString
$ mkFastBytesByteList $ map (fromIntegral . ord) str
mkZFastString = mkFastZStringString
bucket_match :: [FastString] -> Int -> Ptr Word8 -> IO (Maybe FastString)
bucket_match [] _ _ = return Nothing
......
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