b9c7adf · typeable/pandoc

git.iko.soy/typeable/pandoc

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).

commitb9c7adf02ee5da08e97746e9638ddcb162ff651d authorAlbert Krewinkel <albert@zeitkraut.de> dateSun 13 Aug 2017, 14:23 (9 years ago) parent2dc3dbd

2 files changed+27−17

compare with master

unifiedsplit

src/Text/Pandoc/Lua/StackInstances.hs+21−6 src/Text/Pandoc/Lua/Util.hs+6−11

src/Text/Pandoc/Lua/StackInstances.hs+21−6

@@ -34,11 +34,11 @@ module Text.Pandoc.Lua.StackInstances () where

3434

3535import Control.Applicative ((<|>))

3636import Foreign.Lua (Lua, Type (..), FromLuaStack (peek), ToLuaStack (push),

37− StackIndex, peekEither, throwLuaError)

38−import Foreign.Lua.Api (getfield, ltype, newtable, pop, rawlen)

37+ StackIndex, throwLuaError, tryLua)

38+import Foreign.Lua.Api (getmetatable, ltype, newtable, pop, rawget, rawlen)

3939import Text.Pandoc.Definition

4040import Text.Pandoc.Lua.SharedInstances ()

41−import Text.Pandoc.Lua.Util (addValue, getTable, pushViaConstructor)

41+import Text.Pandoc.Lua.Util (addValue, adjustIndexBy, getTable, pushViaConstructor)

4242import Text.Pandoc.Shared (safeRead)

4343

4444instance ToLuaStack Pandoc where

@@ -46,6 +46,7 @@ instance ToLuaStack Pandoc where

4646 newtable

4747 addValue "blocks" blocks

4848 addValue "meta" meta

49+

4950instance FromLuaStack Pandoc where

5051 peek idx = do

5152 blocks <- getTable idx "blocks"

@@ -151,7 +152,7 @@ peekMetaValue idx = do

151152 TypeBoolean -> MetaBool <$> peek idx

152153 TypeString -> MetaString <$> peek idx

153154 TypeTable -> do

154− tag <- getfield idx "t" *> peekEither (-1) <* pop 1

155+ tag <- tryLua $ getTag idx

155156 case tag of

156157 Right "MetaBlocks" -> MetaBlocks <$> elementContent

157158 Right "MetaBool" -> MetaBool <$> elementContent

@@ -192,7 +193,7 @@ pushBlock = \case

192193-- | Return the value at the given index as block if possible.

193194peekBlock :: StackIndex -> Lua Block

194195peekBlock idx = do

195− tag <- getTable idx "t"

196+ tag <- getTag idx

196197 case tag of

197198 "BlockQuote" -> BlockQuote <$> elementContent

198199 "BulletList" -> BulletList <$> elementContent

@@ -243,7 +244,7 @@ pushInline = \case

243244-- | Return the value at the given index as inline if possible.

244245peekInline :: StackIndex -> Lua Inline

245246peekInline idx = do

246− tag <- getTable idx "t"

247+ tag <- getTag idx

247248 case tag of

248249 "Cite" -> (uncurry Cite) <$> elementContent

249250 "Code" -> (withAttr Code) <$> elementContent

@@ -272,6 +273,19 @@ peekInline idx = do

272273 elementContent :: FromLuaStack a => Lua a

273274 elementContent = getTable idx "c"

274275

276+getTag :: StackIndex -> Lua String

277+getTag idx = do

278+ hasMT <- getmetatable idx

279+ if hasMT

280+ then do

281+ push "tag"

282+ rawget (-2)

283+ peek (-1) <* pop 2

284+ else do

285+ push "tag"

286+ rawget (idx `adjustIndexBy` 1)

287+ peek (-1) <* pop 1

288+

275289withAttr :: (Attr -> a -> b) -> (LuaAttr, a) -> b

276290withAttr f (attributes, x) = f (fromLuaAttr attributes) x

277291

@@ -281,5 +295,6 @@ newtype LuaAttr = LuaAttr { fromLuaAttr :: Attr }

281295instance ToLuaStack LuaAttr where

282296 push (LuaAttr (id', classes, kv)) =

283297 pushViaConstructor "Attr" id' classes kv

298+

284299instance FromLuaStack LuaAttr where

285300 peek idx = LuaAttr <$> peek idx

src/Text/Pandoc/Lua/Util.hs+6−11

@@ -31,7 +31,6 @@ Lua utility functions.

3131module Text.Pandoc.Lua.Util

3232 ( adjustIndexBy

3333 , getTable

34− , setTable

3534 , addValue

3635 , getRawInt

3736 , setRawInt

@@ -43,7 +42,7 @@ module Text.Pandoc.Lua.Util

4342

4443import Foreign.Lua (Lua, FromLuaStack (..), ToLuaStack (..), NumArgs,

4544 StackIndex, getglobal')

46−import Foreign.Lua.Api (call, gettable, pop, rawgeti, rawseti, settable)

45+import Foreign.Lua.Api (call, pop, rawget, rawgeti, rawset, rawseti)

4746

4847-- | Adjust the stack index, assuming that @n@ new elements have been pushed on

4948-- the stack.

@@ -57,19 +56,15 @@ adjustIndexBy idx n =

5756getTable :: (ToLuaStack a, FromLuaStack b) => StackIndex -> a -> Lua b

5857getTable idx key = do

5958 push key

60− gettable (idx `adjustIndexBy` 1)

59+ rawget (idx `adjustIndexBy` 1)

6160 peek (-1) <* pop 1

6261

63−-- | Set value for key for table at the given index

64−setTable :: (ToLuaStack a, ToLuaStack b) => StackIndex -> a -> b -> Lua ()

65−setTable idx key value = do

66− push key

67− push value

68− settable (idx `adjustIndexBy` 2)

69−

7062-- | Add a key-value pair to the table at the top of the stack

7163addValue :: (ToLuaStack a, ToLuaStack b) => a -> b -> Lua ()

72−addValue = setTable (-1)

64+addValue key value = do

65+ push key

66+ push value

67+ rawset (-3)

7368

7469-- | Get value behind key from table at given index.

7570getRawInt :: FromLuaStack a => StackIndex -> Int -> Lua a