From 517f65a7cc3e94b9c4ad574369a32c48e0a95be6 Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Tue, 23 Jan 2018 21:29:58 +0100
Subject: Lua filters: store constructors in registry

Lua functions used to construct AST element values are stored in the Lua
registry for quicker access. Getting a value from the registry is much
faster than getting a global value (partly to idiosyncrasies of hslua);
this change results in a considerable performance boost.
---
 src/Text/Pandoc/Lua/Init.hs          | 25 +++++++++++++++++++++++++
 src/Text/Pandoc/Lua/Module/Pandoc.hs |  2 +-
 src/Text/Pandoc/Lua/Util.hs          |  5 +++--
 3 files changed, 29 insertions(+), 3 deletions(-)

(limited to 'src/Text/Pandoc')

diff --git a/src/Text/Pandoc/Lua/Init.hs b/src/Text/Pandoc/Lua/Init.hs
index f3ee2caf1..d1a26ebad 100644
--- a/src/Text/Pandoc/Lua/Init.hs
+++ b/src/Text/Pandoc/Lua/Init.hs
@@ -34,6 +34,7 @@ module Text.Pandoc.Lua.Init
   ) where
 
 import Control.Monad.Trans (MonadIO (..))
+import Data.Data (Data, dataTypeConstrs, dataTypeOf, showConstr)
 import Data.IORef (newIORef, readIORef)
 import Data.Version (Version (versionBranch))
 import Foreign.Lua (Lua, LuaException (..))
@@ -48,6 +49,7 @@ import Text.Pandoc.Lua.Util (loadScriptFromDataDir)
 
 import qualified Foreign.Lua as Lua
 import qualified Foreign.Lua.Module.Text as Lua
+import qualified Text.Pandoc.Definition as Pandoc
 
 -- | Run the lua interpreter, using pandoc's default way of environment
 -- initalization.
@@ -84,3 +86,26 @@ initLuaState luaPkgParams = do
   Lua.setglobal "PANDOC_API_VERSION"
   installPandocPackageSearcher luaPkgParams
   loadScriptFromDataDir (luaPkgDataDir luaPkgParams) "init.lua"
+  putConstructorsInRegistry
+
+putConstructorsInRegistry :: Lua ()
+putConstructorsInRegistry = do
+  Lua.getglobal "pandoc"
+  constrsToReg $ Pandoc.Pandoc mempty mempty
+  constrsToReg $ Pandoc.Str mempty
+  constrsToReg $ Pandoc.Para mempty
+  constrsToReg $ Pandoc.Meta mempty
+  constrsToReg $ Pandoc.MetaList mempty
+  constrsToReg $ Pandoc.Citation mempty mempty mempty Pandoc.AuthorInText 0 0
+  putInReg "Attr"  -- used for Attr type alias
+  Lua.pop 1
+ where
+  constrsToReg :: Data a => a -> Lua ()
+  constrsToReg = mapM_ putInReg . map showConstr . dataTypeConstrs . dataTypeOf
+
+  putInReg :: String -> Lua ()
+  putInReg name = do
+    Lua.push ("pandoc." ++ name) -- name in registry
+    Lua.push name -- in pandoc module
+    Lua.rawget (Lua.nthFromTop 3)
+    Lua.rawset Lua.registryindex
diff --git a/src/Text/Pandoc/Lua/Module/Pandoc.hs b/src/Text/Pandoc/Lua/Module/Pandoc.hs
index f458d4773..b9410a353 100644
--- a/src/Text/Pandoc/Lua/Module/Pandoc.hs
+++ b/src/Text/Pandoc/Lua/Module/Pandoc.hs
@@ -82,7 +82,7 @@ readDoc content formatSpecOrNil = do
           res <- liftIO $ runIO $ r def{ readerExtensions = es } (pack content)
           case res of
             Right pd -> (1 :: NumResults) <$ Lua.push pd -- success, push Pandoc
-            Left s   -> Lua.raiseError (show s)              -- error while reading
+            Left s   -> Lua.raiseError (show s)          -- error while reading
         _  -> Lua.raiseError "Only string formats are supported at the moment."
 
 -- | Pipes input through a command.
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index f82ec4753..b7149af39 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -50,7 +50,7 @@ import Control.Monad (when)
 import Control.Monad.Catch (finally)
 import Data.ByteString.Char8 (unpack)
 import Foreign.Lua (FromLuaStack (..), NumResults, Lua, NumArgs, StackIndex,
-                    ToLuaStack (..), ToHaskellFunction, getglobal')
+                    ToLuaStack (..), ToHaskellFunction)
 import Foreign.Lua.Api (Status, call, pop, rawget, rawgeti, rawset, rawseti)
 import Text.Pandoc.Class (readDataFile, runIOorExplode, setUserDataDir)
 
@@ -131,7 +131,8 @@ class PushViaCall a where
 
 instance PushViaCall (Lua ()) where
   pushViaCall' fn pushArgs num = do
-    getglobal' fn
+    Lua.push fn
+    Lua.rawget (Lua.registryindex)
     pushArgs
     call num 1
 
-- 
cgit v1.2.3