From a420bf024f1dd102f9493ce029c8523e6289f548 Mon Sep 17 00:00:00 2001 From: Justin Bedo Date: Fri, 18 Oct 2024 09:51:40 +1100 Subject: implement Boyer-Moore bad match skipping --- jterm.hs | 21 ++++++++++++++++++++- package.yaml | 1 + 2 files changed, 21 insertions(+), 1 deletion(-) 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] -- cgit v1.2.3