implement Boyer-Moore bad match skipping

2 files changed, 21 insertions, 1 deletions

diff --git a/jterm.hs b/jterm.hs
index 24955b0..dd82048 100644
--- a/jterm.hs
+++ b/jterm.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ViewPatterns #-}
 
+import Control.Concurrent
 import Control.Exception
 import Control.Monad
 import Control.Monad.Trans
@@ -9,6 +10,7 @@ import Control.Monad.Trans.State
 import Data.Bits
 import qualified Data.ByteString.UTF8 as B
 import Data.Function
+import qualified Data.Map as M
 import Data.Maybe
 import Data.String.AnsiEscapeCodes.Strip.Text
 import Data.Text (Text)
@@ -16,6 +18,7 @@ import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Text.Rope (Position (..), Rope)
 import qualified Data.Text.Rope as R
+import Debug.Trace
 import Foreign.C.String
 import Foreign.C.Types
 import GHC.IO.Encoding
@@ -36,6 +39,17 @@ a -. b
   | b > a = 0
   | otherwise = a - b
 
+memo f = unsafePerformIO $ do
+  mvar <- newMVar M.empty
+  pure $ \x -> unsafePerformIO $ do
+    lut <- takeMVar mvar
+    case M.lookup x lut of
+      Just v -> pure v
+      Nothing -> do
+        let v = f x
+        putMVar mvar $ M.insert x v lut
+        pure v
+
 data Buffer = Buffer
   { pos :: Word,
     content :: Rope,
@@ -52,7 +66,12 @@ search needle haystack p = go (n - 1) (p + n)
     go i j
       | j > R.length haystack = Nothing
       | index needle i == index haystack j = if i == 0 then Just j else go (i - 1) (j - 1)
-      | otherwise = go (n - 1) $ j + n - i
+      | otherwise = go (n - 1) $ j + n - memo (match needle) (i, index haystack j)
+
+    match needle (i, c)
+      | i == 0 = 0
+      | index needle (i - 1) == c = i
+      | otherwise = match needle (i - 1, c)
 
     n = R.length needle
 
diff --git a/package.yaml b/package.yaml
index 01842b5..e040603 100644
--- a/package.yaml
+++ b/package.yaml
@@ -18,6 +18,7 @@ dependencies:
   - transformers
   - strip-ansi-escape
   - fusion-plugin
+  - containers
 
 ghc-options: [-O2, -fdicts-strict, -fspec-constr-recursive=16, -fmax-worker-args=16, -fplugin=Fusion.Plugin, -Wall, -Wno-name-shadowing, -threaded, -with-rtsopts=--nonmoving-gc]