summaryrefslogtreecommitdiff
path: root/escapexml/EscapeXML.hs
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2026-05-10 18:54:45 +0200
committerTom Smeding <tom@tomsmeding.com>2026-05-10 18:54:45 +0200
commit5d6f1f42eec48ae1671e54cdd127f39318416498 (patch)
tree58672af74066d702fef81c5fdc9587de77d42c57 /escapexml/EscapeXML.hs
parent66e9a4f242b9f02a7fcf6b5fc610417a50e1ba87 (diff)
Generate renderer functions using TH
These take (and project from) a data type instead of hash maps, _and_ use text-builder-linear, _and_ have the full template inlined. The result is that this is the fastest renderer yet.
Diffstat (limited to 'escapexml/EscapeXML.hs')
-rw-r--r--escapexml/EscapeXML.hs37
1 files changed, 37 insertions, 0 deletions
diff --git a/escapexml/EscapeXML.hs b/escapexml/EscapeXML.hs
new file mode 100644
index 0000000..662d2ed
--- /dev/null
+++ b/escapexml/EscapeXML.hs
@@ -0,0 +1,37 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+module EscapeXML (escapeXML) where
+
+import Data.Array.Byte
+import Data.Text.Internal
+import Foreign.C.Types
+import GHC.Exts
+import GHC.IO (IO(IO))
+import System.IO.Unsafe (unsafePerformIO)
+
+
+foreign import ccall unsafe "tirclogv_escapexml_len"
+ c_escapexml_len :: ByteArray# -> CSize -> CSize -> IO CSize
+
+foreign import ccall unsafe "tirclogv_escapexml"
+ c_escapexml :: MutableByteArray# RealWorld -> ByteArray# -> CSize -> CSize -> IO ()
+
+{-# NOINLINE escapeXML #-}
+escapeXML :: Text -> Text
+escapeXML (Text (ByteArray src#) off len) = unsafePerformIO $ do
+ let offCS = fromIntegral @Int @CSize off
+ lenCS = fromIntegral @Int @CSize len
+
+ reslen <- c_escapexml_len src# offCS lenCS
+ let !reslenI@(I# reslen#) = fromIntegral @CSize @Int reslen
+
+ MutableByteArray dst# <-
+ IO $ \s -> case newByteArray# reslen# s of
+ (# s', mba# #) -> (# s', MutableByteArray mba# #)
+ c_escapexml dst# src# offCS lenCS
+ ba <- IO $ \s -> case unsafeFreezeByteArray# dst# s of
+ (# s', ba# #) -> (# s', ByteArray ba# #)
+
+ return (Text ba 0 reslenI)