hslua-list (empty) → 1.0.0
raw patch · 7 files changed
+550/−0 lines, 7 filesdep +basedep +bytestringdep +hslua-core
Dependencies added: base, bytestring, hslua-core, hslua-list, hslua-marshalling, tasty, tasty-lua
Files
- CHANGELOG.md +9/−0
- LICENSE +20/−0
- README.md +6/−0
- cbits/listmod.c +354/−0
- hslua-list.cabal +71/−0
- src/HsLua/List.hs +56/−0
- test/test-hslua-list.hs +34/−0
+ CHANGELOG.md view
@@ -0,0 +1,9 @@+# Changelog++`hslua-list` uses [PVP Versioning](https://pvp.haskell.org).++## hslua-list-1.0.0++Released 2022-10-10.++- To boldly go where no Haskell library has gone before.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright © 2021-2022 Albert Krewinkel++Permission is hereby granted, free of charge, to any person obtaining a+copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,6 @@+hslua-list+==========++Opinionated, fast, and extensible implementation of a Lua *List*+type. The type re-uses some parts of Lua's base library, so the+*base* library must be loaded before this one.
+ cbits/listmod.c view
@@ -0,0 +1,354 @@+#include <stdlib.h>+#include "lua.h"+#include "lauxlib.h"+#include "lualib.h"++#define LIST_T "List"++/* compatibility with older Lua versions, which did not define this in the+ * header. */+#ifndef LUA_LOADED_TABLE+/* key, in the registry, for table of loaded modules */+#define LUA_LOADED_TABLE "_LOADED"+#endif++/*+** Placeholder function.+*/+static int missing (lua_State *L) {+ return luaL_error(L,+ "Function should have been overwritten with one from the table module."+ );+}++/* Translate a relative table position: negative means back from end */+static lua_Integer posrelat (lua_Integer pos, size_t len) {+ if (pos >= 0) return pos;+ else if (0u - (size_t)pos > len) return 0;+ else return (lua_Integer)len + pos + 1;+}++/*+** Check that 'arg' is either a function or a different callable object.+*/+static void checkcallable (lua_State *L, int arg) {+ if (lua_type(L, arg) != LUA_TFUNCTION) { /* is it not a function? */+ if (luaL_getmetafield(L, arg, "__call"))+ lua_pop(L, 1); /* pop metamethod */+ else+ luaL_checktype(L, arg, LUA_TFUNCTION); /* force an error */+ }+}++/*+** Creates a List from a table; uses a fresh, empty table if none is+** given.+*/+static int list_new (lua_State *L) {+ lua_settop(L, 2);+ if (lua_isnoneornil(L, 2)) {+ lua_newtable(L);+ lua_remove(L, 2);+ } else {+ luaL_checktype(L, 2, LUA_TTABLE);+ }+ lua_pushvalue(L, 1);+ lua_setmetatable(L, 2);+ return 1;+}++/*+** Creates a shallow clone of the given list; the clone will contain+** only the list elements, not any other elements that might have been+** present.+*/+static int list_clone (lua_State *L) {+ lua_settop(L, 1);+ luaL_checktype(L, 1, LUA_TTABLE);+ lua_Integer len = luaL_len(L, 1);+ lua_createtable(L, len, 0); /* create new table */+ lua_getmetatable(L, 1);+ lua_setmetatable(L, 2);+ for (lua_Integer i = 1; i <= len; i++) {+ lua_geti(L, 1, i);+ lua_seti(L, 2, i);+ }+ return 1;+}++/*+** Creates a new list that is the concatenation of its two arguments.+** The result has the same metatable as the first operand.+*/+static int list_concat (lua_State *L) {+ lua_settop(L, 2);+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_checktype(L, 2, LUA_TTABLE);+ lua_Integer len1 = luaL_len(L, 1);+ lua_Integer len2 = luaL_len(L, 2);+ lua_createtable(L, len1 + len2, 0); /* result table */+ if (lua_getmetatable(L, 1)) {+ lua_setmetatable(L, 3);+ }+ for (lua_Integer i = 1; i <= len1; i++) {+ lua_geti(L, 1, i);+ lua_seti(L, 3, i);+ }+ for (lua_Integer i = 1; i <= len2; i++) {+ lua_geti(L, 2, i);+ lua_seti(L, 3, len1 + i);+ }+ return 1;+}++/*+** Checks equality. Two lists are equal if and only if they have the same+** metatable and if all items are equal.+*/+static int list_eq (lua_State *L) {+ lua_settop(L, 2);+ /* compare meta tables */+ if (!(lua_getmetatable(L, 1) &&+ lua_getmetatable(L, 2) &&+ lua_rawequal(L, -1, -2))) {+ lua_pushboolean(L, 0);+ return 1;+ };+ lua_pop(L, 2); /* remove metatables */++ /* ensure both lists have the same length */+ lua_Integer len1 = luaL_len(L, 1);+ lua_Integer len2 = luaL_len(L, 2);+ if (len1 != len2) {+ lua_pushboolean(L, 0);+ return 1;+ }++ /* check element-wise equality */+ for (lua_Integer i = 1; i <= len1; i++) {+ lua_geti(L, 1, i);+ lua_geti(L, 2, i);+ if (!lua_compare(L, -1, -2, LUA_OPEQ)) {+ lua_pushboolean(L, 0);+ return 1;+ }+ }+ lua_pushboolean(L, 1);+ return 1;+}++/*+** Appends the second list to the first.+*/+static int list_extend (lua_State *L) {+ lua_settop(L, 2);+ luaL_checktype(L, 1, LUA_TTABLE);+ luaL_checktype(L, 2, LUA_TTABLE);+ lua_Integer len1 = luaL_len(L, 1);+ lua_Integer len2 = luaL_len(L, 2);+ for (lua_Integer i = 1; i <= len2; i++) {+ lua_geti(L, 2, i);+ lua_seti(L, 1, len1 + i);+ }+ return 1;+}++/*+** Removes elements that do not have the desired property.+*/+static int list_filter (lua_State *L) {+ lua_settop(L, 2);+ luaL_checktype(L, 1, LUA_TTABLE);+ checkcallable(L, 2);+ luaL_checkstack(L, 4, NULL);+ lua_Integer len = luaL_len(L, 1);+ lua_createtable(L, len, 0); /* create new table */+ lua_getmetatable(L, 1);+ lua_setmetatable(L, 3);+ for (lua_Integer i = 1, j = 0; i <= len; i++) {+ lua_pushvalue(L, 2); /* push predicate function */+ lua_geti(L, 1, i);+ lua_pushinteger(L, i);+ lua_call(L, 2, 1);+ if (lua_toboolean(L, -1)) {+ lua_geti(L, 1, i);+ lua_seti(L, 3, ++j);+ }+ lua_pop(L, 1); /* remove predicate call result */+ }+ return 1;+}++/*+** Returns the first element that is equal to `needle`, along with that+** element's index, or `nil` if no such element exists.+*/+static int list_find (lua_State *L) {+ luaL_checkstack(L, 2, "List.find");+ lua_settop(L, 3);+ luaL_checktype(L, 1, LUA_TTABLE);+ lua_Integer len = luaL_len(L, 1);+ lua_Integer start = posrelat(luaL_optinteger(L, 3, 1), len);+ for (lua_Integer i = start; i <= len; i++) {+ lua_geti(L, 1, i);+ if (lua_compare(L, 2, -1, LUA_OPEQ)) {+ lua_pushinteger(L, i);+ return 2;+ }+ lua_pop(L, 1); /* remove list element result */+ }+ lua_pushnil(L);+ return 1;+}++/*+** Returns the first element after the given start index for which the+** predicate function returns a truthy value, along with that element's+** index; returns `nil` if no such element exists.+*/+static int list_find_if (lua_State *L) {+ lua_settop(L, 3);+ luaL_checktype(L, 1, LUA_TTABLE);+ checkcallable(L, 2);+ lua_Integer len = luaL_len(L, 1);+ lua_Integer start = posrelat(luaL_optinteger(L, 3, 1), len);+ for (lua_Integer i = start; i <= len; i++) {+ lua_pushvalue(L, 2); /* predicate function */+ lua_geti(L, 1, i);+ lua_pushinteger(L, i);+ lua_call(L, 2, 1);+ if (lua_toboolean(L, -1)) {+ lua_geti(L, 1, i);+ lua_pushinteger(L, i);+ return 2;+ }+ lua_pop(L, 1); /* remove predicate call result */+ }+ lua_pushnil(L);+ return 1;+}++/*+** Returns a boolean value indicating whether or not the element exists+** in the given list.+*/+static int list_includes(lua_State *L) {+ lua_settop(L, 3);+ lua_pushcfunction(L, list_find);+ lua_insert(L, 1);+ lua_call(L, 3, 1);+ luaL_checkstack(L, 1, "List.includes");+ lua_pushboolean(L, lua_toboolean(L, -1));+ return 1;+}++/*+** Returns a copy of the current list by applying the given function to+** all elements.+*/+static int list_map(lua_State *L) {+ lua_settop(L, 2);+ luaL_checktype(L, 1, LUA_TTABLE);+ checkcallable(L, 2);+ lua_Integer len = luaL_len(L, 1);+ lua_createtable(L, len, 0); /* create new table */+ luaL_getmetatable(L, LIST_T); /* make result a generic list */+ lua_setmetatable(L, 3);+ for (lua_Integer i = 1; i <= len; i++) {+ lua_pushvalue(L, 2); /* map function */+ lua_geti(L, 1, i);+ lua_pushinteger(L, i);+ lua_call(L, 2, 1);+ lua_seti(L, 3, i);+ }+ return 1;+}++/*+** Pushes the standard `table` module to the stack.+*/+static void pushtablemodule (lua_State *L) {+ lua_getfield(L, LUA_REGISTRYINDEX, LUA_LOADED_TABLE);+ if (!lua_getfield(L, -1, LUA_TABLIBNAME)) {+ /* apparently it's not been loaded yes. So open it here (but don't+ * 'load' it). */+ lua_pushcfunction(L, luaopen_table);+ lua_pushliteral(L, LUA_TABLIBNAME);+ lua_call(L, 1, 1);+ }+ lua_remove(L, -2); /* remove LOADED table */+}++/*+** Fields to copy from standard `table` package.+*/+static const char *tablelib_functions[] = {+ "insert",+ "remove",+ "sort",+ NULL+};++/*+** Copy fields from standard `table` module to the table at the given+** index.+*/+static void copyfromtablelib (lua_State *L, int idx) {+ int absidx = lua_absindex(L, idx);+ pushtablemodule(L);+ for (const char **name = tablelib_functions; *name != NULL; *name++) {+ if (lua_getfield(L, -1, *name)) {+ lua_setfield(L, absidx, *name);+ } else {+ lua_pop(L, 1);+ }+ }+ lua_pop(L, 1); /* remove table module */+}++static const luaL_Reg list_funcs[] = {+ {"__concat", list_concat},+ {"__eq", list_eq},+ {"clone", list_clone},+ {"extend", list_extend},+ {"filter", list_filter},+ {"find", list_find},+ {"find_if", list_find_if},+ {"includes", list_includes},+ {"insert", missing},+ {"map", list_map},+ {"new", list_new},+ {"remove", missing},+ {"sort", missing},+ {NULL, NULL}+};++static const luaL_Reg metareg[] = {+ {"__call", list_new},+ {NULL, NULL}+};++/*+** Creates a new metatable for a new List-like type.+ */+int lualist_newmetatable (lua_State *L, const char *name) {+ if (luaL_newmetatable(L, name)) {+ luaL_setfuncs(L, list_funcs, 0);+ /* use functions from standard table module. */+ copyfromtablelib(L, -1);+ lua_pushvalue(L, -1);+ lua_setfield(L, -2, "__index");+ return 1;+ }+ return 0;+}++int luaopen_list (lua_State *L) {+ luaL_checkversion(L);+ lualist_newmetatable(L, LIST_T);++ lua_newtable(L);+ luaL_setfuncs(L, metareg, 0);+ lua_setmetatable(L, -2);+ return 1;+}
+ hslua-list.cabal view
@@ -0,0 +1,71 @@+cabal-version: 2.2+name: hslua-list+version: 1.0.0+synopsis: Opinionated, but extensible Lua list type.+description: List type for Lua, with a Haskell interface.+homepage: https://hslua.org/+bug-reports: https://github.com/hslua/hslua/issues+license: MIT+license-file: LICENSE+author: Albert Krewinkel+maintainer: Albert Krewinkel <albert@hslua.org>+copyright: © 2022 Albert Krewinkel+category: Foreign+build-type: Simple+extra-doc-files: README.md+ CHANGELOG.md+tested-with: GHC == 8.0.2+ , GHC == 8.2.2+ , GHC == 8.4.4+ , GHC == 8.6.5+ , GHC == 8.8.4+ , GHC == 8.10.7+ , GHC == 9.0.2+ , GHC == 9.2.3++source-repository head+ type: git+ location: https://github.com/hslua/hslua+ subdir: hslua-list++common common-options+ build-depends: base >= 4.9.1 && < 5+ , hslua-core >= 2.3 && < 2.4+ ghc-options: -Wall+ -Wcompat+ -Widentities+ -Wincomplete-uni-patterns+ -Wincomplete-record-updates+ if impl(ghc >= 8.0)+ ghc-options: -Wredundant-constraints+ if impl(ghc >= 8.2)+ ghc-options: -fhide-source-paths+ if impl(ghc >= 8.4)+ ghc-options: -Wmissing-export-lists+ -Wpartial-fields+ if impl(ghc >= 8.10)+ ghc-options: -Wunused-packages+ if impl(ghc >= 9.0)+ ghc-options: -Winvalid-haddock++ default-language: Haskell2010++library+ import: common-options+ hs-source-dirs: src+ c-sources: cbits/listmod.c+ exposed-modules: HsLua.List+ build-depends: bytestring+ , hslua-marshalling >= 2.1 && < 2.3++test-suite hslua-list-test+ import: common-options+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: test-hslua-list.hs+ build-depends: hslua-list+ , tasty >= 0.11+ , tasty-lua >= 1.0+ ghc-options: -threaded+ -rtsopts+ -with-rtsopts=-N
+ src/HsLua/List.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{- |+Copyright : © 2021-2022 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <tarleb+pandoc@moltkeplatz.de>++Lua lists with additional methods.+-}+module HsLua.List+ ( pushPandocList+ , luaopen_list_ptr+ , pushListModule+ , newListMetatable+ ) where++import Data.ByteString (useAsCString)+import Foreign.C+import HsLua.Core+import HsLua.Marshalling (Pusher, pushList)++-- | Pushes a list as a numerically-indexed Lua table, and sets a+-- metatable that offers a number of convenience functions.+pushPandocList :: LuaError e => Pusher e a -> Pusher e [a]+pushPandocList pushItem items = do+ pushList pushItem items+ getmetatable' "List" >>= \case+ TypeTable -> setmetatable (nth 2)+ _ -> failLua "List has not been initialized correctly."++-- | Pointer to the function that opens the List module and pushes it to the+-- stack.+foreign import ccall unsafe "listmod.c &luaopen_list"+ luaopen_list_ptr :: CFunction++-- | Opens the List module and pushes it to the stack.+pushListModule :: LuaError e => LuaE e ()+pushListModule = do+ pushcfunction luaopen_list_ptr+ call 0 1++-- | Creates a new list metatable with the given name.+foreign import ccall "listmod.c lualist_newmetatable"+ lualist_newmetatable :: State -> CString -> IO CInt++-- | Pushes the metatable of the given List type, creating it if+-- necessary. The @setup@ operation is run when the metatable did not+-- exists, was created, and is then at the top of the stack. The+-- operation may modify the table but must be balanced, and must leave+-- the stack as it found it.+newListMetatable :: Name -> LuaE e () {-^ setup -} -> LuaE e ()+newListMetatable (Name name) setup = do+ l <- state+ liftIO (useAsCString name (lualist_newmetatable l)) >>= \case+ 0 -> pure () -- metatable already registered; no need to setup again+ _ -> setup
+ test/test-hslua-list.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-|+Module : Main+Copyright : © 2021-2022 Albert Krewinkel+License : MIT+Maintainer : Albert Krewinkel <albert@hslua.org>++Tests for the list type.+-}+module Main (main) where++import HsLua.Core as Lua+import HsLua.List+import Test.Tasty (defaultMain, testGroup)+import Test.Tasty.Lua (translateResultsFromFile)++main :: IO ()+main = do+ listTests <- run @Lua.Exception $ do+ openlibs+ -- Init default List module+ pushListModule *> setglobal "List"+ -- Create a custom List type with constructor "CustomList"+ pushHaskellFunction $ do+ settop 1+ newListMetatable "CustomList" (pure ())+ setmetatable (nthBottom 1)+ return 1+ setglobal "CustomList"+ translateResultsFromFile "test/test-list.lua"++ defaultMain $ testGroup "hslua-list" [listTests]