Text.Pandoc.Lua: Optimize performance by using raw table access

Raw table accessing functions never call back into haskell, which allows
the compiler to use more aggressive optimizations. This improves lua
filter performance considerably (⪆5% speedup).

2 files changed, 27 insertions, 17 deletions

diff --git a/src/Text/Pandoc/Lua/StackInstances.hs b/src/Text/Pandoc/Lua/StackInstances.hs
index 4eea5bc2f..7d451a16a 100644
--- a/src/Text/Pandoc/Lua/StackInstances.hs
+++ b/src/Text/Pandoc/Lua/StackInstances.hs
@@ -34,11 +34,11 @@ module Text.Pandoc.Lua.StackInstances () where
 
 import Control.Applicative ((<|>))
 import Foreign.Lua (Lua, Type (..), FromLuaStack (peek), ToLuaStack (push),
-                    StackIndex, peekEither, throwLuaError)
-import Foreign.Lua.Api (getfield, ltype, newtable, pop, rawlen)
+                    StackIndex, throwLuaError, tryLua)
+import Foreign.Lua.Api (getmetatable, ltype, newtable, pop, rawget, rawlen)
 import Text.Pandoc.Definition
 import Text.Pandoc.Lua.SharedInstances ()
-import Text.Pandoc.Lua.Util (addValue, getTable, pushViaConstructor)
+import Text.Pandoc.Lua.Util (addValue, adjustIndexBy, getTable, pushViaConstructor)
 import Text.Pandoc.Shared (safeRead)
 
 instance ToLuaStack Pandoc where
@@ -46,6 +46,7 @@ instance ToLuaStack Pandoc where
     newtable
     addValue "blocks" blocks
     addValue "meta"   meta
+
 instance FromLuaStack Pandoc where
   peek idx = do
     blocks <- getTable idx "blocks"
@@ -151,7 +152,7 @@ peekMetaValue idx = do
     TypeBoolean -> MetaBool <$> peek idx
     TypeString  -> MetaString <$> peek idx
     TypeTable   -> do
-      tag <- getfield idx "t" *> peekEither (-1) <* pop 1
+      tag <- tryLua $ getTag idx
       case tag of
         Right "MetaBlocks"  -> MetaBlocks  <$> elementContent
         Right "MetaBool"    -> MetaBool    <$> elementContent
@@ -192,7 +193,7 @@ pushBlock = \case
 -- | Return the value at the given index as block if possible.
 peekBlock :: StackIndex -> Lua Block
 peekBlock idx = do
-  tag <- getTable idx "t"
+  tag <- getTag idx
   case tag of
       "BlockQuote"     -> BlockQuote <$> elementContent
       "BulletList"     -> BulletList <$> elementContent
@@ -243,7 +244,7 @@ pushInline = \case
 -- | Return the value at the given index as inline if possible.
 peekInline :: StackIndex -> Lua Inline
 peekInline idx = do
-  tag <- getTable idx "t"
+  tag <- getTag idx
   case tag of
     "Cite"       -> (uncurry Cite) <$> elementContent
     "Code"       -> (withAttr Code) <$> elementContent
@@ -272,6 +273,19 @@ peekInline idx = do
    elementContent :: FromLuaStack a => Lua a
    elementContent = getTable idx "c"
 
+getTag :: StackIndex -> Lua String
+getTag idx = do
+  hasMT <- getmetatable idx
+  if hasMT
+    then do
+      push "tag"
+      rawget (-2)
+      peek (-1) <* pop 2
+    else do
+      push "tag"
+      rawget (idx `adjustIndexBy` 1)
+      peek (-1) <* pop 1
+
 withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b
 withAttr f (attributes, x) = f (fromLuaAttr attributes) x
 
@@ -281,5 +295,6 @@ newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr }
 instance ToLuaStack LuaAttr where
   push (LuaAttr (id', classes, kv)) =
     pushViaConstructor "Attr" id' classes kv
+
 instance FromLuaStack LuaAttr where
   peek idx = LuaAttr <$> peek idx
diff --git a/src/Text/Pandoc/Lua/Util.hs b/src/Text/Pandoc/Lua/Util.hs
index 9e72b652c..1b6338e64 100644
--- a/src/Text/Pandoc/Lua/Util.hs
+++ b/src/Text/Pandoc/Lua/Util.hs
@@ -31,7 +31,6 @@ Lua utility functions.
 module Text.Pandoc.Lua.Util
   ( adjustIndexBy
   , getTable
-  , setTable
   , addValue
   , getRawInt
   , setRawInt
@@ -43,7 +42,7 @@ module Text.Pandoc.Lua.Util
 
 import Foreign.Lua (Lua, FromLuaStack (..), ToLuaStack (..), NumArgs,
                     StackIndex, getglobal')
-import Foreign.Lua.Api (call, gettable, pop, rawgeti, rawseti, settable)
+import Foreign.Lua.Api (call, pop, rawget, rawgeti, rawset, rawseti)
 
 -- | Adjust the stack index, assuming that @n@ new elements have been pushed on
 -- the stack.
@@ -57,19 +56,15 @@ adjustIndexBy idx n =
 getTable :: (ToLuaStack a, FromLuaStack b) => StackIndex -> a -> Lua b
 getTable idx key = do
   push key
-  gettable (idx `adjustIndexBy` 1)
+  rawget (idx `adjustIndexBy` 1)
   peek (-1) <* pop 1
 
--- | Set value for key for table at the given index
-setTable :: (ToLuaStack a, ToLuaStack b) => StackIndex -> a -> b -> Lua ()
-setTable idx key value = do
-  push key
-  push value
-  settable (idx `adjustIndexBy` 2)
-
 -- | Add a key-value pair to the table at the top of the stack
 addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()
-addValue = setTable (-1)
+addValue key value = do
+  push key
+  push value
+  rawset (-3)
 
 -- | Get value behind key from table at given index.
 getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a