b9c7adf · typeable/pandoc

git.iko.soy/typeable/pandoc

on master help sign in

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

b9c7adfAlbert Krewinkel9 years ago

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

compare with master

unifiedsplit

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

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

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

37− StackIndex, peekEither, throwLuaError)

37+ StackIndex, throwLuaError, tryLua)

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

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

39import Text.Pandoc.Definition

40import Text.Pandoc.Lua.SharedInstances ()

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

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

42import Text.Pandoc.Shared (safeRead)

44instance ToLuaStack Pandoc where

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

46 newtable

47 addValue "blocks" blocks

48 addValue "meta" meta

49+

49instance FromLuaStack Pandoc where

50instance FromLuaStack Pandoc where

50 peek idx = do

51 peek idx = do

51 blocks <- getTable idx "blocks"

52 blocks <- getTable idx "blocks"

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

151 TypeBoolean -> MetaBool <$> peek idx

152 TypeBoolean -> MetaBool <$> peek idx

152 TypeString -> MetaString <$> peek idx

153 TypeString -> MetaString <$> peek idx

153 TypeTable -> do

154 TypeTable -> do

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

155+ tag <- tryLua $ getTag idx

155 case tag of

156 case tag of

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

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

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

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

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

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

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

193peekBlock :: StackIndex -> Lua Block

194peekBlock :: StackIndex -> Lua Block

194peekBlock idx = do

195peekBlock idx = do

195− tag <- getTable idx "t"

196+ tag <- getTag idx

196 case tag of

197 case tag of

197 "BlockQuote" -> BlockQuote <$> elementContent

198 "BlockQuote" -> BlockQuote <$> elementContent

198 "BulletList" -> BulletList <$> elementContent

199 "BulletList" -> BulletList <$> elementContent

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

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

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

244peekInline :: StackIndex -> Lua Inline

245peekInline :: StackIndex -> Lua Inline

245peekInline idx = do

246peekInline idx = do

246− tag <- getTable idx "t"

247+ tag <- getTag idx

247 case tag of

248 case tag of

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

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

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

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

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

272 elementContent :: FromLuaStack a => Lua a

273 elementContent :: FromLuaStack a => Lua a

273 elementContent = getTable idx "c"

274 elementContent = getTable idx "c"

274

275

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+

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

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

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

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

277

291

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

281instance ToLuaStack LuaAttr where

295instance ToLuaStack LuaAttr where

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

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

283 pushViaConstructor "Attr" id' classes kv

297 pushViaConstructor "Attr" id' classes kv

298+

284instance FromLuaStack LuaAttr where

299instance FromLuaStack LuaAttr where

285 peek idx = LuaAttr <$> peek idx

300 peek idx = LuaAttr <$> peek idx

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

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

31module Text.Pandoc.Lua.Util

32 ( adjustIndexBy

33 , getTable

34− , setTable

35 , addValue

34 , addValue

36 , getRawInt

35 , getRawInt

37 , setRawInt

36 , setRawInt

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

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

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

45 StackIndex, getglobal')

44 StackIndex, getglobal')

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

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

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

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

49-- the stack.

48-- the stack.

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

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

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

58getTable idx key = do

57getTable idx key = do

59 push key

58 push key

60− gettable (idx `adjustIndexBy` 1)

59+ rawget (idx `adjustIndexBy` 1)

61 peek (-1) <* pop 1

60 peek (-1) <* pop 1

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−

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

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

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

63addValue :: (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)

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

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

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

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