From 519746dd6d98d7bce24eac317f5649865d301549 Mon Sep 17 00:00:00 2001
From: Adrian Cochrane <adrian@openwork.nz>
Date: Tue, 26 Sep 2023 10:52:22 +1300
Subject: [PATCH] Tell Haskell that its cheaper to recompute the data than
 store 40x the input text.

---
 Data/Text/Glyphize.hs        |  1 +
 Data/Text/Glyphize/Array.hs  | 11 ++++++++---
 Data/Text/Glyphize/Buffer.hs |  6 +++---
 3 files changed, 12 insertions(+), 6 deletions(-)

diff --git a/Data/Text/Glyphize.hs b/Data/Text/Glyphize.hs
index fd27933..bd6c894 100644
--- a/Data/Text/Glyphize.hs
+++ b/Data/Text/Glyphize.hs
@@ -32,6 +32,7 @@ module Data.Text.Glyphize (shape, version, versionAtLeast, versionString, Harfbu
 import Data.Text.Glyphize.Font
 import Data.Text.Glyphize.Buffer
 import Data.Text.Glyphize.Oom
+import Data.Text.Glyphize.Array (noCache)
 
 import System.IO.Unsafe (unsafePerformIO, unsafeDupablePerformIO)
 import Foreign.Ptr (Ptr(..))
diff --git a/Data/Text/Glyphize/Array.hs b/Data/Text/Glyphize/Array.hs
index 5f8173f..34f089a 100644
--- a/Data/Text/Glyphize/Array.hs
+++ b/Data/Text/Glyphize/Array.hs
@@ -10,7 +10,7 @@ import Foreign.Ptr
 import Foreign.Marshal.Array (copyArray)
 
 import GHC.IO (IO(IO))
-import GHC.Exts (realWorld#)
+import GHC.Exts (realWorld#, oneShot)
 
 clonePtr ptr l = do
     ret <- mallocForeignPtrArray l
@@ -28,9 +28,12 @@ peekEager acc n ptr = let n' = pred n in do
     peekEager (e:acc) n' ptr
 chunkSize = 1024 -- 4k, benchmarks seem to like it!
 iterateLazy :: Storable a => Ptr a -> Int -> IO [a]
-iterateLazy ptr l = do
+iterateLazy ptr l
+  | l < 0 = putStrLn ("Invalid array length: " ++ show l) >> return []
+  | l == 0 = return []
+  | otherwise = do
     fp <- clonePtr ptr l
-    return $ peekLazy fp $ fromEnum l
+    return $ noCache peekLazy fp $ fromEnum l
 
 -- | This \"function\" has a superficial similarity to 'System.IO.Unsafe.unsafePerformIO' but
 -- it is in fact a malevolent agent of chaos. It unpicks the seams of reality
@@ -63,3 +66,5 @@ iterateLazy ptr l = do
 {-# INLINE accursedUnutterablePerformIO #-}
 accursedUnutterablePerformIO :: IO a -> a
 accursedUnutterablePerformIO (IO m) = case m realWorld# of (# _, r #) -> r
+
+noCache = oneShot
diff --git a/Data/Text/Glyphize/Buffer.hs b/Data/Text/Glyphize/Buffer.hs
index bbe1cf7..5fad2d1 100644
--- a/Data/Text/Glyphize/Buffer.hs
+++ b/Data/Text/Glyphize/Buffer.hs
@@ -10,7 +10,7 @@ import Control.Exception (bracket)
 import Control.DeepSeq (NFData)
 
 import Data.Text.Glyphize.Oom (throwFalse, throwNull)
-import Data.Text.Glyphize.Array (iterateLazy)
+import Data.Text.Glyphize.Array (iterateLazy, noCache)
 
 import qualified Data.Text.Array as A
 import GHC.Exts (ByteArray#, sizeofByteArray#, Int#)
@@ -405,7 +405,7 @@ glyphInfos buf' = do
     arr <- throwNull $ hb_buffer_get_glyph_infos buf' nullPtr
     length <- hb_buffer_get_length buf'
     words <- iterateLazy arr (fromEnum length * 5)
-    return $ decodeInfos words
+    return $ noCache decodeInfos words
 foreign import ccall "hb_buffer_get_glyph_infos" hb_buffer_get_glyph_infos
     :: Buffer' -> Ptr Word -> IO (Ptr Word32)
 foreign import ccall "hb_buffer_get_length" hb_buffer_get_length :: Buffer' -> IO Word
@@ -437,7 +437,7 @@ glyphsPos buf' = do
     arr <- throwNull $ hb_buffer_get_glyph_positions buf' nullPtr
     length <- hb_buffer_get_length buf'
     words <- iterateLazy arr (fromEnum length * 5)
-    return $ decodePositions words
+    return $ noCache decodePositions words
 foreign import ccall "hb_buffer_get_glyph_positions" hb_buffer_get_glyph_positions
     :: Buffer' -> Ptr Word -> IO (Ptr Int32)
 -- NOTE: The array returned from FFI is valid as long as the buffer is.
-- 
2.30.2