From b9c7adf02ee5da08e97746e9638ddcb162ff651d Mon Sep 17 00:00:00 2001
From: Albert Krewinkel <albert@zeitkraut.de>
Date: Sun, 13 Aug 2017 14:23:25 +0200
Subject: Text.Pandoc.Lua: Optimize performance by using raw table access
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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).
---
src/Text/Pandoc/Lua/StackInstances.hs | 27 +++++++++++++++++++++------
src/Text/Pandoc/Lua/Util.hs | 17 ++++++-----------
2 files changed, 27 insertions(+), 17 deletions(-)
(limited to 'src/Text/Pandoc/Lua')
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
--
cgit v1.2.3