nyje
/
medit
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Added Penlight Lua library

master
Yevgen Muntyan 2010-09-06 16:13:19 -07:00
parent da2ba0a5cd
commit 81f29c8831
50 changed files with 7958 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
doc/help-sections.h
View File

@ -10,10 +10,11 @@
#define HELP_SECTION_DOCUMENT_VIEW "DocumentView-object.html"
#define HELP_SECTION_EDITING_OPTIONS "editing_002doptions.html"
#define HELP_SECTION_FILE_SELECTOR "index.html"
#define HELP_SECTION_LICENSE_GPL "GNU-General-Public-License.html"
#define HELP_SECTION_LICENSE_GPL "GNU-GPL.html"
#define HELP_SECTION_LICENSE_LFS "LuaFileSystem-License.html"
#define HELP_SECTION_LICENSE_LGPL "GNU-Lesser-General-Public-License.html"
#define HELP_SECTION_LICENSE_LGPL "GNU-LGPL.html"
#define HELP_SECTION_LICENSE_LUA "Lua-License.html"
#define HELP_SECTION_LICENSE_PENLIGHT "Penlight-License.html"
#define HELP_SECTION_LICENSE_XDG_UTILS "xdg_002dutils-License.html"
#define HELP_SECTION_PREFS_ACCELS "index.html"
#define HELP_SECTION_PREFS_DIALOG "index.html"

8
doc/help/GNU-General-Public-License.html → doc/help/GNU-GPL.html
View File

@ -1,12 +1,12 @@
<html lang="en">
<head>
<title>GNU General Public License - medit 0.99.0-unstable manual</title>
<title>GNU GPL - medit 0.99.0-unstable manual</title>
<meta http-equiv="Content-Type" content="text/html">
<meta name="description" content="medit 0.99.0-unstable manual">
<meta name="generator" content="makeinfo 4.13">
<link title="Top" rel="start" href="index.html#Top">
<link rel="up" href="License.html#License" title="License">
<link rel="next" href="GNU-Lesser-General-Public-License.html#GNU-Lesser-General-Public-License" title="GNU Lesser General Public License">
<link rel="next" href="GNU-LGPL.html#GNU-LGPL" title="GNU LGPL">
<link href="http://www.gnu.org/software/texinfo/" rel="generator-home" title="Texinfo Homepage">
<meta http-equiv="Content-Style-Type" content="text/css">
<style type="text/css"><!--
@ -23,9 +23,9 @@
</head>
<body>
<div class="node">
<a name="GNU-General-Public-License"></a>
<a name="GNU-GPL"></a>
<p>
Next:&nbsp;<a rel="next" accesskey="n" href="GNU-Lesser-General-Public-License.html#GNU-Lesser-General-Public-License">GNU Lesser General Public License</a>,
Next:&nbsp;<a rel="next" accesskey="n" href="GNU-LGPL.html#GNU-LGPL">GNU LGPL</a>,
Up:&nbsp;<a rel="up" accesskey="u" href="License.html#License">License</a>
<hr>
</div>

8
doc/help/GNU-Lesser-General-Public-License.html → doc/help/GNU-LGPL.html
View File

@ -1,12 +1,12 @@
<html lang="en">
<head>
<title>GNU Lesser General Public License - medit 0.99.0-unstable manual</title>
<title>GNU LGPL - medit 0.99.0-unstable manual</title>
<meta http-equiv="Content-Type" content="text/html">
<meta name="description" content="medit 0.99.0-unstable manual">
<meta name="generator" content="makeinfo 4.13">
<link title="Top" rel="start" href="index.html#Top">
<link rel="up" href="License.html#License" title="License">
<link rel="prev" href="GNU-General-Public-License.html#GNU-General-Public-License" title="GNU General Public License">
<link rel="prev" href="GNU-GPL.html#GNU-GPL" title="GNU GPL">
<link rel="next" href="Lua-License.html#Lua-License" title="Lua License">
<link href="http://www.gnu.org/software/texinfo/" rel="generator-home" title="Texinfo Homepage">
<meta http-equiv="Content-Style-Type" content="text/css">
@ -24,10 +24,10 @@
</head>
<body>
<div class="node">
<a name="GNU-Lesser-General-Public-License"></a>
<a name="GNU-LGPL"></a>
<p>
Next:&nbsp;<a rel="next" accesskey="n" href="Lua-License.html#Lua-License">Lua License</a>,
Previous:&nbsp;<a rel="previous" accesskey="p" href="GNU-General-Public-License.html#GNU-General-Public-License">GNU General Public License</a>,
Previous:&nbsp;<a rel="previous" accesskey="p" href="GNU-GPL.html#GNU-GPL">GNU GPL</a>,
Up:&nbsp;<a rel="up" accesskey="u" href="License.html#License">License</a>
<hr>
</div>

7
doc/help/License.html
View File

@ -40,11 +40,12 @@ as licenses and acknowledgements for third-party software incorporated
in medit, can be found in this section.
<ul class="menu">
<li><a accesskey="1" href="GNU-General-Public-License.html#GNU-General-Public-License">GNU General Public License</a>: GNU General Public License
<li><a accesskey="2" href="GNU-Lesser-General-Public-License.html#GNU-Lesser-General-Public-License">GNU Lesser General Public License</a>: GNU Lesser General Public License
<li><a accesskey="1" href="GNU-GPL.html#GNU-GPL">GNU GPL</a>: GNU General Public License
<li><a accesskey="2" href="GNU-LGPL.html#GNU-LGPL">GNU LGPL</a>: GNU Lesser General Public License
<li><a accesskey="3" href="Lua-License.html#Lua-License">Lua License</a>: Lua License
<li><a accesskey="4" href="LuaFileSystem-License.html#LuaFileSystem-License">LuaFileSystem License</a>: LuaFileSystem License
<li><a accesskey="5" href="xdg_002dutils-License.html#xdg_002dutils-License">xdg-utils License</a>: xdg-utils License
<li><a accesskey="5" href="Penlight-License.html#Penlight-License">Penlight License</a>: Penlight License
<li><a accesskey="6" href="xdg_002dutils-License.html#xdg_002dutils-License">xdg-utils License</a>: xdg-utils License
</ul>
</body></html>

4
doc/help/Lua-License.html
View File

@ -6,7 +6,7 @@
<meta name="generator" content="makeinfo 4.13">
<link title="Top" rel="start" href="index.html#Top">
<link rel="up" href="License.html#License" title="License">
<link rel="prev" href="GNU-Lesser-General-Public-License.html#GNU-Lesser-General-Public-License" title="GNU Lesser General Public License">
<link rel="prev" href="GNU-LGPL.html#GNU-LGPL" title="GNU LGPL">
<link rel="next" href="LuaFileSystem-License.html#LuaFileSystem-License" title="LuaFileSystem License">
<link href="http://www.gnu.org/software/texinfo/" rel="generator-home" title="Texinfo Homepage">
<meta http-equiv="Content-Style-Type" content="text/css">
@ -27,7 +27,7 @@
<a name="Lua-License"></a>
<p>
Next:&nbsp;<a rel="next" accesskey="n" href="LuaFileSystem-License.html#LuaFileSystem-License">LuaFileSystem License</a>,
Previous:&nbsp;<a rel="previous" accesskey="p" href="GNU-Lesser-General-Public-License.html#GNU-Lesser-General-Public-License">GNU Lesser General Public License</a>,
Previous:&nbsp;<a rel="previous" accesskey="p" href="GNU-LGPL.html#GNU-LGPL">GNU LGPL</a>,
Up:&nbsp;<a rel="up" accesskey="u" href="License.html#License">License</a>
<hr>
</div>

4
doc/help/LuaFileSystem-License.html
View File

@ -7,7 +7,7 @@
<link title="Top" rel="start" href="index.html#Top">
<link rel="up" href="License.html#License" title="License">
<link rel="prev" href="Lua-License.html#Lua-License" title="Lua License">
<link rel="next" href="xdg_002dutils-License.html#xdg_002dutils-License" title="xdg-utils License">
<link rel="next" href="Penlight-License.html#Penlight-License" title="Penlight License">
<link href="http://www.gnu.org/software/texinfo/" rel="generator-home" title="Texinfo Homepage">
<meta http-equiv="Content-Style-Type" content="text/css">
<style type="text/css"><!--
@ -26,7 +26,7 @@
<div class="node">
<a name="LuaFileSystem-License"></a>
<p>
Next:&nbsp;<a rel="next" accesskey="n" href="xdg_002dutils-License.html#xdg_002dutils-License">xdg-utils License</a>,
Next:&nbsp;<a rel="next" accesskey="n" href="Penlight-License.html#Penlight-License">Penlight License</a>,
Previous:&nbsp;<a rel="previous" accesskey="p" href="Lua-License.html#Lua-License">Lua License</a>,
Up:&nbsp;<a rel="up" accesskey="u" href="License.html#License">License</a>
<hr>

63
doc/help/Penlight-License.html Normal file
View File

@ -0,0 +1,63 @@
<html lang="en">
<head>
<title>Penlight License - medit 0.99.0-unstable manual</title>
<meta http-equiv="Content-Type" content="text/html">
<meta name="description" content="medit 0.99.0-unstable manual">
<meta name="generator" content="makeinfo 4.13">
<link title="Top" rel="start" href="index.html#Top">
<link rel="up" href="License.html#License" title="License">
<link rel="prev" href="LuaFileSystem-License.html#LuaFileSystem-License" title="LuaFileSystem License">
<link rel="next" href="xdg_002dutils-License.html#xdg_002dutils-License" title="xdg-utils License">
<link href="http://www.gnu.org/software/texinfo/" rel="generator-home" title="Texinfo Homepage">
<meta http-equiv="Content-Style-Type" content="text/css">
<style type="text/css"><!--
pre.display { font-family:inherit }
pre.format { font-family:inherit }
pre.smalldisplay { font-family:inherit; font-size:smaller }
pre.smallformat { font-family:inherit; font-size:smaller }
pre.smallexample { font-size:smaller }
pre.smalllisp { font-size:smaller }
span.sc { font-variant:small-caps }
span.roman { font-family:serif; font-weight:normal; }
span.sansserif { font-family:sans-serif; font-weight:normal; }
--></style>
</head>
<body>
<div class="node">
<a name="Penlight-License"></a>
<p>
Next:&nbsp;<a rel="next" accesskey="n" href="xdg_002dutils-License.html#xdg_002dutils-License">xdg-utils License</a>,
Previous:&nbsp;<a rel="previous" accesskey="p" href="LuaFileSystem-License.html#LuaFileSystem-License">LuaFileSystem License</a>,
Up:&nbsp;<a rel="up" accesskey="u" href="License.html#License">License</a>
<hr>
</div>
<h3 class="section">Penlight Lua Libraries License</h3>
<p><!-- moo-help-section: LICENSE_PENLIGHT -->
<pre class="verbatim">Copyright (C) 2009 Steve Donovan, David Manura.
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.
</pre>
</body></html>

5
doc/help/index.html
View File

@ -49,10 +49,11 @@
</li></ul>
<li><a name="toc_License" href="License.html#License">License</a>
<ul>
<li><a href="GNU-General-Public-License.html#GNU-General-Public-License">GNU General Public License</a>
<li><a href="GNU-Lesser-General-Public-License.html#GNU-Lesser-General-Public-License">GNU Lesser General Public License</a>
<li><a href="GNU-GPL.html#GNU-GPL">GNU General Public License</a>
<li><a href="GNU-LGPL.html#GNU-LGPL">GNU Lesser General Public License</a>
<li><a href="Lua-License.html#Lua-License">Lua License</a>
<li><a href="LuaFileSystem-License.html#LuaFileSystem-License">LuaFileSystem License</a>
<li><a href="Penlight-License.html#Penlight-License">Penlight Lua Libraries License</a>
<li><a href="xdg_002dutils-License.html#xdg_002dutils-License">xdg-utils License</a>
</li></ul>
</li></ul>

4
doc/help/xdg_002dutils-License.html
View File

@ -6,7 +6,7 @@
<meta name="generator" content="makeinfo 4.13">
<link title="Top" rel="start" href="index.html#Top">
<link rel="up" href="License.html#License" title="License">
<link rel="prev" href="LuaFileSystem-License.html#LuaFileSystem-License" title="LuaFileSystem License">
<link rel="prev" href="Penlight-License.html#Penlight-License" title="Penlight License">
<link href="http://www.gnu.org/software/texinfo/" rel="generator-home" title="Texinfo Homepage">
<meta http-equiv="Content-Style-Type" content="text/css">
<style type="text/css"><!--
@ -26,7 +26,7 @@
<a name="xdg-utils-License"></a>
<a name="xdg_002dutils-License"></a>
<p>
Previous:&nbsp;<a rel="previous" accesskey="p" href="LuaFileSystem-License.html#LuaFileSystem-License">LuaFileSystem License</a>,
Previous:&nbsp;<a rel="previous" accesskey="p" href="Penlight-License.html#Penlight-License">Penlight License</a>,
Up:&nbsp;<a rel="up" accesskey="u" href="License.html#License">License</a>
<hr>
</div>

14
doc/license.texi
View File

@ -9,19 +9,20 @@ as licenses and acknowledgements for third-party software incorporated
in @medit{}, can be found in this section.
@menu
* GNU General Public License:: GNU General Public License
* GNU Lesser General Public License:: GNU Lesser General Public License
* GNU GPL:: GNU General Public License
* GNU LGPL:: GNU Lesser General Public License
* Lua License:: Lua License
* LuaFileSystem License:: LuaFileSystem License
* Penlight License:: Penlight License
* xdg-utils License:: xdg-utils License
@end menu
@node GNU General Public License
@node GNU GPL
@section GNU General Public License
@helpsection{LICENSE_GPL}
@verbatiminclude ../COPYING.GPL
@node GNU Lesser General Public License
@node GNU LGPL
@section GNU Lesser General Public License
@helpsection{LICENSE_LGPL}
@verbatiminclude ../COPYING
@ -46,6 +47,11 @@ attributes. LuaFileSystem is free software and uses the same license as Lua 5.1
Current version is 1.2.1.
@end verbatim
@node Penlight License
@section Penlight Lua Libraries License
@helpsection{LICENSE_PENLIGHT}
@verbatiminclude ../moo/moolua/pl/LICENCE.txt
@node xdg-utils License
@section xdg-utils License
@helpsection{LICENSE_XDG_UTILS}

10
moo/moolua/Makefile.incl
View File

@ -76,3 +76,13 @@ EXTRA_DIST += \
moolua/README \
moolua/slnudata.c \
moolua/slnunico.c
lua2dir = $(MOO_DATA_DIR)/lua2
EXTRA_DIST += moolua/pl
install-data-local: install-lua-pl
uninstall-local: uninstall-lua-pl
install-lua-pl:
$(MKDIR_P) $(DESTDIR)$(lua2dir)/pl
cd $(srcdir) && $(INSTALL_DATA) moolua/pl/*.lua $(DESTDIR)$(lua2dir)/pl/
uninstall-lua-pl:
rm -f $(DESTDIR)$(lua2dir)/pl/*.lua

21
moo/moolua/pl/LICENCE.txt Normal file
View File

@ -0,0 +1,21 @@
Copyright (C) 2009 Steve Donovan, David Manura.
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.

1
moo/moolua/pl/README Normal file
View File

@ -0,0 +1 @@
This is penlight-0.8 code (http://penlight.luaforge.net/). LICENCE.txt and README.txt are from the original distribution.

185
moo/moolua/pl/README.txt Normal file
View File

@ -0,0 +1,185 @@
Penlight Lua Libraries
1. Why a new set of libraries?
Penlight brings together a set of generally useful pure Lua modules,
focussing on input data handling (such as reading configuration files),
functional programming (such as map, reduce, placeholder expressions,etc),
and OS path management. Much of the functionality is inspired by the
Python standard libraries.
2. Requirements
The file and directory functions depend on LuaFileSystem (lfs). If you want
dir.copyfile to work elegantly on Windows, then you need Alien. (Both are
present in Lua for Windows.)
3. Known Issues
Error handling is still hit and miss.
There are 7581 lines of source and 1764 lines of formal tests,
which is not an ideal ratio.
Formal documentation for comprehension and luabalanced is missing.
4. Installation
The directory structure is
lua
pl
(module files)
examples
(examples)
tests
(tests)
docs
(index.html)
api
(index.html)
modules
All you need to do is copy the pl directory into your Lua module path, which
is typically /usr/local/share/lua/5.1 on a Linux system (of course, you
can set LUA_PATH appropriately.)
With Lua for Windows, if LUA stands for 'c:\Program Files\Lua\5.1',
then pl goes into LUA\lua, docs goes into LUA\examples\penlight and
both examples and tests goes into LUA\examples
5. Building the Documentation
The Users Guide is processed by markdown.lua. If you like the section headers,
you'll need to download my modified version:
http://mysite.mweb.co.za/residents/sdonovan/lua/markdown.zip
docgen.lua will preprocess the documentation (handles @see references)
and use markdown.
gen_modules.bat does the LuaDoc stuff.
6. What's new with 0.8b ?
Features:
pl.app provides useful stuff like simple command-line argument parsing and require_here(), which
makes subsequent require() calls look in the local directory by preference.
p.file provides useful functions like copy(),move(), read() and write(). (These are aliases to
dir.copyfile(),movefile(),utils.readfile(),writefile())
Custom error trace will only show the functions in user code.
More robust argument checking.
In function arguments, now supports 'string lambdas', e.g. '|x| 2*x'
utils.readfile,writefile now insist on being given filenames. This will cause less confusion.
tablex.search() is new: will look recursively in an arbitrary table; can specify tables not to follow.
tablex.move() will work with source and destination tables the same, with overlapping ranges.
Bug Fixes:
dir.copyfile() now works fine without Alien on Windows
dir.makepath() and rmtree() had problems.
tablex.compare_no_order() is now O(NlogN), as expected.
tablex.move() had a problem with source size
7. What's New with 0.7.0b?
Features:
utils.is_type(v,tp) can say is_type(s,'string') and is_type(l,List).
utils.is_callable(v) either a function, or has a __call metamethod.
Sequence wrappers: can write things like this:
seq(s):last():filter('<'):copy()
seq:mapmethod(s,name) - map using a named method over a sequence.
seq:enum(s) If s is a simple sequence, then
for i,v in seq.enum(s) do print(i,v) end
seq:take(s,n) Grab the next n values from a (possibly infinite)
sequence.
In a related change suggested by Flemming Madsden, the in-place List
methods like reverse() and sort() return the list, allowing for
method chaining.
list.join() explicitly converts using tostring first.
tablex.count_map() like seq.count_map(), but takes an equality function.
tablex.difference() set difference
tablex.set() explicit set generator given a list of values
Template.indent_substitute() is a new Template method which adjusts
for indentation and can also substitute templates themselves.
pretty.read(). This reads a Lua table (as dumped by pretty.write)
and attempts to be paranoid about its contents.
sip.match_at_start(). Convenience function for anchored SIP matches.
Bug Fixes:
tablex.deepcompare() was confused by false boolean values, which
it thought were synonymous with being nil.
pretty.write() did not handle cycles, and could not display tables
with 'holes' properly (Flemming Madsden)
The SIP pattern '$(' was not escaped properly.
sip.match() did not pass on options table.
seq.map() was broken for double-valued sequences.
seq.copy_tuples() did not use default_iter(), so did not e.g. like
table arguments.
dir.copyfile() returns the wrong result for *nix operations.
dir.makepath() was broken for non-Windows paths.
8. What's New with 0.6.3?
The map and reduce functions now take the function first, as Nature intended.
The Python-like overloading of '*' for strings has been dropped, since it
is silly. Also, strings are no longer callable; use 's:at(1)' instead of
's(1)' - this tended to cause Obscure Error messages.
Wherever a function argument is expected, you can use the operator strings
like '+','==',etc as well as pl.operator.add, pl.operator.eq, etc.
(see end of pl/operator.lua for the full list.)
tablex now has compare() and compare_no_order(). An explicit set()
function has been added which constructs a table with the specified
keys, all set to a value of true.
List has reduce() and partition() (This is a cool function which
separates out elements of a list depending on a classifier function.)
There is a new array module which generalizes tablex operations like
map and reduce for two-dimensional arrays.
The famous iterator over permutations from PiL 9.3 has been included.
David Manura's list comprehension library has been included.
Also, utils now contains his memoize function, plus a useful function
args which captures the case where varargs contains nils.
There was a bug with dir.copyfile() where the flag was the wrong way round.
config.lines() had a problem with continued lines.
Some operators were missing in pl.operator; have renamed them to be
consistent with the Lua metamethod names.

115
moo/moolua/pl/app.lua Normal file
View File

@ -0,0 +1,115 @@
--- Application support functions.
local utils = require 'pl.utils'
local raise = utils.raise
local path = require 'pl.path'
local package,_G,lfs = package,_G,lfs
module ('pl.app',utils._module)
local function check_script_name ()
if _G.arg == nil then utils.error('no command line args available\nWas this run from a main script?') end
return _G.arg[0]
end
--- add the current script's path to the Lua module path.
-- Applies to both the source and the binary module paths. It makes it easy for
-- the main file of a multi-file program to access its modules in the same directory.
-- @return the current script's path with a trailing slash
function require_here ()
local p = path.dirname(check_script_name())
if not path.isabs(p) then
p = path.join(lfs.currentdir(),p)
end
if p:sub(-1,-1) ~= path.sep then
p = p..path.sep
end
local so_ext = is_windows and 'dll' or 'so'
local lsep = package.path:find '^;' and '' or ';'
local csep = package.cpath:find '^;' and '' or ';'
package.path = ('%s?.lua;%s?%sinit.lua%s%s'):format(p,p,path.sep,lsep,package.path)
package.cpath = ('%s?.%s%s%s'):format(p,so_ext,csep,package.cpath)
return p
end
--- return a suitable path for files private to this application.
-- These will look like '~/.SNAME/file', with '~' as with expanduser and
-- SNAME is the name of the script without .lua extension.
-- @param file a filename (w/out path)
-- @return a full pathname
function appfile (file)
local sname = path.basename(check_script_name())
local name,ext = path.splitext(sname)
local dir = path.join(path.expanduser('~'),'.'..name)
if not path.isdir(dir) then
local ret = lfs.mkdir(dir)
if not ret then raise ('cannot create '..dir) end
end
return path.join(dir,file)
end
--- parse command-line arguments into flags and parameters.
-- Understands GNU-style command-line flags; short (-f) and long (--flag).
-- These may be given a value with either '=' or ':' (-k:2,--alpha=3.2,-n2);
-- note that a number value can be given without a space.
-- Multiple short args can be combined like so: (-abcd).
-- @param args an array of strings (default is the global 'arg')
-- @param flags_with_values any flags that take values, e.g. <code>{out=true}</code>
-- @return a table of flags (flag=value pairs)
-- @return an array of parameters
function parse_args (args,flags_with_values)
if not args then
args = _G.arg
if not _args then utils.error "Not in a main program: 'arg' not found" end
end
flags_with_values = flags_with_values or {}
local _args = {}
local flags = {}
local i = 1
while i <= #args do
local a = args[i]
local v = a:match('^-(.+)')
local is_long
if v then -- we have a flag
if v:find '^-' then
is_long = true
v = v:sub(2)
end
if flags_with_values[v] then
if i == #_args or args[i+1]:find '^-' then
return raise ("no value for '"..v.."'")
end
flags[v] = args[i+1]
i = i + 1
else
-- a value can be indicated with = or :
local var,val = utils.splitv (v,'[=:]')
var = var or v
val = val or true
if not is_long then
if #var > 1 then
if var:find '.%d+' then -- short flag, number value
val = var:sub(2)
var = var:sub(1,1)
else -- multiple short flags
for i = 1,#var do
flags[var:sub(i,i)] = true
end
val = nil -- prevents use of var as a flag below
end
else -- single short flag (can have value, defaults to true)
val = val or true
end
end
if val then
flags[var] = val
end
end
else
_args[#_args+1] = a
end
i = i + 1
end
return flags,_args
end

358
moo/moolua/pl/array2d.lua Normal file
View File

@ -0,0 +1,358 @@
-------------------------------------------------------------------
-- Operations on two-dimensional arrays.
local ops = require 'pl.operator'
local tablex = require 'pl.tablex'
local utils = require 'pl.utils'
local type,tonumber,assert,tostring = type,tonumber,assert,tostring
local imap,tmap,reduce,keys,tmap2,tset,index_by = tablex.imap,tablex.map,tablex.reduce,tablex.keys,tablex.map2,tablex.set,tablex.index_by
local remove = table.remove
local perm = require 'pl.permute'
local splitv,fprintf,assert_arg = utils.splitv,utils.fprintf,utils.assert_arg
local byte = string.byte
local print = print --debug
local stdout = io.stdout
module ('pl.array2d',utils._module)
--- extract a column from the 2D array.
-- @param a 2d array
-- @param key an index or key
-- @return 1d array
function column (a,key)
assert_arg(1,a,'table')
return imap(ops.index,a,key)
end
--- map a function over a 2D array
-- @param f a function of at least one argument
-- @param a 2d array
-- @param arg an optional extra argument to be passed to the function.
-- @return 2d array
function map (f,a,arg)
assert_arg(1,a,'table')
f = utils.function_arg(f)
return imap(function(row) return imap(f,row,arg) end, a)
end
--- reduce the rows using a function.
-- @param f a binary function
-- @param a 2d array
-- @return 1d array
-- @see pl.tablex.reduce
function reduce_rows (f,a)
assert_arg(1,a,'table')
return tmap(function(row) return reduce(f,row) end, a)
end
--- reduce the columns using a function.
-- @param f a binary function
-- @param a 2d array
-- @return 1d array
-- @see pl.tablex.reduce
function reduce_cols (f,a)
assert_arg(1,a,'table')
return tmap(function(c) return reduce(f,column(a,c)) end, keys(a[1]))
end
--- reduce a 2D array into a scalar, using two operations.
-- @param opc operation to reduce the final result
-- @param opr operation to reduce the rows
-- @param a 2D array
function reduce2 (opc,opr,a)
assert_arg(1,a,'table')
local tmp = reduce_rows(opr,a)
return reduce(opc,tmp)
end
local function dimension (t)
return type(t[1])=='table' and 2 or 1
end
--- map a function over two arrays.
-- They can be both or either 2D arrays
-- @param f function of at least two arguments
-- @param ad order of first array
-- @param bd order of second array
-- @param a 1d or 2d array
-- @param b 1d or 2d array
-- @param arg optional extra argument to pass to function
-- @return 2D array, unless both arrays are 1D
function map2 (f,ad,bd,a,b,arg)
assert_arg(1,a,'table')
assert_arg(2,b,'table')
f = utils.function_arg(f)
--local ad,bd = dimension(a),dimension(b)
if ad == 1 and bd == 2 then
return imap(function(row)
return tmap2(f,a,row,arg)
end, b)
elseif ad == 2 and bd == 1 then
return imap(function(row)
return tmap2(f,row,b,arg)
end, a)
elseif ad == 1 and bd == 1 then
return tmap2(f,a,b)
elseif ad == 2 and bd == 2 then
return tmap2(function(rowa,rowb)
return tmap2(f,rowa,rowb,arg)
end, a,b)
end
end
--- cartesian product of two 1d arrays.
-- @param f a function of 2 arguments
-- @param t1 a 1d table
-- @param t2 a 1d table
-- @return 2d table
function product (f,t1,t2)
assert_arg(1,t1,'table')
assert_arg(2,t2,'table')
return map2(f,1,2,t1,perm.table(t2))
end
--- swap two rows of an array.
-- @param t a 2d array
-- @param i1 a row index
-- @param i2 a row index
function swap_rows (t,i1,i2)
assert_arg(1,t,'table')
t[i1],t[i2] = t[i2],t[i1]
end
--- swap two columns of an array.
-- @param t a 2d array
-- @param i1 a column index
-- @param i2 a column index
function swap_cols (t,j1,j2)
assert_arg(1,t,'table')
for i = 1,#t do
local row = t[i]
row[j1],row[j2] = row[j2],row[j1]
end
end
--- extract the specified rows.
-- @param a 2d array
-- @param ridx a table of row indices
function extract_rows (t,ridx)
return index_by(t,ridx)
end
--- extract the specified columns.
-- @param a 2d array
-- @param cidx a table of column indices
function extract_cols (t,cidx)
assert_arg(1,t,'table')
for i = 1,#t do
t[i] = index_by(t[i],cidx)
end
end
--- remove a row from an array.
-- @class function
-- @name remove_row
-- @param t a 2d array
-- @param i a row index
remove_row = remove
--- remove a column from an array.
-- @param t a 2d array
-- @param j a column index
function remove_col (t,j)
assert_arg(1,t,'table')
for i = 1,#t do
remove(t[i],j)
end
end
local Ai = byte 'A'
local function _parse (s)
local c,r
if s:sub(1,1) == 'R' then
r,c = s:match 'R(%d+)C(%d+)'
r,c = tonumber(r),tonumber(c)
else
c,r = s:match '(.)(.)'
c = byte(c) - byte 'A' + 1
r = tonumber(r)
end
assert(c ~= nil and r ~= nil,'bad cell specifier: '..s)
return r,c
end
--- parse a spreadsheet range.
-- The range can be specified either as 'A1:B2' or 'R1C1:R2C2';
-- a special case is a single element (e.g 'A1' or 'R1C1')
-- @param s a range.
-- @return start col
-- @return start row
-- @return end col
-- @return end row
function parse_range (s)
if s:find ':' then
local start,finish = splitv(s,':')
local i1,j1 = _parse(start)
local i2,j2 = _parse(finish)
return i1,j1,i2,j2
else -- single value
local i,j = _parse(s)
return i,j
end
end
--- get a slice of a 2D array using spreadsheet range notation (see <a href="#parse_range">parse_range</a>).
-- @param t a 2D array
-- @param rstr range expression
-- @return a slice
-- @see parse_range
-- @see slice
function range (t,rstr)
assert_arg(1,t,'table')
local i1,j1,i2,j2 = parse_range(rstr)
if i2 then
return slice(t,i1,j1,i2,j2)
else -- single value
return t[i1][j1]
end
end
local function default_range (t,i1,j1,i2,j2)
assert(t and type(t)=='table','not a table')
i1,j1 = i1 or 1, j1 or 1
i2,j2 = i2 or #t, j2 or #t[1]
return i1,j1,i2,j2
end
--- get a slice of a 2D array. Note that if the specified range has
-- a 1D result, the rank of the result will be 1.
-- @param t a 2D array
-- @param i1 start row (default 1)
-- @param j1 start col (default 1)
-- @param i2 end row (default N)
-- @param j1 end col (default M)
-- @return an array, 2D in general but 1D in special cases.
function slice (t,i1,j1,i2,j2)
assert_arg(1,t,'table')
i1,j1,i2,j2 = default_range(t,i1,j1,i2,j2)
local res = {}
for i = i1,i2 do
local val
local row = t[i]
if j1 == j2 then
val = row[j1]
else
val = {}
for j = j1,j2 do
val[#val+1] = row[j]
end
end
res[#res+1] = val
end
if i1 == i2 then res = res[1] end
return res
end
--- set a specified range of an array to a value.
-- @param t a 2D array
-- @param value the value
-- @param i1 start row (default 1)
-- @param j1 start col (default 1)
-- @param i2 end row (default N)
-- @param j1 end col (default M)
function set (t,value,i1,j1,i2,j2)
i1,j1,i2,j2 = default_range(t,i1,j1,i2,j2)
for i = i1,i2 do
tset(t[i],value)
end
end
--- write a 2D array to a file.
-- @param t a 2D array
-- @param f a file object (default stdout)
-- @param fmt a format string (default is just to use tostring)
-- @param i1 start row (default 1)
-- @param j1 start col (default 1)
-- @param i2 end row (default N)
-- @param j1 end col (default M)
function write (t,f,fmt,i1,j1,i2,j2)
assert_arg(1,t,'table')
f = f or stdout
local rowop
if fmt then
rowop = function(row,j) fprintf(f,fmt,row[j]) end
else
rowop = function(row,j) f:write(tostring(row[j]),' ') end
end
local function newline()
f:write '\n'
end
forall(t,rowop,newline,i1,j1,i2,j2)
end
--- perform an operation for all values in a 2D array.
-- @param a 2D array
-- @param row_op function to call on each value
-- @param end_row_op function to call at end of each row
-- @param i1 start row (default 1)
-- @param j1 start col (default 1)
-- @param i2 end row (default N)
-- @param j1 end col (default M)
function forall (t,row_op,end_row_op,i1,j1,i2,j2)
assert_arg(1,t,'table')
i1,j1,i2,j2 = default_range(t,i1,j1,i2,j2)
for i = i1,i2 do
local row = t[i]
for j = j1,j2 do
row_op(row,j)
end
if end_row_op then end_row_op(i) end
end
end
--- iterate over all elements in a 2D array, with optional indices.
-- @param a 2D array
-- @param indices with indices (default false)
-- @param i1 start row (default 1)
-- @param j1 start col (default 1)
-- @param i2 end row (default N)
-- @param j1 end col (default M)
-- @return either value or i,j,value depending on indices
function iter (a,indices,i1,j1,i2,j2)
assert_arg(1,a,'table')
local norowset = not (i2 and j2)
i1,j1,i2,j2 = default_range(a,i1,j1,i2,j2)
local n,i,j = i2-i1+1,i1-1,j1-1
local row,nr = nil,0
local onr = j2 - j1 + 1
return function()
j = j + 1
if j > nr then
j = j1
i = i + 1
if i > i2 then return nil end
row = a[i]
nr = norowset and #row or onr
end
if indices then
return i,j,row[j]
else
return row[j]
end
end
end
function columns (a)
assert_arg(1,a,'table')
local n = a[1][1]
local i = 0
return function()
i = i + 1
if i > n then return nil end
return column(a,i)
end
end

359
moo/moolua/pl/class.lua Normal file
View File

@ -0,0 +1,359 @@
--- Wrapper classes: Map and Set.
-- Provides a reuseable and convenient framework for creating classes in Lua.
-- See the Guide for further <a href="../../index.html#class">discussion</a>
-- @class module
-- @name pl.class
local function module(...) end
module 'pl.class'
-- utils keeps the predefined metatables for these useful interfaces,
-- so that other modules (such as tablex) can tag their output accordingly.
-- However, users are not required to use this module.
local tablex = require 'pl.tablex'
local utils = require 'pl.utils'
local stdmt = utils.stdmt
local List = require 'pl.list' . List
local rawset = rawset
local is_callable = utils.is_callable
local tmakeset,deepcompare,merge,keys,difference,tupdate = tablex.makeset,tablex.deepcompare,tablex.merge,tablex.keys,tablex.difference,tablex.update
local pretty_write = require 'pl.pretty' . write
local Map = stdmt.Map
local Set = stdmt.Set
local List = stdmt.List
pl.class = {Set = Set, Map = Map}
-- this trickery is necessary to prevent the inheritance of 'super' and
-- the resulting recursive call problems.
local function call_ctor (c,obj,...)
-- nice alias for the base class ctor
if rawget(c,'_base') then obj.super = c._base._init end
local res = c._init(obj,...)
obj.super = nil
return res
end
local function is_a(self,klass)
local m = getmetatable(self)
if not m then return false end --*can't be an object!
while m do
if m == klass then return true end
m = rawget(m,'_base')
end
return false
end
local function class_of(klass,obj)
if type(klass) ~= 'table' or not rawget(klass,'is_a') then return false end
return klass.is_a(obj,klass)
end
local function _class_tostring (obj)
local mt = obj._class
local name = rawget(mt,'_name')
setmetatable(obj,nil)
local str = tostring(obj)
setmetatable(obj,mt)
if name then str = name ..str:gsub('table','') end
return str
end
local function _class(base,c_arg,c)
c = c or {} -- a new class instance, which is the metatable for all objects of this type
-- the class will be the metatable for all its objects,
-- and they will look up their methods in it.
local mt = {} -- a metatable for the class instance
if type(base) == 'table' then
-- our new class is a shallow copy of the base class!
tupdate(c,base)
c._base = base
-- inherit the 'not found' handler, if present
if rawget(c,'_handler') then mt.__index = c._handler end
elseif base ~= nil then
error("must derive from a table type")
end
c.__index = c
setmetatable(c,mt)
c._init = nil
if base and rawget(base,'_class_init') then
base._class_init(c,c_arg)
end
-- expose a ctor which can be called by <classname>(<args>)
mt.__call = function(class_tbl,...)
local obj = {}
setmetatable(obj,c)
if rawget(c,'_init') then -- explicit constructor
local res = call_ctor(c,obj,...)
if res then -- _if_ a ctor returns a value, it becomes the object...
obj = res
setmetatable(obj,c)
end
elseif base and rawget(base,'_init') then -- default constructor
-- make sure that any stuff from the base class is initialized!
call_ctor(base,obj,...)
end
if base and rawget(base,'_post_init') then
base._post_init(obj)
end
if not rawget(c,'__tostring') then
c.__tostring = _class_tostring
end
return obj
end
-- Call Class.catch to set a handler for methods/properties not found in the class!
c.catch = function(handler)
c._handler = handler
mt.__index = handler
end
c.is_a = is_a
c.class_of = class_of
c._class = c
-- any object can have a specified delegate which is called with unrecognized methods
-- if _handler exists and obj[key] is nil, then pass onto handler!
c.delegate = function(self,obj)
mt.__index = function(tbl,key)
local method = obj[key]
if method then
return function(self,...)
return method(obj,...)
end
elseif self._handler then
return self._handler(tbl,key)
end
end
end
return c
end
--- create a new class, derived from a given base class.
-- supporting two class creation syntaxes:
-- either 'Name = class()' or'class.Name()'
-- @class function
-- @name class
-- @param base optional base class
-- @param c_arg optional parameter to class ctor
-- @param c optional table to be used as class
local class = setmetatable({},{
__call = function(fun,...)
return _class(...)
end,
__index = function(tbl,key)
local env = getfenv(2)
return function(...)
local c = _class(...)
c._name = key
rawset(env,key,c)
return c
end
end
})
pl.class.class = class
-- the Map class ---------------------
class(nil,nil,Map)
local function makemap (m)
return setmetatable(m,Map)
end
function Map:_init (t)
local mt = getmetatable(t)
if mt == Set or mt == Map then
self:update(t)
else
return t -- otherwise assumed to be a map-like table
end
end
local values,keys = tablex.values,tablex.keys
--- list of keys.
function Map:keys ()
return List(keys(self))
end
--- list of values.
function Map:values ()
return List(values(self))
end
--- return an iterator over all key-value pairs.
function Map:iter ()
return pairs(self)
end
--- return a List of all key-value pairs, sorted by the keys.
function Map:items()
local ls = List (tablex.pairmap (function (k,v) return List {k,v} end, self))
ls:sort(function(t1,t2) return t1[1] < t2[1] end)
return ls
end
-- Will return the existing value, or if it doesn't exist it will set
-- a default value and return it.
function Map:setdefault(key, defaultval)
return self[key] or self:set(key,defaultval) or defaultval
end
--- size of map.
-- note: this is a relatively expensive operation!
-- @class function
-- @name Map:len
Map.len = tablex.size
--- put a value into the map.
-- @param key the key
-- @param val the value
function Map:set (key,val)
self[key] = val
end
--- get a value from the map.
-- @param key the key
-- @return the value, or nil if not found.
function Map:get (key)
return rawget(self,key)
end
local index_by = tablex.index_by
-- get a list of values indexed by a list of keys.
-- @param keys a list-like table of keys
-- @return a new list
function Map:getvalues (keys)
return List(index_by(self,keys))
end
Map.iter = pairs
Map.update = tablex.update
function Map:__eq (m)
-- note we explicitly ask deepcompare _not_ to use __eq!
return deepcompare(self,m,true)
end
function Map:__tostring ()
return pretty_write(self,'')
end
-- the Set class --------------------
class(Map,nil,Set)
local function makeset (t)
return setmetatable(t,Set)
end
function Set:_init (t)
local mt = getmetatable(t)
if mt == Set or mt == Map then
for k in pairs(t) do self[k] = true end
else
for _,v in ipairs(t) do self[v] = true end
end
end
function Set:__tostring ()
return '['..self:keys():join ','..']'
end
--- add a value to a set.
-- @param key a value
function Set:set (key)
self[key] = true
end
--- remove a value from a set.
-- @param key a value
function Set:unset (key)
self[key] = nil
end
--- get a list of the values in a set.
-- @class function
-- @name Set:values
Set.values = Map.keys
--- map a function over the values of a set.
-- @param fn a function
-- @param ... extra arguments to pass to the function.
-- @return a new set
function Set:map (fn,...)
fn = utils.function_arg(fn)
local res = {}
for k in pairs(self) do
res[fn(k,...)] = true
end
return makeset(res)
end
--- union of two sets (also +).
-- @param set another set
-- @return a new set
function Set:union (set)
return merge(self,set,true)
end
Set.__add = Set.union
--- intersection of two sets (also *).
-- @param set another set
-- @return a new set
function Set:intersection (set)
return merge(self,set,false)
end
Set.__mul = Set.intersection
--- new set with elements in the set that are not in the other (also -).
-- @param set another set
-- @return a new set
function Set:difference (set)
return difference(self,set,false)
end
Set.__sub = Set.difference
-- a new set with elements in _either_ the set _or_ other but not both (also ^).
-- @param set another set
-- @return a new set
function Set:symmetric_difference (set)
return difference(self,set,true)
end
Set.__pow = Set.symmetric_difference
--- is the first set a subset of the second?.
-- @return true or false
function Set:issubset (set)
for k in pairs(self) do
if not set[k] then return false end
end
return true
end
Set.__lt = Set.subset
--- is the set empty?.
-- @return true or false
function Set:issempty ()
return next(self) == nil
end
--- are the sets disjoint? (no elements in common).
-- Uses naive definition, i.e. that intersection is empty
-- @param set another set
-- @return true or false
function Set:isdisjoint (set)
return self:intersection(set):isempty()
end
return pl.class

177
moo/moolua/pl/classx.lua Normal file
View File

@ -0,0 +1,177 @@
--- extra classes: MultiMap, OrderedMap and Typed List.
-- @class module
-- @name pl.classx
local function module(...) end
module 'pl.classx'
local classes = require 'pl.class'
local tablex = require 'pl.tablex'
local utils = require 'pl.utils'
local List = require 'pl.list' . List
local class,Map = classes.class,classes.Map
local index_by,tsort,concat = tablex.index_by,table.sort,table.concat
local append,extend,slice = List.append,List.extend,List.slice
local append = table.insert
local is_type = utils.is_type
pl.classx = {}
-- MultiMap is a standard MT
local MultiMap = utils.stdmt.MultiMap
class(Map,nil,MultiMap)
MultiMap._name = 'MultiMap'
function MultiMap:_init (t)
self:update(t)
end
--- update a MultiMap using a table.
-- @param t either a Multimap or a map-like table.
function MultiMap:update (t)
if not t then return end
if Map:class_of(t) then
for k,v in pairs(t) do
self[k] = List()
self[k]:append(v)
end
else
for k,v in pairs(t) do
self[k] = List(v)
end
end
end
--- add a new value to a key.
-- @param key the key
-- @param val the value
function MultiMap:set (key,val)
if not self[key] then
self[key] = List()
end
self[key]:append(val)
end
local OrderedMap = class(Map)
OrderedMap._name = 'OrderedMap'
function OrderedMap:_init (t)
self._keys = List()
if t then self:update(t) end
end
--- update an OrderedMap using a table.
-- @param t map-like table.
function OrderedMap:update (t)
local keys = self._keys
for k,v in pairs(t) do
keys:append(k)
self[k] = v
end
end
--- set the key's value.
-- @param key the key
-- @param val the value
function OrderedMap:set (key,val)
self._keys:append(key)
self[key] = val
end
--- return the keys in order.
-- (Not a copy!)
function OrderedMap:keys ()
return self._keys
end
--- return the values in order.
-- this is relatively expensive.
function OrderedMap:values ()
return List(index_by(self,self._keys))
end
--- sort the keys.
function OrderedMap:sort (cmp)
tsort(self._keys,cmp)
end
--- iterate over key-value pairs in order.
function OrderedMap:iter ()
local i = 0
local keys = self._keys
local n,idx = #keys
return function()
i = i + 1
if i > #keys then return nil end
idx = keys[i]
return idx,self[idx]
end
end
function OrderedMap:__tostring ()
local res = {}
for i,v in ipairs(self._keys) do
res[i] = tostring(v)..'='..tostring(self[v])
end
return '{'..concat(res,',')..'}'
end
local function name_of_type (tp)
local tname = type(tp)
if tname == 'table' then
if rawget(tp,'_class') then
tname = rawget(tp,'_name')
if tname then return tname end
end
return '<table>'
else
return tname
end
end
--- construct a specific TypedList.
-- For example, class.StringList(TypedList,'string')
-- @class table
-- @name TypedList
local TypedList = class(List)
TypedList._name = 'TypedList'
function TypedList._class_init (klass,type)
klass._type = type
klass._name = 'TypedList<'..name_of_type(type)..'>'
end
--- append a value to the list.
-- Will throw an error if the value is not of the correct type.
-- @param val a value of the correct type.
-- @return the list
function TypedList:append (val)
if not is_type(val,self._type) then error ('not a '..name_of_type(self._type)) end
return append(self,val)
end
--- extend the list using another list.
-- @param L a list of the same type.
-- @return the list
function TypedList:extend (L)
if self._class ~= L._class then error ('cannot extend with another List type') end
return extend(self,L)
end
--- return a slice of the list
-- @param i1 start of slice
-- @param i2 end of slice
-- @return a new typed list
-- @see pl.List:slice
function TypedList:slice (i1,i2)
return setmetatable(slice(self,i1,i2),self._class)
end
pl.classx.OrderedMap = OrderedMap
pl.classx.MultiMap = MultiMap
pl.classx.TypedList = TypedList
return pl.classx

24
moo/moolua/pl/compat52.lua Normal file
View File

@ -0,0 +1,24 @@
if _VERSION == "Lua 5.2" then
require 'debug'
getfenv = function(level)
return debug.getfenv(debug.getinfo(level+1,'f').func)
end
setfenv = function(level,env)
if type(level) == 'number' then
level = debug.getinfo(level+1,'f').func
end
return debug.setfenv(level,env)
end
unpack = table.unpack
string.gfind = string.gmatch
else
local dir_separator = package.config:sub(1,1)
function package.searchpath (mod,path)
mod = mod:gsub('%.',dir_separator)
for m in path:gmatch('[^;]+') do
local nm = m:gsub('?',mod)
local f = io.open(nm,'r')
if f then f:close(); return nm end
end
end
end

278
moo/moolua/pl/comprehension.lua Normal file
View File

@ -0,0 +1,278 @@
--- List comprehensions implemented in Lua.
-- @class module
-- @name pl.comprehension
--
-- http://lua-users.org/wiki/ListComprehensions
--
-- Example:
-- local comp = require 'comprehension' . new()
-- assert(comp 'sum(x^2 for x)' {2,3,4} == 2^2+3^2+4^2)
--
-- (c) 2008 David Manura. Licensed under the same terms as Lua (MIT license).
--
local assert = assert
local loadstring = loadstring
local tonumber = tonumber
local math_max = math.max
local table_concat = table.concat
local getfenv = getfenv
local setfenv = setfenv
local ipairs = ipairs
local setmetatable = setmetatable
local _G = _G
local lb = require "pl.luabalanced"
local utils = require 'pl.utils'
-- fold operations
-- http://en.wikipedia.org/wiki/Fold_(higher-order_function)
local ops = {
list = {init=' {} ', accum=' __result[#__result+1] = (%s) '},
table = {init=' {} ', accum=' local __k, __v = %s __result[__k] = __v '},
sum = {init=' 0 ', accum=' __result = __result + (%s) '},
min = {init=' nil ', accum=' local __tmp = %s ' ..
' if __result then if __tmp < __result then ' ..
'__result = __tmp end else __result = __tmp end '},
max = {init=' nil ', accum=' local __tmp = %s ' ..
' if __result then if __tmp > __result then ' ..
'__result = __tmp end else __result = __tmp end '},
}
-- Parses comprehension string <expr>.
-- Returns output expression list <out> string, array of for types
-- ('=', 'in' or nil) <fortypes>, array of input variable name
-- strings <invarlists>, array of input variable value strings
-- <invallists>, array of predicate expression strings <preds>,
-- operation name string <opname>, and number of placeholder
-- parameters <max_param>.
--
-- The is equivalent to the mathematical set-builder notation:
--
-- <opname> { <out> | <invarlist> in <invallist> , <preds> }
--
-- Examples:
-- "x^2 for x" -- array values
-- "x^2 for x=1,10,2" -- numeric for
-- "k^v for k,v in pairs(_1)" -- iterator for
-- "(x+y)^2 for x for y if x > y" -- nested
--
local function parse_comprehension(expr)
local t = {}
local pos = 1
-- extract opname (if exists)
local opname
local tok, post = expr:match('^%s*([%a_][%w_]*)%s*%(()', pos)
local pose = #expr + 1
if tok then
local tok2, posb = lb.match_bracketed(expr, post-1)
assert(tok2, 'syntax error')
if expr:match('^%s*$', posb) then
opname = tok
pose = posb - 1
pos = post
end
end
opname = opname or "list"
-- extract out expression list
local out; out, pos = lb.match_explist(expr, pos)
assert(out, "syntax error: missing expression list")
out = table_concat(out, ', ')
-- extract "for" clauses
local fortypes = {}
local invarlists = {}
local invallists = {}
while 1 do
local post = expr:match('^%s*for%s+()', pos)
if not post then break end
pos = post
-- extract input vars
local iv; iv, pos = lb.match_namelist(expr, pos)
assert(#iv > 0, 'syntax error: zero variables')
for _,ident in ipairs(iv) do
assert(not ident:match'^__',
"identifier " .. ident .. " may not contain __ prefix")
end
invarlists[#invarlists+1] = iv
-- extract '=' or 'in' (optional)
local fortype, post = expr:match('^(=)%s*()', pos)
if not fortype then fortype, post = expr:match('^(in)%s+()', pos) end
if fortype then
pos = post
-- extract input value range
local il; il, pos = lb.match_explist(expr, pos)
assert(#il > 0, 'syntax error: zero expressions')
assert(fortype ~= '=' or #il == 2 or #il == 3,
'syntax error: numeric for requires 2 or three expressions')
fortypes[#invarlists] = fortype
invallists[#invarlists] = il
else
fortypes[#invarlists] = false
invallists[#invarlists] = false
end
end
assert(#invarlists > 0, 'syntax error: missing "for" clause')
-- extract "if" clauses
local preds = {}
while 1 do
local post = expr:match('^%s*if%s+()', pos)
if not post then break end
pos = post
local pred; pred, pos = lb.match_expression(expr, pos)
assert(pred, 'syntax error: predicated expression not found')
preds[#preds+1] = pred
end
-- extract number of parameter variables (name matching "_%d+")
local stmp = ''; lb.gsub(expr, function(u, sin) -- strip comments/strings
if u == 'e' then stmp = stmp .. ' ' .. sin .. ' ' end
end)
local max_param = 0; stmp:gsub('[%a_][%w_]*', function(s)
local s = s:match('^_(%d+)$')
if s then max_param = math_max(max_param, tonumber(s)) end
end)
if pos ~= pose then
assert(false, "syntax error: unrecognized " .. expr:sub(pos))
end
--DEBUG:
--print('----\n', string.format("%q", expr), string.format("%q", out), opname)
--for k,v in ipairs(invarlists) do print(k,v, invallists[k]) end
--for k,v in ipairs(preds) do print(k,v) end
return out, fortypes, invarlists, invallists, preds, opname, max_param
end
-- Create Lua code string representing comprehension.
-- Arguments are in the form returned by parse_comprehension.
local function code_comprehension(
out, fortypes, invarlists, invallists, preds, opname, max_param
)
local op = assert(ops[opname])
local code = op.accum:gsub('%%s', out)
for i=#preds,1,-1 do local pred = preds[i]
code = ' if ' .. pred .. ' then ' .. code .. ' end '
end
for i=#invarlists,1,-1 do
if not fortypes[i] then
local arrayname = '__in' .. i
local idx = '__idx' .. i
code =
' for ' .. idx .. ' = 1, #' .. arrayname .. ' do ' ..
' local ' .. invarlists[i][1] .. ' = ' .. arrayname .. '['..idx..'] ' ..
code .. ' end '
else
code =
' for ' ..
table_concat(invarlists[i], ', ') ..
' ' .. fortypes[i] .. ' ' ..
table_concat(invallists[i], ', ') ..
' do ' .. code .. ' end '
end
end
code = ' local __result = ( ' .. op.init .. ' ) ' .. code
return code
end
-- Convert code string represented by code_comprehension
-- into Lua function. Also must pass ninputs = #invarlists,
-- max_param, and invallists (from parse_comprehension).
-- Uses environment env.
local function wrap_comprehension(code, ninputs, max_param, invallists, env)
assert(ninputs > 0)
local ts = {}
for i=1,max_param do
ts[#ts+1] = '_' .. i
end
for i=1,ninputs do
if not invallists[i] then
local name = '__in' .. i
ts[#ts+1] = name
end
end
if #ts > 0 then
code = ' local ' .. table_concat(ts, ', ') .. ' = ... ' .. code
end
code = code .. ' return __result '
--print('DEBUG:', code)
local f, err = loadstring(code)
if not f then assert(false, err .. ' with generated code ' .. code) end
setfenv(f, env)
return f
end
-- Build Lua function from comprehension string.
-- Uses environment env.
local function build_comprehension(expr, env)
local out, fortypes, invarlists, invallists, preds, opname, max_param
= parse_comprehension(expr)
local code = code_comprehension(
out, fortypes, invarlists, invallists, preds, opname, max_param)
local f = wrap_comprehension(code, #invarlists, max_param, invallists, env)
return f
end
-- Creates new comprehension cache.
-- Any list comprehension function created are set to the environment
-- env (defaults to caller of new).
local function new(env)
-- Note: using a single global comprehension cache would have had
-- security implications (e.g. retrieving cached functions created
-- in other environments).
-- The cache lookup function could have instead been written to retrieve
-- the caller's environment, lookup up the cache private to that
-- environment, and then looked up the function in that cache.
-- That would avoid the need for this <new> call to
-- explicitly manage caches; however, that might also have an undue
-- performance penalty.
env = env or getfenv(2)
local mt = {}
local cache = setmetatable({}, mt)
-- Index operator builds, caches, and returns Lua function
-- corresponding to comprehension expression string.
--
-- Example: f = comprehension['x^2 for x']
--
function mt:__index(expr)
local f = build_comprehension(expr, env)
self[expr] = f -- cache
return f
end
-- Convenience syntax.
-- Allows comprehension 'x^2 for x' instead of comprehension['x^2 for x'].
mt.__call = mt.__index
cache.new = new
return cache
end
local comprehension = {}
comprehension.new = new
-- a default instance
local C = new()
utils.add_function_factory(getmetatable "",function(s)
return C(s)
end)
return comprehension

127
moo/moolua/pl/config.lua Normal file
View File

@ -0,0 +1,127 @@
--- reads configuration files into a Lua table. <br>
-- Understands INI files, classic Unix config files, and simple
-- delimited columns of values. <br>
-- See the Guide for further <a href="../../index.html#config">discussion</a>
-- @class module
-- @name pl.config
local stringx = require ('pl.stringx')
local split,strip = stringx.split,stringx.strip
local type,tonumber,ipairs,io = type,tonumber,ipairs,io
local utils = require 'pl.utils'
local raise = utils.raise
module ('pl.config',utils._module)
-- @class table
-- @name configuration
-- @field variablilize make names into valid Lua identifiers (default true)
-- @field convert_numbers try to convert values into numbers (default true)
-- @field trim_space ensure that there is no starting or trailing whitespace with values (default true)
-- @field list_delim delimiter to use when separating columns (default ',')
--- like io.lines(), but allows for lines to be continued with '\'.
-- @param file a file-like object (anything where read() returns the next line) or a filename.
-- Defaults to stardard input.
-- @return an iterator over the lines
function lines(file)
local f,openf,err
local line = ''
if type(file) == 'string' then
f,err = io.open(file,'r')
if not f then return raise(err) end
openf = true
else
f = file or io.stdin
if not file.read then return raise 'not a file-like object' end
end
if not f then return raise'file is nil' end
return function()
local l = f:read()
while l do
-- does the line end with '\'?
local i = l:find '\\%s*$'
if i then -- if so,
line = line..l:sub(1,i-1)
elseif line == '' then
return l
else
l = line..l
line = ''
return l
end
l = f:read()
end
if openf then f:close() end
end
end
--- read a configuration file into a table
-- @param file either a file-like object or a string, which must be a filename
-- @param cnfg a configuration table
-- @return nil,error_msg in case of an error, otherwise a table containing items
function read(file,cnfg)
local f,openf,err
if not cnfg then
cnfg = {variablilize = true, convert_numbers = true,
trim_space = true, list_delim=','
}
end
local t = {}
local top_t = t
local variablilize = cnfg.variablilize
local list_delim = cnfg.list_delim
local convert_numbers = cnfg.convert_numbers
local trim_space = cnfg.trim_space
local function process_name(key)
if variablilize then
key = key:gsub('[^%w]','_')
end
return key
end
local function process_value(value)
if list_delim and value:find(list_delim) then
value = split(value,list_delim)
for i,v in ipairs(value) do
value[i] = process_value(v)
end
elseif convert_numbers and value:find('^[%d%+%-]') then
local val = tonumber(value)
if val then value = val end
end
if trim_space and type(value) == 'string' then
value = strip(value)
end
return value
end
local iter,err = lines(file)
if not iter then return raise(err) end
for line in iter do
-- strips comments
local ci = line:find('%s*[#;]')
if ci then line = line:sub(1,ci-1) end
-- and ignore blank lines
if line:find('^%s*$') then
elseif line:find('^%[') then -- section!
local section = process_name(line:match('%[([^%]]+)%]'))
t = top_t
t[section] = {}
t = t[section]
else
local i1,i2 = line:find('%s*=%s*')
if i1 then -- key,value assignment
local key = process_name(line:sub(1,i1-1))
local value = process_value(line:sub(i2+1))
t[key] = value
else -- a plain list of values...
t[#t+1] = process_value(line)
end
end
end
return top_t
end

447
moo/moolua/pl/data.lua Normal file
View File

@ -0,0 +1,447 @@
--- Reading and querying simple tabular data. <br>
-- This provides a way of creating basic SQL-like queries. <br>
-- See <a href="../../index.html#data">the Guide</a>
-- @class module
-- @name pl.data
local stringx = require 'pl.stringx'
local utils = require 'pl.utils'
local seq = require 'pl.seq'
local tablex = require 'pl.tablex'
local List = require 'pl.list'.List
local rstrip,count = stringx.rstrip,stringx.count
local _DEBUG = rawget(_G,'_DEBUG')
local throw,patterns,choose,function_arg,split = utils.throw,utils.patterns,utils.choose,utils.function_arg,utils.split
local append,concat = table.insert,table.concat
local map,find = tablex.map,tablex.find
local gsub = string.gsub
local io = io
local _G,print,loadstring,type,tonumber,ipairs,setmetatable,pcall,error,setfenv = _G,print,loadstring,type,tonumber,ipairs,setmetatable,pcall,error,setfenv
module ('pl.data',utils._module)
local parse_select
local DataMT = {
column_by_name = function(self,name)
return seq.copy(query(self,name))
end,
copy_query = function(self,condn)
condn = parse_select(condn,self)
local res = seq.copy_tuples(query(self,condn))
res.delim = self.delim
return new(res,List.split(condn.fields,','))
end,
column_names = function(self)
return self.fieldnames
end,
}
DataMT.__index = DataMT
-- [guessing delimiter] We check for comma, tab and spaces in that order.
-- [issue] any other delimiters to be checked?
local function guess_delim (line)
if count(line,',') > 0 then
return ','
elseif count(line,'\t') > 0 then
return '\t'
elseif count(line,' ') > 0 then
return '%s+'
else
return ' '
end
end
-- [file parameter] If it's a string, we try open as a filename. If nil, then
-- either stdin or stdout depending on the mode. Otherwise, check if this is
-- a file-like object (implements read or write depending)
local function open_file (f,mode)
local opened
local reading = mode == 'r'
if type(f) == 'string' then
f,err = io.open(f,mode)
if not f then return throw(err) end
opened = true
end
if f and ((reading and not f.read) or (not reading and not f.write)) then
return throw "not a file-like object"
end
return (f or (reading and io.stdin or io.stdout)),nil,opened
end
local function all_n ()
end
--- read a delimited file in a Lua table.
-- By default, attempts to treat first line as separated list of fieldnames.
-- @param file a filename or a file-like object (default stdin)
-- @param cnfig options: can override delim (a string pattern), fieldnames (a list),
-- specify no_convert (default is to convert), numfields (indices of columns known
-- to be numbers) and thousands_dot (thousands separator in Excel CSV is '.')
function read(file,cnfg)
local list = seq.list
local convert,err,opened
local data = {}
if not cnfg then cnfg = {} end
local f,err,opened = open_file(file,'r')
if not f then return throw (err) end
local thousands_dot = cnfg.thousands_dot
local function try_tonumber(x)
if thousands_dot then x = x:gsub('%.(...)','%1') end
return tonumber(x)
end
local line = f:read()
if not line then return throw "empty file" end
-- first question: what is the delimiter?
data.delim = cnfg.delim and cnfg.delim or guess_delim(line)
local delim = data.delim
local collect_end = cnfg.last_field_collect
-- first line will usually be field names. Unless fieldnames are specified,
-- we check if it contains purely numerical values for the case of reading
-- plain data files.
if not cnfg.fieldnames then
local fields = List.split(line,delim)
local nums = map(tonumber,fields)
if #nums == #fields then
convert = tonumber
append(data,nums)
else
cnfg.fieldnames = fields
end
line = f:read()
elseif type(cnfg.fieldnames) == 'string' then
cnfg.fieldnames = List.split(cnfg.fieldnames,delim)
end
-- at this point, the column headers have been read in. If the first
-- row consisted of numbers, it has already been added to the dataset.
local numfields = cnfg.numfields
if cnfg.fieldnames then
data.fieldnames = cnfg.fieldnames
-- [conversion] unless @no_convert, we need the numerical field indices
-- of the first data row. Can also be specified by @numfields.
if not cnfg.no_convert then
if not numfields then
numfields = List()
local fields = split(line,data.delim)
for i = 1,#fields do
if tonumber(fields[i]) then
numfields:append(i)
end
end
end
if #numfields > 0 then -- there are numerical fields
-- note that using dot as the thousands separator (@thousands_dot)
-- requires a special conversion function!
convert = thousands_dot and try_tonumber or tonumber
end
end
end
local N = #data.fieldnames
-- keep going until finished
while line do
if not line:find ('^%s*$') then
local fields = split(line,delim)
if convert then
for i in list(numfields) do
local val = convert(fields[i])
if val == nil then
return throw ("not a number: "..fields[i])
else
fields[i] = val
end
end
end
-- [collecting end field] If @last_field_collect then we will collect
-- all extra space-delimited fields into a single last field.
if collect_end and #fields > N then
local ends = List(fields):slice(N):join ' '
tablex.icopy(fields,{ends},N) --*note* copy
end
append(data,fields)
end
line = f:read()
end
if opened then f:close() end
if delim == '%s+' then data.delim = ' ' end
return new(data)
end
local function write_row (data,f,row)
f:write(List.join(row,data.delim),'\n')
end
DataMT.write_row = write_row
local function write (data,file)
local f,err,opened = open_file(file,'w')
if not f then return throw (err) end
f:write(data.fieldnames:join(data.delim),'\n')
for i = 1,#data do
write_row(data,f,data[i])
end
if opened then f:close() end
end
DataMT.write = write
local function massage_fieldnames (fields)
-- [fieldnames must be valid Lua identifiers]
for i = 1,#fields do
fields[i] = fields[i]:gsub('%A','_')
end
end
--- create a new dataset from a table of rows. <br>
-- Can specify the fieldnames, else the table must have a field called
-- 'fieldnames', which is either a string of comma-separated names,
-- or a table of names.
-- @param data the table.
-- @param fieldnames optional fieldnames
-- @return the table.
function new (data,fieldnames)
data.fieldnames = data.fieldnames or fieldnames
if not data.delim and type(data.fieldnames) == 'string' then
data.delim = guess_delim(data.fieldnames)
data.fieldnames = split(data.fieldnames,data.delim)
end
data.fieldnames = List(data.fieldnames)
massage_fieldnames(data.fieldnames)
setmetatable(data,DataMT)
-- a query with just the fieldname will return a sequence
-- of values, which seq.copy turns into a table.
return data
end
local sorted_query = [[
return function (t)
local i = 0
local v
local ls = {}
for i,v in ipairs(t) do
if CONDITION then
ls[#ls+1] = v
end
end
table.sort(ls,function(v1,v2)
return SORT_EXPR
end)
local n = #ls
return function()
i = i + 1
v = ls[i]
if i > n then return end
return FIELDLIST
end
end
]]
-- question: is this optimized case actually worth the extra code?
local simple_query = [[
return function (t)
local n = #t
local i = 0
local v
return function()
repeat
i = i + 1
v = t[i]
until i > n or CONDITION
if i > n then return end
return FIELDLIST
end
end
]]
local function is_string (s)
return type(s) == 'string'
end
local field_error
function fieldnames_as_string (data)
return concat(data.fieldnames,',')
end
local function massage_fields(data,f)
local idx = find(data.fieldnames,f)
if idx then
return 'v['..idx..']'
else
field_error = f..' not found in '..fieldnames_as_string(data)
return f
end
end
local function process_select (data,parms)
--- preparing fields ----
local res,ret
field_error = nil
if parms.fields:find '^%s*%*%s*' then
parms.fields = fieldnames_as_string(data)
end
local fields = rstrip(parms.fields):gsub('[^,%w]','_') -- non-identifier chars
local massage_fields = utils.bind1(massage_fields,data)
ret = gsub(fields,patterns.IDEN,massage_fields)
if field_error then return throw(field_error) end
parms.proc_fields = ret
parms.where = parms.where or 'true'
if is_string(parms.where) then
parms.where = gsub(parms.where,patterns.IDEN,massage_fields)
field_error = nil
end
return true
end
parse_select = function(s,data)
local endp
local parms = {}
local w1,w2 = s:find('where ')
local s1,s2 = s:find('sort by ')
if w1 then -- where clause!
endp = (s1 or 0)-1
parms.where = s:sub(w2+1,endp)
end
if s1 then -- sort by clause (must be last!)
parms.sort_by = s:sub(s2+1)
end
endp = (w1 or s1 or 0)-1
parms.fields = s:sub(1,endp)
local status,err = process_select(data,parms)
if not status then return throw(err)
else return parms end
end
--- create a query iterator from a select string.
-- Select string has this format: <br>
-- FIELDLIST [ where LUA-CONDN [ sort by FIELD] ]<br>
-- FIELDLISt is a comma-separated list of valid fields, or '*'. <br> <br>
-- The condition can also be a table, with fields 'fields' (comma-sep string or
-- table), 'sort_by' (string) and 'where' (Lua expression string or function)
-- @param data table produced by read
-- @param condn select string or table
-- @param context a list of tables to be searched when resolving functions
-- @param return_row if true, wrap the results in a row table
-- @return an iterator over the specified fields
function query(data,condn,context,return_row)
local err
if is_string(condn) then
condn,err = parse_select(condn,data)
if not condn then return throw(err) end
elseif type(condn) == 'table' then
if type(condn.fields) == 'table' then
condn.fields = concat(condn.fields,',')
end
if not condn.proc_fields then
local status,err = process_select(data,condn)
if not status then return throw(err) end
end
else
return throw "condition must be a string or a table"
end
local query
if condn.sort_by then -- use sorted_query
query = sorted_query
else
query = simple_query
end
local fields = condn.proc_fields or condn.fields
if return_row then
fields = '{'..fields..'}'
end
query,k = query:gsub('FIELDLIST',fields)
if is_string(condn.where) then
query = query:gsub('CONDITION',condn.where)
condn.where = nil
else
query = query:gsub('CONDITION','_condn(v)')
condn.where = function_arg(condn.where)
end
if condn.sort_by then
local expr,sort_var,sort_dir
local sort_by = condn.sort_by
local i1,i2 = sort_by:find('%s+')
if i1 then
sort_var,sort_dir = sort_by:sub(1,i1-1),sort_by:sub(i2+1)
else
sort_var = sort_by
sort_dir = 'asc'
end
sort_var = massage_fields(data,sort_var)
if field_error then return throw(field_error) end
if sort_dir == 'asc' then
sort_dir = '<'
else
sort_dir = '>'
end
expr = ('%s %s %s'):format(sort_var:gsub('v','v1'),sort_dir,sort_var:gsub('v','v2'))
query = query:gsub('SORT_EXPR',expr)
end
if condn.where then
query = 'return function(_condn) '..query..' end'
end
if _DEBUG then print(query) end
local fn,err = loadstring(query,'tmp')
if not fn then return throw(err) end
fn = fn() -- get the function
if condn.where then
fn = fn(condn.where)
end
local qfun = fn(data)
if context then
-- [specifying context for condition] @context is a list of tables which are
-- 'injected'into the condition's custom context
append(context,_G)
local lookup = {}
setfenv(qfun,lookup)
setmetatable(lookup,{
__index = function(tbl,key)
-- _G.print(tbl,key)
for k,t in ipairs(context) do
if t[key] then return t[key] end
end
end
})
end
return qfun
end
DataMT.select = query
DataMT.select_row = function(data,condn,context)
return query(data,condn,context,true)
end
--- Filter input using a query.
-- @param Q a query string
-- @param file a file-like object
-- @param dont_fail true if you want to return an error, not just fail
function filter (Q,file,dont_fail)
local err
local d = read(file)
local iter,err = d:select(Q)
local delim = d.delim
if not iter then
err = 'error: '..err
if dont_fail then
return nil,err
else
utils.quit(1,err)
end
end
while true do
local res = {iter()}
if #res == 0 then break end
print(concat(res,delim))
end
end

309
moo/moolua/pl/dir.lua Normal file
View File

@ -0,0 +1,309 @@
-------------------------------------------------------------------------------
-- Useful functions for getting directory contents and matching them against wildcards
local lfs = require 'lfs'
local utils = require 'pl.utils'
local path = require 'pl.path'
local is_windows = path.is_windows
local tablex = require 'pl.tablex'
local attrib = lfs.attributes
local ldir = lfs.dir
local chdir = lfs.chdir
local mkdir = lfs.mkdir
local escape = utils.escape
local os,pcall,ipairs,require,setmetatable,_G = os,pcall,ipairs,require,setmetatable,_G
local remove = os.remove
local append = table.insert
local print = print
local wrap = coroutine.wrap
local yield = coroutine.yield
local assert_arg,assert_string,raise = utils.assert_arg,utils.assert_string,utils.raise
local List = utils.stdmt.List
module ('pl.dir',utils._module)
local function assert_dir (n,val)
assert_arg(n,val,'string',path.isdir,'not a directory')
end
local function assert_file (n,val)
assert_arg(n,val,'string',path.isfile,'not a file')
end
local function filemask(mask)
mask = escape(mask)
return mask:gsub('%%%*','.+'):gsub('%%%?','.')..'$'
end
--- does the filename match the shell pattern?.
-- (cf. fnmatch.fnmatch in Python, 11.8)
-- @param file A file name
-- @param pattern A shell pattern
function fnmatch(file,pattern)
assert_string(1,file)
assert_string(2,pattern)
return path.normcase(file):find(filemask(pattern)) ~= nil
end
--- return a list of all files in a list of files which match the pattern.
-- (cf. fnmatch.filter in Python, 11.8)
-- @param files A table containing file names
-- @param pattern A shell pattern.
function filter(files,pattern)
assert_arg(1,files,'table')
assert_string(2,pattern)
local res = {}
local mask = filemask(pattern)
for i,f in ipairs(files) do
if f:find(mask) then append(res,f) end
end
return setmetatable(res,List)
end
function _listfiles(dir,filemode,match)
local res = {}
if not dir then dir = '.' end
for f in ldir(dir) do
if f ~= '.' and f ~= '..' then
local p = path.join(dir,f)
local mode = attrib(p,'mode')
if mode == filemode and (not match or match(p)) then
append(res,p)
end
end
end
return setmetatable(res,List)
end
--- return a list of all files in a directory which match the a shell pattern.
-- @param dir A directory. If not given, all files in current directory are returned.
-- @param mask A shell pattern. If not given, all files are returned.
function getfiles(dir,mask)
assert_dir(1,dir)
assert_string(2,mask)
local match
if mask then
mask = filemask(mask)
match = function(f)
return f:find(mask)
end
end
return _listfiles(dir,'file',match)
end
--- return a list of all subdirectories of the directory.
-- @param dir A directory
function getdirectories(dir)
assert_dir(1,dir)
return _listfiles(dir,'directory')
end
local function quote_if_necessary (f)
if f:find '%s' then
return '"'..f..'"'
else
return f
end
end
local alien,no_alien,kernel,CopyFile,MoveFile
local function file_op (is_copy,src,dest,flag)
local null
if is_windows then
local res
-- if we haven't tried to load Alien before, then do so
if not alien and not no_alien then
res,alien = pcall(require,'alien')
no_alien = not res
if no_alien then alien = nil end
if alien then
-- register the Win32 CopyFile and MoveFile functions
local spec = {'string','string','int',ret='int',abi='stdcall'}
kernel = alien.load('kernel32.dll')
CopyFile = kernel.CopyFileA
CopyFile:types(spec)
MoveFile = kernel.MoveFileA
MoveFile:types(spec)
end
end
-- fallback if there's no Alien, just use DOS commands *shudder*
if not CopyFile then
cmd = is_copy and 'copy' or 'rename'
null = ' > NUL'
else
if is_copy then return CopyFile(src,dest,flag)
else return MoveFile(src,dest) end
end
else -- for Unix, just use cp for now
cmd = is_copy and 'cp' or 'mv'
null = ' 2> /dev/null'
end
src = quote_if_necessary(src)
dest = quote_if_necessary(dest)
-- let's make this as quiet a call as we can...
cmd = cmd..' '..src..' '..dest..null
--print(cmd)
return os.execute(cmd) ~= 0
end
--- copy a file.
-- @param src source file
-- @param dest destination file
-- @param flag true if you want to force the copy (default)
-- @return true if operation succeeded
function copyfile (src,dest,flag)
assert_string(1,src)
assert_string(2,dest)
flag = flag==nil or flag
return file_op(true,src,dest,flag and 0 or 1)==1
end
--- move a file.
-- @param src source file
-- @param dest destination file
-- @return true if operation succeeded
function movefile (src,dest)
assert_string(1,src)
assert_string(2,dest)
return file_op(false,src,dest,0)==1
end
local function _dirfiles(dir)
local dirs = {}
local files = {}
for f in ldir(dir) do
if f ~= '.' and f ~= '..' then
local p = path.join(dir,f)
local mode = attrib(p,'mode')
if mode=='directory' then
append(dirs,f)
else
append(files,f)
end
end
end
return setmetatable(dirs,List),setmetatable(files,List)
end
local function _walker(root,bottom_up)
local dirs,files = _dirfiles(root)
if not bottom_up then yield(root,dirs,files) end
for i,d in ipairs(dirs) do
_walker(root..path.sep..d,bottom_up)
end
if bottom_up then yield(root,dirs,files) end
end
--- return an iterator which walks through a directory tree starting at root.
-- The iterator returns (root,dirs,files)
-- Note that dirs and files are lists of names (i.e. you must say _path.join(root,d)_
-- to get the actual full path)
-- If bottom_up is false (or not present), then the entries at the current level are returned
-- before we go deeper. This means that you can modify the returned list of directories before
-- continuing.
-- This is a clone of os.walk from the Python libraries.
-- @param root A starting directory
-- @param bottom_up False if we start listing entries immediately.
function walk(root,bottom_up)
assert_string(1,root)
if not path.isdir(root) then return raise 'not a directory' end
return wrap(function () _walker(root,bottom_up) end)
end
--- remove a whole directory tree.
-- @param path A directory path
function rmtree(fullpath)
assert_string(1,fullpath)
if not path.isdir(fullpath) then return raise 'not a directory' end
for root,dirs,files in walk(fullpath,true) do
for i,f in ipairs(files) do
remove(path.join(root,f))
end
lfs.rmdir(root)
end
end
local dirpat
if path.is_windows then
dirpat = '(.+)\\[^\\]+$'
else
dirpat = '(.+)/[^/]+$'
end
function _makepath(p)
-- windows root drive case
if p:find '^%a:$' then
return true
end
if not path.isdir(p) then
local subp = p:match(dirpat)
if not _makepath(subp) then return raise ('cannot create '..subp) end
--print('create',p)
return lfs.mkdir(p)
else
return true
end
end
--- create a directory path.
-- This will create subdirectories as necessary!
-- @param path A directory path
function makepath (p)
assert_string(1,p)
return _makepath(path.normcase(path.abspath(p)))
end
--- clone a directory tree. Will always try to create a new directory structure
-- if necessary.
-- @param path1 the base path of the source tree
-- @param path2 the new base path for the destination
-- @param file_fun an optional function to apply on all files
-- @return if failed, false plus an error message. If completed the traverse,
-- true, a list of failed directory creations and a list of failed file operations.
-- @usage clonetree('.','../backup',copyfile)
function clonetree (path1,path2,file_fun,verbose)
assert_string(1,path1)
assert_string(2,path2)
local abspath,normcase,isdir,join = path.abspath,path.normcase,path.isdir,path.join
local faildirs,failfiles = {},{}
if not isdir(path1) then return raise 'source is not a valid directory' end
path1 = abspath(normcase(path1))
path2 = abspath(normcase(path2))
if verbose then verbose('normalized:',path1,path2) end
-- particularly NB that the new path isn't fully contained in the old path
if path1 == path2 then return raise "paths are the same" end
local i1,i2 = path2:find(path1,1,true)
if i2 == #path1 and path2:sub(i2+1,i2+1) == path.sep then
return raise 'destination is a subdirectory of the source'
end
local cp = path.common_prefix (path1,path2)
local idx = #cp
if idx == 0 then -- no common path, but watch out for Windows paths!
if path1:sub(2,2) == ':' then idx = 3 end
end
for root,dirs,files in walk(path1) do
local opath = path2..root:sub(idx)
if verbose then verbose('paths:',opath,root) end
if not isdir(opath) then
local ret = makepath(opath)
if not ret then append(faildirs,opath) end
if verbose then verbose('creating:',opath,ret) end
end
if file_fun then
for i,f in ipairs(files) do
local p1 = join(root,f)
local p2 = join(opath,f)
local ret = file_fun(p1,p2)
if not ret then append(failfiles,p2) end
if verbose then
verbose('files:',p1,p2,ret)
end
end
end
end
return true,faildirs,failfiles
end

64
moo/moolua/pl/file.lua Normal file
View File

@ -0,0 +1,64 @@
-------------------------------------------------------------------
-- File Operations: copy,move,reading,writing
local os = os
local utils = require 'pl.utils'
local dir = require 'pl.dir'
local path = require 'pl.path'
module ('pl.file',utils._module)
--- return the contents of a file as a string
-- @class function
-- @name read
-- @param filename The file path
-- @return file contents
read = utils.readfile
--- write a string to a file
-- @class function
-- @name write
-- @param filename The file path
-- @param str The string
write = utils.writefile
--- copy a file.
-- @class function
-- @name copy
-- @param src source file
-- @param dest destination file
-- @param flag true if you want to force the copy (default)
-- @return true if operation succeeded
copy = dir.copyfile
--- move a file.
-- @class function
-- @name move
-- @param src source file
-- @param dest destination file
-- @return true if operation succeeded
move = dir.movefile
--- Return the time of last access as the number of seconds since the epoch.
-- @class function
-- @name access_time
-- @param path A file path
access_time = path.getatime
---Return when the file was created.
-- @class function
-- @name creation_time
-- @param path A file path
creation_time = path.getctime
--- Return the time of last modification
-- @class function
-- @name modified_time
-- @param path A file path
modified_time = path.getmtime
--- Delete a file
-- @class function
-- @name delete
-- @param path A file path
delete = os.remove

353
moo/moolua/pl/func.lua Normal file
View File

@ -0,0 +1,353 @@
-----------------------------------------------------
--- Functional helpers like composition,binding and placeholder expressions. <br>
-- See <a href="../../index.html#func">the Guide</a>
local type,select,setmetatable,getmetatable,rawset = type,select,setmetatable,getmetatable,rawset
local concat,append = table.concat,table.insert
local max = math.max
local print,tostring = print,tostring
local pairs,getfenv,ipairs,loadstring,rawget,unpack = pairs,getfenv,ipairs,loadstring,rawget,unpack
local _G = _G
local utils = require 'pl.utils'
local tablex = require 'pl.tablex'
local map = tablex.map
local _DEBUG = rawget(_G,'_DEBUG')
local assert_arg = utils.assert_arg
module ('pl.func',utils._module)
local mod = _G.pl.func
-- metatable for Placeholder Expressions (PE)
local _PEMT = {}
local function P (t)
setmetatable(t,_PEMT)
return t
end
mod.PE = P
local function isPE (obj)
return getmetatable(obj) == _PEMT
end
mod.isPE = isPE
-- construct a placeholder variable (e.g _1 and _2)
local function PH (idx)
return P {op='X',repr='_'..idx, index=idx}
end
-- construct a constant placeholder variable (e.g _C1 and _C2)
local function CPH (idx)
return P {op='X',repr='_C'..idx, index=idx}
end
_1,_2,_3,_4,_5 = PH(1),PH(2),PH(3),PH(4),PH(5)
_0 = P{op='X',repr='...',index=0}
function Var (name)
local ls = utils.split(name,',')
local res = {}
for _,n in ipairs(ls) do
append(res,P{op='X',repr=n,index=0})
end
return unpack(res)
end
function _ (value)
return P{op='X',repr=value,index='wrap'}
end
Nil = Var 'nil'
function _PEMT.__index(obj,key)
return P{op='[]',obj,key}
end
function _PEMT.__call(fun,...)
return P{op='()',fun,...}
end
function _PEMT.__tostring (e)
return repr(e)
end
function _PEMT.__unm(arg)
return P{op='-',arg}
end
function Not (arg)
return P{op='not',arg}
end
function Len (arg)
return P{op='#',arg}
end
local function binreg(context,t)
for name,op in pairs(t) do
rawset(context,name,function(x,y)
return P{op=op,x,y}
end)
end
end
local function import_name (name,fun,context)
rawset(context,name,function(...)
return P{op='()',fun,...}
end)
end
local imported_functions = {}
local function is_global_table (n)
return type(_G[n]) == 'table'
end
--- wrap a table of functions. This makes them available for use in
-- placeholder expressions.
-- @param tname a table name
-- @param context context to put results, defaults to environment of caller
function import(tname,context)
assert_arg(1,tname,'string',is_global_table,'arg# 1: not a name of a global table')
local t = _G[tname]
context = context or getfenv(2)
for name,fun in pairs(t) do
import_name(name,fun,context)
imported_functions[fun] = name
end
end
--- register a function for use in placeholder expressions.
-- @param fun a function
-- @param an optional name
-- @return a placeholder functiond
function register (fun,name)
assert_arg(1,fun,'function')
if name then
assert_arg(2,name,'string')
imported_functions[fun] = name
end
return function(...)
return P{op='()',fun,...}
end
end
function lookup_imported_name (fun)
return imported_functions[fun]
end
local function _arg(...) return ... end
function Args (...)
return P{op='()',_arg,...}
end
-- binary and unary operators, with their precedences (see 2.5.6)
local operators = {
['or'] = 0,
['and'] = 1,
['=='] = 2, ['~='] = 2, ['<'] = 2, ['>'] = 2, ['<='] = 2, ['>='] = 2,
['..'] = 3,
['+'] = 4, ['-'] = 4,
['*'] = 5, ['/'] = 5, ['%'] = 5,
['not'] = 6, ['#'] = 6, ['-'] = 6,
['^'] = 7
}
-- comparisons (as prefix functions)
binreg (mod,{And='and',Or='or',Eq='==',Lt='<',Gt='>',Le='<=',Ge='>='})
-- standard binary operators (as metamethods)
binreg (_PEMT,{__add='+',__sub='-',__mul='*',__div='/',__mod='%',__pow='^',__concat='..'})
binreg (_PEMT,{__eq='=='})
--- all elements of a table except the first.
-- @param ls a list-like table.
function tail (ls)
assert_arg(1,ls,'table')
local res = {}
for i = 2,#ls do
append(res,ls[i])
end
return res
end
--- create a string representation of a placeholder expression.
-- @param e a placeholder expression
function repr (e,lastpred)
if isPE(e) then
local pred = operators[e.op]
local ls = map(repr,e,pred)
if pred then --unary or binary operator
if #ls ~= 1 then
local s = concat(ls,' '..e.op..' ')
if lastpred and lastpred > pred then
s = '('..s..')'
end
return s
else
return e.op..' '..ls[1]
end
else -- either postfix, or a placeholder
if e.op == '[]' then
return ls[1]..'['..ls[2]..']'
elseif e.op == '()' then
local fn
if ls[1] ~= _args then
fn = ls[1]
else
fn = ''
end
return fn..'('..concat(tail(ls),',')..')'
else
return e.repr
end
end
elseif type(e) == 'string' then
return '"'..e..'"'
elseif type(e) == 'function' then
local name = lookup_imported_name(e)
if name then return name else return tostring(e) end
else
return tostring(e) --should not really get here!
end
end
-- collect all the non-PE values in this PE into vlist, and replace each occurence
-- with a constant PH (_C1, etc). Return the maximum placeholder index found.
function collect_values (e,vlist)
if isPE(e) then
if e.op ~= 'X' then
local m = 0
for i,subx in ipairs(e) do
local pe = isPE(subx)
if pe then
if subx.op == 'X' and subx.index == 'wrap' then
subx = subx.repr
pe = false
else
m = max(m,collect_values(subx,vlist))
end
end
if not pe then
append(vlist,subx)
e[i] = CPH(#vlist)
end
end
return m
else -- was a placeholder, it has an index...
return e.index
end
else -- plain value has no placeholder dependence
return 0
end
end
--- instantiate a PE into an actual function. First we find the largest placeholder used,
-- e.g. _2; from this a list of the formal parameters can be build. Then we collect and replace
-- any non-PE values from the PE, and build up a constant binding list.
-- Finally, the expression can be compiled, and e.__PE_function is set.
-- @param e a placeholder expression
-- @return a function
function instantiate (e)
local consts,values,parms = {},{},{}
local rep
local n = collect_values(e,values)
for i = 1,#values do
append(consts,'_C'..i)
if _DEBUG then print(i,values[i]) end
end
for i =1,n do
append(parms,'_'..i)
end
consts = concat(consts,',')
parms = concat(parms,',')
rep = repr(e)
fstr = ('return function(%s) return function(%s) return %s end end'):format(consts,parms,rep)
if _DEBUG then print(fstr) end
fun,err = loadstring(fstr,'fun')
if not fun then return nil,err end
fun = fun() -- get wrapper
fun = fun(unpack(values)) -- call wrapper (values could be empty)
e.__PE_function = fun
return fun
end
--- instantiate a PE unless it has already been done.
-- @param e a placeholder expression
-- @return the function
function I(e)
if rawget(e,'__PE_function') then
return e.__PE_function
else return instantiate(e)
end
end
utils.add_function_factory(_PEMT,I)
--- bind the first parameter of the function to a value.
-- @class function
-- @name curry
-- @param fn a function of one or more arguments
-- @param p a value
-- @return a function of one less argument
-- @usage (curry(math.max,10))(20) == math.max(10,20)
curry = utils.bind1
--- create a function which chains two functions.
-- @param f a function of at least one argument
-- @param g a function of at least one argument
-- @return a function
-- @usage printf = compose(io.write,string.format)
function compose (f,g)
return function(...) return f(g(...)) end
end
--- bind the arguments of a function to given values.
-- bind(fn,v,_2) is equivalent to curry(fn,v).
-- @param fn a function of at least one argument
-- @param ... values or placeholder variables
-- @return a function
-- @usage (bind(f,_1,a))(b) == f(a,b)
-- @usage (bind(f,_2,_1))(a,b) == f(b,a)
function bind(fn,...)
local args,n = utils.args(...)
local holders,parms,bvalues,values = {},{},{'fn'},{}
local nv,maxplace,varargs = 1,0,false
for i = 1,n do
local a = args[i]
if isPE(a) and a.op == 'X' then
append(holders,a.repr)
maxplace = max(maxplace,a.index)
if a.index == 0 then varargs = true end
else
local v = '_v'..nv
append(bvalues,v)
append(holders,v)
append(values,a)
nv = nv + 1
end
end
for np = 1,maxplace do
append(parms,'_'..np)
end
if varargs then append(parms,'...') end
bvalues = concat(bvalues,',')
parms = concat(parms,',')
holders = concat(holders,',')
local fstr = ([[
return function (%s)
return function(%s) return fn(%s) end
end
]]):format(bvalues,parms,holders)
if _DEBUG then print(fstr) end
local res,err = loadstring(fstr)
res = res()
return res(fn,unpack(values))
end

45
moo/moolua/pl/init.lua Normal file
View File

@ -0,0 +1,45 @@
-- entry point for loading all PL libraries only on demand!
local modules = {
utils = true,path=true,dir=true,tablex=true,stringio=true,sip=true,
input=true,seq=true,lexer=true,stringx=true,
config=true,pretty=true,data=true,func=true,text=true,
operator=true,lapp=true,array2d=true,
comprehension=true,luabalanced=true,
test = true, app = true, file = true,
-- classes --
List = 'list', Map = 'class', Set = 'class', class = 'class',
OrderedMap = 'classx', MultiMap = 'classx', TypedList = 'classx',
}
utils = require 'pl.utils'
for name,klass in pairs(utils.stdmt) do
klass.__index = function(t,key)
return require ('pl.'..modules[name])[name][key]
end
end
local _hook
setmetatable(_G,{
hook = function(handler)
_hook = handler
end,
__index = function(t,name)
local found = modules[name]
local modname
if found then
if type(found) == 'string' then
return require('pl.'..found) [name]
else
rawset(_G,name,require('pl.'..name))
return _G[name]
end
elseif _hook then
return _hook(t,name)
end
end
})
-- remove the comment if you want Penlight to always run in strict mode
--require 'pl.strict'

157
moo/moolua/pl/input.lua Normal file
View File

@ -0,0 +1,157 @@
-------------------------------------------------
-- Iterators for extracting words or numbers from an input source.
local strfind = string.find
local strsub = string.sub
local strmatch = string.match
local pairs,type,unpack,tonumber = pairs,type,unpack,tonumber
local utils = require 'pl.utils'
local patterns = utils.patterns
local io = io
local assert_arg = utils.assert_arg
module ('pl.input',utils._module)
--- create an iterator over all tokens.
-- based on allwords from PiL, 7.1
-- @param getter any function that returns a line of text
-- @param pattern
-- @param fn Optionally can pass a function to process each token as it/s found.
-- @return an iterator
function alltokens (getter,pattern,fn)
local line = getter() -- current line
local pos = 1 -- current position in the line
return function () -- iterator function
while line do -- repeat while there are lines
local s, e = strfind(line, pattern, pos)
if s then -- found a word?
pos = e + 1 -- next position is after this token
local res = strsub(line, s, e) -- return the token
if fn then res = fn(res) end
return res
else
line = getter() -- token not found; try next line
pos = 1 -- restart from first position
end
end
return nil -- no more lines: end of traversal
end
end
-- question: shd this _split_ a string containing line feeds?
--- create a function which grabs the next value from a source. If the source is a string, then the getter
-- will return the string and thereafter return nil. If not specified then the source is assumed to be stdin.
-- @param f a string or a file-like object (i.e. has a read() method which returns the next line)
-- @return a getter function
function create_getter(f)
if f then
if type(f) == 'string' then
local ls = utils.split(f,'\n')
local i,n = 0,#ls
return function()
i = i + 1
if i > n then return nil end
return ls[i]
end
else
-- anything that supports the read() method!
if not f.read then utils.error('not a file-like object') end
return function() return f:read() end
end
else
return io.read -- i.e. just read from stdin
end
end
--- generate a sequence of numbers from a source.
-- @param f A source
-- @return An iterator
function numbers(f)
return alltokens(create_getter(f),
'('..patterns.FLOAT..')',tonumber)
end
--- generate a sequence of words from a source.
-- @param f A source
-- @return An iterator
function words(f)
return alltokens(create_getter(f),"%w+")
end
local function apply_tonumber (no_fail,...)
local args = {...}
for i = 1,#args do
local n = tonumber(args[i])
if n == nil then
if not no_fail then return nil,args[i] end
else
args[i] = n
end
end
return args
end
--- parse an input source into fields.
-- By default, will fail if it cannot convert a field to a number.
-- @param ids a list of field indices, or a maximum field index
-- @param delim delimiter to parse fields (default space)
-- @param f a source (@see create_getter)
-- @param opts option table, {no_fail=true}
-- @return an iterator with the field values
-- @usage for x,y in fields {2,3} do print(x,y) end -- 2nd and 3rd fields from stdin
function fields (ids,delim,f,opts)
local sep
local s
local getter = create_getter(f)
local no_fail = opts and opts.no_fail
local no_convert = opts and opts.no_convert
if not delim or delim == ' ' then
delim = '%s'
sep = '%s+'
s = '%s*'
else
sep = delim
s = ''
end
local max_id = 0
if type(ids) == 'table' then
for i,id in pairs(ids) do
if id > max_id then max_id = id end
end
else
max_id = ids
ids = {}
for i = 1,max_id do ids[#ids+1] = i end
end
local pat = '[^'..delim..']*'
local k = 1
for i = 1,max_id do
if ids[k] == i then
k = k + 1
s = s..'('..pat..')'
else
s = s..pat
end
if i < max_id then
s = s..sep
end
end
local linecount = 1
return function()
local line,results,err
repeat
line = getter()
linecount = linecount + 1
if not line then return nil end
if no_convert then
results = {strmatch(line,s)}
else
results,err = apply_tonumber(no_fail,strmatch(line,s))
if not results then
utils.quit("line "..(linecount-1)..": cannot convert '"..err.."' to number")
end
end
until #results > 0
return unpack(results)
end
end

322
moo/moolua/pl/lapp.lua Normal file
View File

@ -0,0 +1,322 @@
-- lapp.lua
-- Simple command-line parsing using human-readable specification.
-- @class module
-- @name pl.lapp
-----------------------------
--~ -- args.lua
--~ local args = require ('lapp') [[
--~ Testing parameter handling
--~ -p Plain flag (defaults to false)
--~ -q,--quiet Plain flag with GNU-style optional long name
--~ -o (string) Required string option
--~ -n (number) Required number option
--~ -s (default 1.0) Option that takes a number, but will default
--~ <start> (number) Required number argument
--~ <input> (default stdin) A parameter which is an input file
--~ <output> (default stdout) One that is an output file
--~ ]]
--~ for k,v in pairs(args) do
--~ print(k,v)
--~ end
-------------------------------
--~ > args -pq -o help -n 2 2.3
--~ input file (781C1B78)
--~ p true
--~ s 1
--~ output file (781C1B98)
--~ quiet true
--~ start 2.3
--~ o help
--~ n 2
--------------------------------
local match = require 'pl.sip'.match_at_start
local stringx = require 'pl.stringx'
local lines,lstrip,strip,at = stringx.lines,stringx.lstrip,stringx.strip,stringx.at
local isdigit = stringx.isdigit
local append = table.insert
local tinsert = table.insert
pl.lapp = {}
local lapp = pl.lapp
local open_files,parms,aliases,parmlist,usage,windows,script
local filetypes = {
stdin = {io.stdin,'file-in'}, stdout = {io.stdout,'file-out'},
stderr = {io.stderr,'file-out'}
}
local function quit(msg,no_usage)
if msg then
io.stderr:write(msg..'\n\n')
end
if not no_usage then
io.stderr:write(usage)
end
os.exit(1);
end
local function error(msg,no_usage)
quit(script..':'..msg,no_usage)
end
local function open (file,opt)
local val,err = io.open(file,opt)
if not val then error(err,true) end
append(open_files,val)
return val
end
local function xassert(condn,msg)
if not condn then
error(msg)
end
end
local function range_check(x,min,max,parm)
xassert(min <= x and max >= x,parm..' out of range')
end
local function xtonumber(s)
local val = tonumber(s)
if not val then error("unable to convert to number: "..s) end
return val
end
local function is_filetype(type)
return type == 'file-in' or type == 'file-out'
end
local types
local function convert_parameter(ps,val)
if ps.converter then
val = ps.converter(val)
end
if ps.type == 'number' then
val = xtonumber(val)
elseif is_filetype(ps.type) then
val = open(val,(ps.type == 'file-in' and 'r') or 'w' )
elseif ps.type == 'boolean' then
val = true
end
if ps.constraint then
ps.constraint(val)
end
return val
end
function lapp.add_type (name,converter,constraint)
types[name] = {converter=converter,constraint=constraint}
end
local function force_short(short)
xassert(#short==1,short..": short parameters should be one character")
end
local function process_default (sval)
local val = tonumber(sval)
if val then -- we have a number!
return val,'number'
elseif filetypes[sval] then
local ft = filetypes[sval]
return ft[1],ft[2]
else
return sval,'string'
end
end
function process_options_string(str)
local results = {}
local opts = {at_start=true}
local varargs
open_files = {}
parms = {}
aliases = {}
parmlist = {}
types = {}
local function check_varargs(s)
local res,cnt = s:gsub('%.%.%.%s*','')
varargs = cnt > 0
return res
end
local function set_result(ps,parm,val)
if not ps.varargs then
results[parm] = val
else
if not results[parm] then
results[parm] = { val }
else
append(results[parm],val)
end
end
end
usage = str
local res = {}
for line in lines(str) do
local optspec,optparm,i1,i2,defval,vtype,constraint
line = lstrip(line)
-- flags: either -<short> or -<short>,--<long>
if match('-$v{short},--$v{long} $',line,res) or match('-$v{short} $',line,res) then
if res.long then
optparm = res.long
aliases[res.short] = optparm
else
optparm = res.short
end
force_short(res.short)
res.rest = check_varargs(res.rest)
elseif match('$<{name} $',line,res) then -- is it <parameter_name>?
-- so <input file...> becomes input_file ...
optparm = check_varargs(res.name):gsub('%A','_')
append(parmlist,optparm)
end
if res.rest then -- this is not a pure doc line
line = res.rest
res = {}
-- do we have (default <val>) or (<type>)?
if match('$({def} $',line,res) or match('$({def}',line,res) then
typespec = strip(res.def)
if match('default $',typespec,res) then
defval,vtype = process_default(res[1])
elseif match('$f{min}..$f{max}',typespec,res) then
local min,max = res.min,res.max
vtype = 'number'
constraint = function(x)
range_check(x,min,max,optparm)
end
else -- () just contains type of required parameter
vtype = typespec
end
else -- must be a plain flag, no extra parameter required
defval = false
vtype = 'boolean'
end
local ps = {
type = vtype,
defval = defval,
required = defval == nil,
comment = res.rest or optparm,
constraint = constraint,
varargs = varargs
}
varargs = nil
if types[vtype] then
local converter = types[vtype].converter
if type(converter) == 'string' then
ps.type = converter
else
ps.converter = converter
end
ps.constraint = types[vtype].constraint
end
parms[optparm] = ps
end
end
-- cool, we have our parms, let's parse the command line args
local iparm = 1
local iextra = 1
local i = 1
local parm,ps,val
while i <= #arg do
local theArg = arg[i]
-- look for a flag, -<short flags> or --<long flag>
if match('--$v{long}',theArg,res) or match('-$v{short}',theArg,res) then
if res.long then -- long option
parm = res.long
elseif #res.short == 1 then
parm = res.short
else
local parmstr = res.short
parm = at(parmstr,1)
if isdigit(at(parmstr,2)) then
-- a short option followed by a digit is an exception (for AW;))
-- push ahead into the arg array
tinsert(arg,i+1,parmstr:sub(2))
else
-- push multiple flags into the arg array!
for k = 2,#parmstr do
tinsert(arg,i+k-1,'-'..at(parmstr,k))
end
end
end
if parm == 'h' or parm == 'help' then
quit()
end
if aliases[parm] then parm = aliases[parm] end
else -- a parameter
parm = parmlist[iparm]
if not parm then
-- extra unnamed parameters are indexed starting at 1
parm = iextra
iextra = iextra + 1
ps = { type = 'string' }
else
ps = parms[parm]
end
if not ps.varargs then
iparm = iparm + 1
end
val = theArg
end
ps = parms[parm]
if not ps then error("unrecognized parameter: "..parm) end
if ps.type ~= 'boolean' then -- we need a value! This should follow
if not val then
i = i + 1
val = arg[i]
end
xassert(val,parm.." was expecting a value")
end
ps.used = true
val = convert_parameter(ps,val)
set_result(ps,parm,val)
if is_filetype(ps.type) then
set_result(ps,parm..'_name',theArg)
end
if lapp.callback then
lapp.callback(parm,theArg,res)
end
i = i + 1
val = nil
end
-- check unused parms, set defaults and check if any required parameters were missed
for parm,ps in pairs(parms) do
if not ps.used then
if ps.required then error("missing required parameter: "..parm) end
set_result(ps,parm,ps.defval)
end
end
return results
end
if arg then
script = arg[0]:gsub('.+[\\/]',''):gsub('%.%a+$','')
else
script = "inter"
end
setmetatable(lapp, {
__call = function(tbl,str) return process_options_string(str) end,
__index = {
open = open,
quit = quit,
error = error,
assert = xassert,
}
})
return lapp

386
moo/moolua/pl/lexer.lua Normal file
View File

@ -0,0 +1,386 @@
-------------------------------------------
--- Lexical scanner for creating a sequence of tokens from text. <br>
-- See the Guide for further <a href="../../index.html#lexer">discussion</a>
local tonumber,type,ipairs,_G = tonumber,type,ipairs,_G
local yield,wrap = coroutine.yield,coroutine.wrap
local strfind = string.find
local strsub = string.sub
local append = table.insert
local utils = require 'pl.utils'
local assert_arg = utils.assert_arg
module ('pl.lexer',utils._module)
local lexer = _G.pl.lexer
local NUMBER1 = '^[%+%-]?%d+%.?%d*[eE][%+%-]?%d+'
local NUMBER2 = '^[%+%-]?%d+%.?%d*'
local NUMBER3 = '^0x[%da-fA-F]+'
local IDEN = '^[%a_][%w_]*'
local WSPACE = '^%s+'
local STRING1 = "^'.-[^\\]'"
local STRING2 = '^".-[^\\]"'
local STRING3 = '^[\'"][\'"]'
local plain_matches,lua_matches,cpp_matches,lua_keyword,cpp_keyword
local function tdump(tok)
return yield(tok,tok)
end
local function ndump(tok,options)
if options and options.number then
tok = tonumber(tok)
end
return yield("number",tok)
end
local function sdump(tok,options)
if options and options.string then
tok = tok:sub(2,-2)
end
return yield("string",tok)
end
local function chdump(tok,options)
if options and options.string then
tok = tok:sub(2,-2)
end
return yield("char",tok)
end
local function cdump(tok)
return yield("comment",tok)
end
local function wsdump (tok)
return yield("space",tok)
end
local function plain_vdump(tok)
return yield("iden",tok)
end
local function lua_vdump(tok)
if lua_keyword[tok] then
return yield("keyword",tok)
else
return yield("iden",tok)
end
end
local function cpp_vdump(tok)
if cpp_keyword[tok] then
return yield("keyword",tok)
else
return yield("iden",tok)
end
end
--- create a plain token iterator from a string.
-- @param s the string
-- @param matches an optional match table (set of pattern-action pairs)
-- @param filter a table of token types to exclude, by default {space=true}
-- @param options a table of options; by default, {number=true,string=true},
-- which means convert numbers and strip string quotes.
function scan (s,matches,filter,options)
assert_arg(1,s,'string')
filter = filter or {space=true}
options = options or {number=true,string=true}
if filter then
if filter.space then filter[wsdump] = true end
if filter.comments then filter[cdump] = true end
end
if not matches then
if not plain_matches then
plain_matches = {
{WSPACE,wsdump},
{NUMBER3,ndump},
{IDEN,plain_vdump},
{NUMBER1,ndump},
{NUMBER2,ndump},
{STRING3,sdump},
{STRING1,sdump},
{STRING2,sdump},
{'^.',tdump}
}
end
matches = plain_matches
end
function lex ()
local i1,i2,idx,res1,res2,tok,pat,fun
local sz = #s
--print('sz',sz)
while true do
for _,m in ipairs(matches) do
pat = m[1]
fun = m[2]
i1,i2 = strfind(s,pat,idx)
if i1 then
tok = strsub(s,i1,i2)
idx = i2 + 1
if not (filter and filter[fun]) then
--print(s,pat,idx,tok)
lexer.finished = idx > sz
res1,res2 = fun(tok,options)
--print(res1,res2)
end
if res1 then
-- insert a token list
if type(res1)=='table' then
yield('','')
for _,t in ipairs(res1) do
--print('insert',t[1],t[2])
yield(t[1],t[2])
end
else -- or search up to some special pattern
i1,i2 = strfind(s,res1,idx)
if i1 then
tok = strsub(s,i1,i2)
idx = i2 + 1
yield('',tok)
else
yield('','')
idx = sz + 1
end
if idx > sz then return end
end
end
if idx > sz then return -- print 'ret';
else break end
end
end
end
end
return wrap(lex)
end
local function isstring (s)
return type(s) == 'string'
end
--- insert tokens into a stream.
-- @param tok a token stream
-- @param a1 a string is the type, a table is a token list and
-- a function is assumed to be a token-like iterator (returns type & value)
-- @param a2 a string is the value
function insert (tok,a1,a2)
if not a1 then return end
local ts
if isstring(a1) and isstring(a2) then
ts = {{a1,a2}}
elseif type(a1) == 'function' then
ts = {}
for t,v in a1() do
append(ts,{t,v})
end
else
ts = a1
end
tok(ts)
end
--- get everything in a stream upto a newline.
-- @param tok a token stream
-- @return a string
function getline (tok)
local t,v = tok('.-\n')
return v
end
--- get the rest of the stream.
-- @param tok a token stream
-- @return a string
function getrest (tok)
local t,v = tok('.+')
return v
end
--- get the Lua keywords as a set-like table.
-- So <code>res["and"]</code> etc would be <code>true</code>.
-- @return a table
function get_keywords ()
if not lua_keyword then
lua_keyword = {
["and"] = true, ["break"] = true, ["do"] = true,
["else"] = true, ["elseif"] = true, ["end"] = true,
["false"] = true, ["for"] = true, ["function"] = true,
["if"] = true, ["in"] = true, ["local"] = true, ["nil"] = true,
["not"] = true, ["or"] = true, ["repeat"] = true,
["return"] = true, ["then"] = true, ["true"] = true,
["until"] = true, ["while"] = true
}
end
return lua_keyword
end
--- create a Lua token iterator from a string. Will return the token type and value.
-- @param s the string
-- @param filter a table of token types to exclude, by default {space=true,comments=true}
-- @param options a table of options; by default, {number=true,string=true},
-- which means convert numbers and strip string quotes.
function lua(s,filter,options)
assert_arg(1,s,'string')
filter = filter or {space=true,comments=true}
get_keywords()
if not lua_matches then
lua_matches = {
{WSPACE,wsdump},
{NUMBER3,ndump},
{IDEN,lua_vdump},
{NUMBER1,ndump},
{NUMBER2,ndump},
{STRING3,sdump},
{STRING1,sdump},
{STRING2,sdump},
{'^%-%-.-\n',cdump},
{'^%[%[.+%]%]',sdump},
{'^%-%-%[%[.+%]%]',cdump},
{'^==',tdump},
{'^~=',tdump},
{'^<=',tdump},
{'^>=',tdump},
{'^%.%.%.',tdump},
{'^.',tdump}
}
end
return scan(s,lua_matches,filter,options)
end
--- create a C/C++ token iterator from a string. Will return the token type type and value.
-- @param s the string
-- @param filter a table of token types to exclude, by default {space=true,comments=true}
-- @param options a table of options; by default, {number=true,string=true},
-- which means convert numbers and strip string quotes.
function cpp(s,filter,options)
assert_arg(1,s,'string')
filter = filter or {comments=true}
if not cpp_keyword then
cpp_keyword = {
["class"] = true, ["break"] = true, ["do"] = true, ["sizeof"] = true,
["else"] = true, ["continue"] = true, ["struct"] = true,
["false"] = true, ["for"] = true, ["public"] = true, ["void"] = true,
["private"] = true, ["protected"] = true, ["goto"] = true,
["if"] = true, ["static"] = true, ["const"] = true, ["typedef"] = true,
["enum"] = true, ["char"] = true, ["int"] = true, ["bool"] = true,
["long"] = true, ["float"] = true, ["true"] = true, ["delete"] = true,
["double"] = true, ["while"] = true, ["new"] = true, ["delete"] = true,
["namespace"] = true, ["try"] = true, ["catch"] = true,
["switch"] = true, ["case"] = true, ["extern"] = true,
}
end
if not cpp_matches then
cpp_matches = {
{WSPACE,wsdump},
{NUMBER3,ndump},
{IDEN,cpp_vdump},
{NUMBER1,ndump},
{NUMBER2,ndump},
{STRING3,sdump},
{STRING1,chdump},
{STRING2,sdump},
{'^//.-\n',cdump},
{'^/%*.-%*/]',cdump},
{'^==',tdump},
{'^!=',tdump},
{'^<=',tdump},
{'^>=',tdump},
{'^->',tdump},
{'^&&',tdump},
{'^||',tdump},
{'^%+%+',tdump},
{'^%-%-',tdump},
{'^%+=',tdump},
{'^%-=',tdump},
{'^%*=',tdump},
{'^/=',tdump},
{'^|=',tdump},
{'^%^=',tdump},
{'^::',tdump},
{'^.',tdump}
}
end
return scan(s,cpp_matches,filter,options)
end
--- get a list of parameters separated by a delimiter from a stream.
-- @param tok the token stream
-- @param endtoken end of list (default ')'). Can be '\n'
-- @param delim separator (default ',')
-- @return a list of token lists.
function get_separated_list(tok,endtoken,delim)
endtoken = endtoken or ')'
delim = delim or ','
local parm_values = {}
local level = 1 -- used to count ( and )
local tl = {}
local function tappend (tl,tok,val)
val = val or tok
append(tl,{tok,val})
end
local is_end
if endtoken == '\n' then
is_end = function(tok,val)
return tok == 'space' and val:find '\n'
end
else
is_end = function (tok)
return tok == endtoken
end
end
while true do
token,value=tok()
if not token then return end -- end of stream is an error!
if token == '(' then
level = level + 1
tappend(tl,'(')
elseif token == ')' then
level = level - 1
if level == 0 then -- finished with parm list
append(parm_values,tl)
break
else
tappend(tl,')')
end
elseif token == delim and level == 1 then
append(parm_values,tl) -- a new parm
tl = {}
elseif is_end(token,value) and level == 1 then
append(parm_values,tl)
break
else
tappend(tl,token,value)
end
end
return parm_values
end
--- get the next non-space token from the stream.
-- @param tok the token stream.
function skipws (tok)
local t,v = tok()
while t == 'space' do
t,v = tok()
end
return t,v
end
--- get the next token, which must be of the expected type.
-- Throws an error if this type does not match!
-- @param tok the token stream
-- @param expected_type the token type
-- @param no_skip_ws whether we should skip whitespace
function expecting (tok,expected_type,no_skip_ws)
assert_arg(2,expected_type,'string')
local t,v
if no_skip_ws then
t,v = tok()
else
t,v = skipws(tok)
end
if t ~= expected_type then utils.error ("expecting "..expected_type) end
return v
end

497
moo/moolua/pl/list.lua Normal file
View File

@ -0,0 +1,497 @@
--- Python-style list class.
-- Based on original code by Nick Trout. <br>
-- Please note: methods that change the list will return the list. <br>
-- This is to allow for method chaining, but please note that ls = ls:sort() <br>
-- does not mean that a new copy of the list is made. In-place (mutable) methods <br>
-- are marked as returning 'the list' in this documentation.
-- See the Guide for further <a href="../../index.html#list">discussion</a>
-- @class module
-- @name pl.list
-- See http://www.python.org/doc/current/tut/tut.html, section 5.1
-- Note:The comments before some of the functions are from the Python docs
-- and contain Python code.
-- Written for Lua version 4.0
-- Redone for Lua 5.1, Steve Donovan.
local tinsert,tremove,concat,tsort = table.insert,table.remove,table.concat,table.sort
local setmetatable, getmetatable,type,tostring,assert,string,next = setmetatable,getmetatable,type,tostring,assert,string,next
local write = io.write
local tablex = require 'pl.tablex'
local filter,imap,imap2,reduce,transform,tremovevalues = tablex.filter,tablex.imap,tablex.imap2,tablex.reduce,tablex.transform,tablex.removevalues
local tablex = tablex
local tsub = tablex.sub
local utils = require 'pl.utils'
local function_arg = utils.function_arg
local is_type = utils.is_type
local split = utils.split
local assert_arg = utils.assert_arg
local normalize_slice = tablex._normalize_slice
module ('pl.list',utils._module)
local Multimap = utils.stdmt.MultiMap
-- metatable for our list objects
List = utils.stdmt.List
List.__index = List
List._name = "List"
List._class = List
-- we give the metatable its own metatable so that we can call it like a function!
setmetatable(List,{
__call = function (tbl,arg)
return List:new(arg)
end,
})
local _List = List
local function makelist (t)
return setmetatable(t,_List)
end
local function is_list(t)
return getmetatable(t) == _List
end
local function simple_table(t)
return type(t) == 'table' and not is_list(t) and #t > 0
end
--- Create a new list. Can optionally pass a table;
-- passing another instance of List will cause a copy to be created
-- we pass anything which isn't a simple table to iter() to work out
-- an appropriate iterator @see iter
-- @param t An optional list-like table
-- @return a new List
-- @usage ls = List(); ls = List {1,2,3,4}
function List:new(t)
if not t then t={}
elseif not simple_table(t) then
local tbl = t
t = {}
for v in iter(tbl) do
tinsert(t,v)
end
end
makelist(t,List)
return t
end
---Add an item to the end of the list.
-- @param i An item
-- @return the list
function List:append(i)
tinsert(self,i)
return self
end
List.push = tinsert
--- Extend the list by appending all the items in the given list.
-- equivalent to 'a[len(a):] = L'.
-- @param L Another List
-- @return the list
function List:extend(L)
assert_arg(1,L,'table')
for i = 1,#L do tinsert(self,L[i]) end
return self
end
--- Insert an item at a given position. i is the index of the
-- element before which to insert.
-- @param i index of element before whichh to insert
-- @param x A data item
-- @return the list
function List:insert(i, x)
assert_arg(1,i,'number')
tinsert(self,i,x)
return self
end
--- Insert an item at the begining of the list.
-- @param x a data item
-- @return the list
function List:put (x)
return self:insert(1,x)
end
--- Remove an element given its index.
-- (equivalent of Python's del s[i])
-- @param i the index
-- @return the list
function List:remove (i)
assert_arg(1,i,'number')
tremove(self,i)
return self
end
--- Remove the first item from the list whose value is given.
-- (This is called 'remove' in Python; renamed to avoid confusion
-- with table.remove)
-- Return nil if there is no such item.
-- @param x A data value
-- @return the list
function List:remove_value(x)
for i=1,#self do
if self[i]==x then tremove(self,i) return self end
end
return self
end
--- Remove the item at the given position in the list, and return it.
-- If no index is specified, a:pop() returns the last item in the list.
-- The item is also removed from the list.
-- @param i An index
-- @return the item
function List:pop(i)
if not i then i = #self end
assert_arg(1,i,'number')
return tremove(self,i)
end
List.get = List.pop
--- Return the index in the list of the first item whose value is given.
-- Return nil if there is no such item.
-- @class function
-- @name List:index
-- @param x A data value
-- @param idx where to start search (default 1)
-- @return the index, or nil if not found.
local tfind = tablex.find
List.index = tfind
--- does this list contain the value?.
-- @param x A data value
-- @return true or false
function List:contains(x)
return tfind(self,x) and true or false
end
--- Return the number of times value appears in the list.
-- @param x A data value
-- @return number of times x appears
function List:count(x)
local cnt=0
for i=1,#self do
if self[i]==x then cnt=cnt+1 end
end
return cnt
end
--- Sort the items of the list, in place.
-- @param cmp an optional comparison function; '<' is used if not given.
-- @return the list
function List:sort(cmp)
tsort(self,cmp)
return self
end
--- Reverse the elements of the list, in place.
-- @return the list
function List:reverse()
local t = self
local n = #t
local n2 = n/2
for i = 1,n2 do
local k = n-i+1
t[i],t[k] = t[k],t[i]
end
return self
end
--- Emulate list slicing. like 'list[first:last]' in Python.
-- If first or last are negative then they are relative to the end of the list
-- eg. slice(-2) gives last 2 entries in a list, and
-- slice(-4,-2) gives from -4th to -2nd
-- @param first An index
-- @param last An index
-- @return a new List
function List:slice(first,last)
return tsub(self,first,last)
end
--- empty the list.
-- @return the list
function List:clear()
for i=1,#self do tremove(self,i) end
return self
end
--- Emulate Python's range(x) function.
-- Include it in List table for tidiness
-- @param start A number
-- @param finish A number greater than start; if zero, then 0..start-1
-- @usage List.range(0,3) == List {0,1,2,3}
function List.range(start,finish)
if not finish then
start = 0
finish = finish - 1
end
assert_arg(1,start,'number')
assert_arg(2,finish,'number')
local t = List:new()
for i=start,finish do tinsert(t,i) end
return t
end
--- list:len() is the same as #list.
function List:len()
return #self
end
-- Extended operations --
--- Remove a subrange of elements.
-- equivalent to 'del s[i1:i2]' in Python.
-- @param i1 start of range
-- @param i2 end of range
-- @return the list
function List:chop(i1,i2)
return tremovevalues(self,i1,i2)
end
--- Insert a sublist into a list
-- equivalent to 's[idx:idx] = list' in Python
-- @param idx index
-- @param list list to insert
-- @return the list
-- @usage l = List{10,20}; l:splice(2,{21,22}); assert(l == List{10,21,22,20})
function List:splice(idx,list)
assert_arg(1,idx,'number')
idx = idx - 1
local i = 1
for v in iter(list) do
tinsert(self,i+idx,v)
i = i + 1
end
return self
end
--- general slice assignment s[i1:i2] = seq.
-- @param i1 start index
-- @param i2 end index
-- @param seq a list
-- @return the list
function List:slice_assign(i1,i2,seq)
assert_arg(1,i1,'number')
assert_arg(1,i2,'number')
i1,i2 = normalize_slice(self,i1,i2)
if i2 >= i1 then self:chop(i1,i2) end
self:splice(i1,seq)
return self
end
--- concatenation operator .. .
-- @param L another List
-- @return a new list consisting of the list with the elements of the new list appended
function List:__concat(L)
assert_arg(1,L,'table')
local ls = List(self)
ls:extend(L)
return ls
end
--- equality operator ==. True iff all elements of two lists are equal.
-- @param L another List
-- @return true or false
function List:__eq(L)
if #self ~= #L then return false end
for i = 1,#self do
if self[i] ~= L[i] then return false end
end
return true
end
--- join the elements of a list using a delimiter.<br>
-- This method uses tostring on all elements.
-- @param delim a delimiter string, can be empty.
-- @return a string
function List:join (delim)
assert_arg(1,delim,'string')
return concat(imap(tostring,self),delim)
end
--- join a list of strings. <br>
-- Uses table.concat directly.
-- @class function
-- @name List:concat
-- @param delim a delimiter
-- @return a string
List.concat = concat
--- how our list should be rendered as a string. Uses join().
-- @see pl.list.List:join
function List:__tostring()
return '{'..self:join(',')..'}'
end
--[[
-- NOTE: this works, but is unreliable. If you leave the loop before finishing,
-- then the iterator is not reset.
--- can iterate over a list directly.
-- @usage for v in ls do print(v) end
function List:__call()
if not self.key then self.key = 1 end
local value = self[self.key]
self.key = self.key + 1
if not value then self.key = nil end
return value
end
--]]
--[[
function List.__call(t,v,i)
i = (i or 0) + 1
v = t[i]
if v then return i, v end
end
--]]
--- call the function for each element of the list.
-- @param fun a function or callable object
function List:foreach (fun,...)
local t = self
fun = function_arg(fun)
for i = 1,#t do
fun(t[i],...)
end
end
--- create a list of all elements which match a function.
-- @param fun a boolean function
-- @param optional argument to be passed as second argument of the predicate
-- @return a new filtered list.
function List:filter (fun,arg)
return makelist(filter(self,fun,arg))
end
--- split a string using a delimiter.
-- @param s the string
-- @param delim the delimiter (default spaces)
-- @return a List of strings
-- @see pl.utils.split
function List.split (s,delim)
assert_arg(1,s,'string')
return makelist(split(s,delim))
end
--- apply a function to all elements.
-- Any extra arguments will be passed to the function
-- @param fun a function of at least one argument
-- @param arg1 an optional argument
-- @param ... arbitrary extra arguments.
-- @return a new list: {f(x) for x in self}
-- @see pl.tablex.imap
function List:map (fun,...)
return imap(fun,self,...)
end
--- apply a function to all elements, in-place.
-- Any extra arguments are passed to the function.
-- @param fun A function that takes at least one argument
-- @param ... arbitrary extra arguments.
function List:transform (fun,t,...)
transform(fun,self,...)
end
--- apply a function to elements of two lists.
-- Any extra arguments will be passed to the function
-- @param fun a function of at least two arguments
-- @param ... arbitrary extra arguments.
-- @return a new list: {f(x,y) for x in self, for x in arg1}
-- @see pl.tablex.imap2
function List:map2 (fun,ls,...)
return makelist(imap2(fun,self,ls,...))
end
--- apply a named meethod to all elements.
-- Any extra arguments will be passed to the method.
-- @param name name of method
-- @param ... extra arguments
-- @return a new list of the results
-- @see pl.seq.mapmethod
function List:mapm (name,...)
local res = {}
local t = self
for i = 1,#t do
local val = t[i]
local fn = val[name]
if not fn then error(type(val).." does not have method "..name) end
res[i] = fn(val,...)
end
return makelist(res)
end
--- 'reduce' a list using a binary function.
-- @param fun a function of two arguments
-- @return result of the function
-- @see pl.tablex.reduce
function List:reduce (fun)
return reduce(fun,self)
end
--- partition a list using a classifier function.
-- The function may return nil, but this will be converted to the string key '<nil>'.
-- @param fun a function of at least one argument
-- @param ... will also be passed to the function
-- @return a table where the keys are the returned values, and the values are Lists
-- of values where the function returned that key. It is given the type of Multimap.
-- @see pl.classx.MultiMap
function List:partition (fun,...)
fun = function_arg(fun)
local res = {}
for i = 1,#self do
local val = self[i]
local klass = fun(val,...)
if klass == nil then klass = '<nil>' end
if not res[klass] then res[klass] = List() end
res[klass]:append(val)
end
return setmetatable(res,Multimap)
end
--- return an iterator over all values.
function List:iter ()
return iter(self)
end
--- Create an iterator over a seqence.
-- This captures the Python concept of 'sequence'.
-- For tables, iterates over all values with integer indices.
-- @param seq a sequence; a string (over characters), a table, a file object (over lines) or an iterator function
-- @usage for x in iter {1,10,22,55} do io.write(x,',') end ==> 1,10,22,55
-- @usage for ch in iter 'help' do do io.write(ch,' ') end ==> h e l p
function iter(seq)
if type(seq) == 'string' then
local idx = 0
local n = #seq
local sub = string.sub
return function ()
idx = idx + 1
if idx > n then return nil
else
return sub(seq,idx,idx)
end
end
elseif type(seq) == 'table' then
local idx = 0
local n = #seq
return function()
idx = idx + 1
if idx > n then return nil
else
return seq[idx]
end
end
elseif type(seq) == 'function' then
return seq
elseif type(seq) == 'userdata' and io.type(seq) == 'file' then
return seq:lines()
end
end

255
moo/moolua/pl/luabalanced.lua Normal file
View File

@ -0,0 +1,255 @@
-- luabalanced.lua
-- Extracted delimited Lua sequences from strings.[1]
-- Inspired by Damian Conway's Text::Balanced[2] in Perl.
--
-- [1] http://lua-users.org/wiki/LuaBalanced
-- [2] http://search.cpan.org/dist/Text-Balanced/lib/Text/Balanced.pm
--
-- (c) 2008, David Manura, Licensed under the same terms as Lua (MIT license).
--
local M = {}
local assert = assert
local table_concat = table.concat
-- map opening brace <-> closing brace.
local ends = { ['('] = ')', ['{'] = '}', ['['] = ']' }
local begins = {}; for k,v in pairs(ends) do begins[v] = k end
-- Match Lua string in string <s> starting at position <pos>.
-- Returns <string>, <posnew>, where <string> is the matched
-- string (or nil on no match) and <posnew> is the character
-- following the match (or <pos> on no match).
-- Supports all Lua string syntax: "...", '...', [[...]], [=[...]=], etc.
local function match_string(s, pos)
pos = pos or 1
local posa = pos
local c = s:sub(pos,pos)
if c == '"' or c == "'" then
pos = pos + 1
while 1 do
pos = assert(s:find("[" .. c .. "\\]", pos), 'syntax error')
if s:sub(pos,pos) == c then
local part = s:sub(posa, pos)
return part, pos + 1
else
pos = pos + 2
end
end
else
local sc = s:match("^%[(=*)%[", pos)
if sc then
local _; _, pos = s:find("%]" .. sc .. "%]", pos)
assert(pos)
local part = s:sub(posa, pos)
return part, pos + 1
else
return nil, pos
end
end
end
M.match_string = match_string
-- Match bracketed Lua expression, e.g. "(...)", "{...}", "[...]", "[[...]]",
-- [=[...]=], etc.
-- Function interface is similar to match_string.
local function match_bracketed(s, pos)
pos = pos or 1
local posa = pos
local ca = s:sub(pos,pos)
if not ends[ca] then
return nil, pos
end
local stack = {}
while 1 do
pos = s:find('[%(%{%[%)%}%]\"\']', pos)
assert(pos, 'syntax error: unbalanced')
local c = s:sub(pos,pos)
if c == '"' or c == "'" then
local part; part, pos = match_string(s, pos)
assert(part)
elseif ends[c] then -- open
local mid, posb
if c == '[' then mid, posb = s:match('^%[(=*)%[()', pos) end
if mid then
pos = s:match('%]' .. mid .. '%]()', posb)
assert(pos, 'syntax error: long string not terminated')
if #stack == 0 then
local part = s:sub(posa, pos-1)
return part, pos
end
else
stack[#stack+1] = c
pos = pos + 1
end
else -- close
assert(stack[#stack] == assert(begins[c]), 'syntax error: unbalanced')
stack[#stack] = nil
if #stack == 0 then
local part = s:sub(posa, pos)
return part, pos+1
end
pos = pos + 1
end
end
end
M.match_bracketed = match_bracketed
-- Match Lua comment, e.g. "--...\n", "--[[...]]", "--[=[...]=]", etc.
-- Function interface is similar to match_string.
local function match_comment(s, pos)
pos = pos or 1
if s:sub(pos, pos+1) ~= '--' then
return nil, pos
end
pos = pos + 2
local partt, post = match_string(s, pos)
if partt then
return '--' .. partt, post
end
local part; part, pos = s:match('^([^\n]*\n?)()', pos)
return '--' .. part, pos
end
-- Match Lua expression, e.g. "a + b * c[e]".
-- Function interface is similar to match_string.
local wordop = {['and']=true, ['or']=true, ['not']=true}
local is_compare = {['>']=true, ['<']=true, ['~']=true}
local function match_expression(s, pos)
pos = pos or 1
local posa = pos
local lastident
local poscs, posce
while pos do
local c = s:sub(pos,pos)
if c == '"' or c == "'" or c == '[' and s:find('^[=%[]', pos+1) then
local part; part, pos = match_string(s, pos)
assert(part, 'syntax error')
elseif c == '-' and s:sub(pos+1,pos+1) == '-' then
-- note: handle adjacent comments in loop to properly support
-- backtracing (poscs/posce).
poscs = pos
while s:sub(pos,pos+1) == '--' do
local part; part, pos = match_comment(s, pos)
assert(part)
pos = s:match('^%s*()', pos)
posce = pos
end
elseif c == '(' or c == '{' or c == '[' then
local part; part, pos = match_bracketed(s, pos)
elseif c == '=' and s:sub(pos+1,pos+1) == '=' then
pos = pos + 2 -- skip over two-char op containing '='
elseif c == '=' and is_compare[s:sub(pos-1,pos-1)] then
pos = pos + 1 -- skip over two-char op containing '='
elseif c:match'^[%)%}%];,=]' then
local part = s:sub(posa, pos-1)
return part, pos
elseif c:match'^[%w_]' then
local newident,newpos = s:match('^([%w_]+)()', pos)
if pos ~= posa and not wordop[newident] then -- non-first ident
local pose = ((posce == pos) and poscs or pos) - 1
while s:match('^%s', pose) do pose = pose - 1 end
local ce = s:sub(pose,pose)
if ce:match'[%)%}\'\"%]]' or
ce:match'[%w_]' and not wordop[lastident]
then
local part = s:sub(posa, pos-1)
return part, pos
end
end
lastident, pos = newident, newpos
else
pos = pos + 1
end
pos = s:find('[%(%{%[%)%}%]\"\';,=%w_%-]', pos)
end
local part = s:sub(posa, #s)
return part, #s+1
end
M.match_expression = match_expression
-- Match name list (zero or more names). E.g. "a,b,c"
-- Function interface is similar to match_string,
-- but returns array as match.
local function match_namelist(s, pos)
pos = pos or 1
local list = {}
while 1 do
local c = #list == 0 and '^' or '^%s*,%s*'
local item, post = s:match(c .. '([%a_][%w_]*)%s*()', pos)
if item then pos = post else break end
list[#list+1] = item
end
return list, pos
end
M.match_namelist = match_namelist
-- Match expression list (zero or more expressions). E.g. "a+b,b*c".
-- Function interface is similar to match_string,
-- but returns array as match.
local function match_explist(s, pos)
pos = pos or 1
local list = {}
while 1 do
if #list ~= 0 then
local post = s:match('^%s*,%s*()', pos)
if post then pos = post else break end
end
local item; item, pos = match_expression(s, pos)
assert(item, 'syntax error')
list[#list+1] = item
end
return list, pos
end
M.match_explist = match_explist
-- Replace snippets of code in Lua code string <s>
-- using replacement function f(u,sin) --> sout.
-- <u> is the type of snippet ('c' = comment, 's' = string,
-- 'e' = any other code).
-- Snippet is replaced with <sout> (unless <sout> is nil or false, in
-- which case the original snippet is kept)
-- This is somewhat analogous to string.gsub .
local function gsub(s, f)
local pos = 1
local posa = 1
local sret = ''
while 1 do
pos = s:find('[%-\'\"%[]', pos)
if not pos then break end
if s:match('^%-%-', pos) then
local exp = s:sub(posa, pos-1)
if #exp > 0 then sret = sret .. (f('e', exp) or exp) end
local comment; comment, pos = match_comment(s, pos)
sret = sret .. (f('c', assert(comment)) or comment)
posa = pos
else
local posb = s:find('^[\'\"%[]', pos)
local str
if posb then str, pos = match_string(s, posb) end
if str then
local exp = s:sub(posa, posb-1)
if #exp > 0 then sret = sret .. (f('e', exp) or exp) end
sret = sret .. (f('s', str) or str)
posa = pos
else
pos = pos + 1
end
end
end
local exp = s:sub(posa)
if #exp > 0 then sret = sret .. (f('e', exp) or exp) end
return sret
end
M.gsub = gsub
return M

190
moo/moolua/pl/operator.lua Normal file
View File

@ -0,0 +1,190 @@
-------------------------------------------------------------------
--- Lua operators available as functions.
-- (similar to the Python module of the same name)<br>
-- There is a module field <code>optable</code> which maps the operator strings
-- onto these functions, e.g. <pre class=example>operator.optable['()']==operator.call</pre>
local strfind = string.find
local utils = require 'pl.utils'
module ('pl.operator',utils._module)
--- apply function to some arguments ()
-- @param fn a function or callable object
function call(fn,...)
return fn(...)
end
--- get the indexed value from a table []
-- @param t a table or any indexable object
-- @param k the key
function index(t,k)
return t[k]
end
--- returns true if arguments are equal ==
-- @param a value
-- @param b value
function eq(a,b)
return a==b
end
--- returns true if arguments are not equal ~=
-- @param a value
-- @param b value
function neq(a,b)
return a~=b
end
--- returns true if a is less than b <
-- @param a value
-- @param b value
function lt(a,b)
return a < b
end
--- returns true if a is less or equal to b <=
-- @param a value
-- @param b value
function le(a,b)
return a <= b
end
--- returns true if a is greater than b >
-- @param a value
-- @param b value
function gt(a,b)
return a > b
end
--- returns true if a is greater or equal to b >=
-- @param a value
-- @param b value
function ge(a,b)
return a >= b
end
--- returns length of string or table #
-- @param a a string or a table
function len(a)
return #a
end
--- add two values +
-- @param a value
-- @param b value
function add(a,b)
return a+b
end
--- subtract b from a -
-- @param a value
-- @param b value
function sub(a,b)
return a-b
end
--- multiply two values *
-- @param a value
-- @param b value
function mul(a,b)
return a*b
end
--- divide first value by second /
-- @param a value
-- @param b value
function div(a,b)
return a/b
end
--- raise first to the power of second ^
-- @param a value
-- @param b value
function pow(a,b)
return a^b
end
--- modulo; remainder of a divided by b %
-- @param a value
-- @param b value
function mod(a,b)
return a%b
end
--- concatenate two values (either strings or __concat defined) ..
-- @param a value
-- @param a value
function concat(a,b)
return a..b
end
--- return the negative of a value -
-- @param a value
-- @param a value
function unm(a)
return -a
end
--- false if value evaluates as true (i.e. not nil or false) not
-- @param a value
function lnot(a)
return not a
end
--- true if both values evaluate as true (i.e. not nil or false) and
-- @param a value
-- @param a value
function land(a,b)
return a and b
end
--- true if either value evaluate as true (i.e. not nil or false) or
-- @param a value
-- @param a value
function lor(a,b)
return a or b
end
--- make a table from the arguments. {}
-- @param ... non-nil arguments
-- @return a table
function table (...)
return {...}
end
function match (a,b)
return strfind(a,b)~=nil
end
--- the null operation.
-- @param ... arguments
-- @return the arguments
function nop (...)
return ...
end
optable = {
['+']=add,
['-']=sub,
['*']=mul,
['/']=div,
['%']=mod,
['^']=pow,
['..']=concat,
['()']=call,
['[]']=index,
['<']=lt,
['<=']=le,
['>']=gt,
['>=']=ge,
['==']=eq,
['~=']=neq,
['#']=len,
['and']=land,
['or']=lor,
['{}']=table,
['~']=match,
['']=nop,
}

289
moo/moolua/pl/path.lua Normal file
View File

@ -0,0 +1,289 @@
--- path manipulation and file queries. <br>
-- This is modelled after Python's os.path library (11.1)
-- @class module
-- @name pl.path
-- imports and locals
local _G = _G
local sub = string.sub
local getenv = os.getenv
local tmpnam = os.tmpname
local attributes
local currentdir
local package = package
local io = io
local append = table.insert
local ipairs = ipairs
local utils = require 'pl.utils'
local assert_arg,assert_string,raise = utils.assert_arg,utils.assert_string,utils.raise
local attributes,currentdir
module ('pl.path',utils._module)
local res,lfs = _G.pcall(_G.require,'lfs')
if res then
attributes = lfs.attributes
currentdir = lfs.currentdir
end
local function at(s,i)
return sub(s,i,i)
end
local function attrib(path,field)
assert_string(1,path)
assert_string(2,field)
if not attributes then return nil end
local attr,err = attributes(path)
if not attr then return raise(err)
else
return attr[field]
end
end
is_windows = utils.dir_separator == '\\'
local other_sep
-- !constant sep is the directory separator for this platform.
if is_windows then
sep = '\\'; other_sep = '/'
dirsep = ';'
else
sep = '/'
dirsep = ':'
end
--- given a path, return the directory part and a file part.
-- if there's no directory part, the first value will be empty
-- @param path A file path
function splitpath(path)
assert_string(1,path)
local i = #path
local ch = at(path,i)
while i > 0 and ch ~= sep and ch ~= other_sep do
i = i - 1
ch = at(path,i)
end
if i == 0 then
return '',path
else
return sub(path,1,i-1), sub(path,i+1)
end
end
--- return an absolute path.
-- @param path A file path
function abspath(path)
assert_string(1,path)
if not currentdir then return path end
if not isabs(path) then
return join(currentdir(),path)
else
return path
end
end
--- given a path, return the root part and the extension part.
-- if there's no extension part, the second value will be empty
-- @param path A file path
function splitext(path)
assert_string(1,path)
local i = #path
local ch = at(path,i)
while i > 0 and ch ~= '.' do
if ch == sep or ch == other_sep then
return path,''
end
i = i - 1
ch = at(path,i)
end
if i == 0 then
return path,''
else
return sub(path,1,i-1),sub(path,i)
end
end
--- return the directory part of a path
-- @param path A file path
function dirname(path)
assert_string(1,path)
local p1,p2 = splitpath(path)
return p1
end
--- return the file part of a path
-- @param path A file path
function basename(path)
assert_string(1,path)
local p1,p2 = splitpath(path)
return p2
end
--- get the extension part of a path.
-- @param path A file path
function extension(path)
assert_string(1,path)
p1,p2 = splitext(path)
return p2
end
--- is this an absolute path?.
-- @param path A file path
function isabs(path)
assert_string(1,path)
if is_windows then
return at(path,1) == '/' or at(path,1)=='\\' or at(path,2)==':'
else
return at(path,1) == '/'
end
end
--- return the path resulting from combining the two paths.
-- if the second is already an absolute path, then it returns it.
-- @param p1 A file path
-- @param p2 A file path
function join(p1,p2)
assert_string(1,p1)
assert_string(2,p2)
if isabs(p2) then return p2 end
local endc = at(p1,#p1)
if endc ~= sep and endc ~= other_sep then
p1 = p1..sep
end
return p1..p2
end
--- Normalize the case of a pathname. On Unix, this returns the path unchanged;
-- for Windows, it converts the path to lowercase, and it also converts forward slashes
-- to backward slashes. Will also replace '\dir\..\' by '\' (PL extension!)
-- @param path A file path
function normcase(path)
assert_string(1,path)
if is_windows then
return (path:lower():gsub('/','\\'):gsub('\\[^\\]+\\%.%.',''))
else
return path
end
end
--- is this a directory?
-- @param path A file path
function isdir(path)
return attrib(path,'mode') == 'directory'
end
--- is this a file?.
-- @param path A file path
function isfile(path)
return attrib(path,'mode') == 'file'
end
--- return size of a file.
-- @param path A file path
function getsize(path)
return attrib(path,'size')
end
--- does a path exist?.
-- @param path A file path
function exists(path)
if attributes then
return attributes(path) ~= nil
else
local f = io.open(path,'r')
if f then
f:close()
return true
else
return false
end
end
end
--- Replace a starting '~' with the user's home directory.
-- In windows, if HOME isn't set, then USERPROFILE is used in preference to
-- HOMEDRIVE HOMEPATH. This is guaranteed to be writeable on all versions of Windows.
-- @param path A file path
function expanduser(path)
assert_string(1,path)
if at(path,1) == '~' then
local home = getenv('HOME')
if not home then -- has to be Windows
home = getenv 'USERPROFILE' or (getenv 'HOMEDRIVE' .. getenv 'HOMEPATH')
end
return home..sub(path,2)
else
return path
end
end
--- Return the time of last access as the number of seconds since the epoch.
-- @param path A file path
function getatime(path)
return attrib(path,'access')
end
--- Return the time of last modification
-- @param path A file path
function getmtime(path)
return attrib(path,'modification')
end
---Return the system's ctime.
-- @param path A file path
function getctime(path)
return attrib(path,'change')
end
---Return a suitable full path to a new temporary file name.
-- unlike os.tmpnam(), it always gives you a writeable path (uses %TMP% on Windows)
function tmpname ()
local res = tmpnam()
if is_windows then res = getenv('TMP')..res end
return res
end
--- return the largest common prefix path of two paths.
-- @param path1 a file path
-- @param path2 a file path
function common_prefix (path1,path2)
assert_string(1,path1)
assert_string(2,path2)
-- get them in order!
if #path1 > #path2 then path2,path1 = path1,path2 end
for i = 1,#path1 do
local c1 = at(path1,i)
if c1 ~= at(path2,i) then
local cp = path1:sub(1,i-1)
if at(path1,i-1) ~= sep then
cp = dirname(cp)
end
return cp
end
end
if at(path2,#path1+1) ~= sep then path1 = dirname(path1) end
return path1
--return ''
end
--- return the full path where a particular Lua module would be found.
-- Both package.path and package.cpath is searched, so the result may
-- either be a Lua file or a shared libarary.
-- @param mod name of the module
-- @return on success: path of module, lua or binary
-- @return on error: nil,error string
function package_path(mod)
assert_string(1,mod)
local res
mod = mod:gsub('%.',sep)
res = package.searchpath(mod,package.path)
if res then return res,true end
res = package.searchpath(mod,package.cpath)
if res then return res,false end
return raise 'cannot find module on path'
end
---- finis -----

59
moo/moolua/pl/permute.lua Normal file
View File

@ -0,0 +1,59 @@
----------------------------------------------
-- Permutation operations
local tablex = require 'pl.tablex'
local utils = require 'pl.utils'
local copy = tablex.deepcopy
local append = table.insert
local coroutine = coroutine
local resume = coroutine.resume
local assert_arg = utils.assert_arg
module ('pl.permute',utils._module)
-- PiL, 9.3
local permgen
permgen = function (a, n, fn)
if n == 0 then
fn(a)
else
for i=1,n do
-- put i-th element as the last one
a[n], a[i] = a[i], a[n]
-- generate all permutations of the other elements
permgen(a, n - 1, fn)
-- restore i-th element
a[n], a[i] = a[i], a[n]
end
end
end
--- an iterator over all permutations of the elements of a list.
-- Please note that the same list is returned each time, so do not keep references!
-- @param a list-like table
-- @return an iterator which provides the next permutation as a list
function iter (a)
assert_arg(1,a,'table')
local n = #a
local co = coroutine.create(function () permgen(a, n, coroutine.yield) end)
return function () -- iterator
local code, res = resume(co)
return res
end
end
--- construct a table containing all the permutations of a list.
-- @param a list-like table
-- @return a table of tables
-- @usage permute.table {1,2,3} --> {{2,3,1},{3,2,1},{3,1,2},{1,3,2},{2,1,3},{1,2,3}}
function table (a)
assert_arg(1,a,'table')
local res = {}
local n = #a
permgen(a,n,function(t) append(res,copy(t)) end)
return res
end

162
moo/moolua/pl/pretty.lua Normal file
View File

@ -0,0 +1,162 @@
----------------------------------------------------------
--- Pretty-printing Lua tables
local append = table.insert
local concat = table.concat
local type,tostring,pairs,ipairs,loadstring,setfenv,require,print,select = type,tostring,pairs,ipairs,loadstring,setfenv,require,print,select
local utils = require 'pl.utils'
local lexer = require 'pl.lexer'
local assert_arg = utils.assert_arg
module('pl.pretty',utils._module)
--- read a string representation of a Lua table.
-- Uses loadstring, but tries to be cautious about loading arbitrary code!
-- It is expecting a string of the form '{...}', with perhaps some whitespace
-- before or after the curly braces. An empty environment is used, and
-- any occurance of the keyword 'function' will be considered a problem.
function read(s)
assert_arg(1,s,'string')
if not s:find '^%s*%b{}%s*$' then return nil,"not a Lua table" end
if s:find '[^\'"%w_]function[^\'"%w_]' then
local tok = lexer.lua(s)
for t,v in tok do
if t == 'keyword' then
return nil,"cannot have Lua keywords in table definition"
end
end
end
local chunk,err = loadstring('return '..s,'tbl')
if not chunk then return nil,err end
setfenv(chunk,{})
return chunk()
end
local function quote_if_necessary (v)
if not v then return ''
else
if v:find ' ' then v = '"'..v..'"' end
end
return v
end
local keywords
--- create a string representation of a Lua table.
-- @param a table
-- @param space the indent to use (defaults to two spaces)
-- @param not_clever (defaults to false) use for plain output, e.g {['key']=1}
-- @return a string
function write (tbl,space,not_clever)
assert_arg(1,tbl,'table')
if not keywords then
keywords = lexer.get_keywords()
end
space = space or ' '
local lines = {}
local line = ''
local tables = {}
local function is_identifier (s)
return (s:find('^[%a_][%w_]*$')) and not keywords[s]
end
local function put(s)
if #s > 0 then
line = line..s
end
end
local function putln (s)
if #line > 0 then
line = line..s
append(lines,line)
line = ''
else
append(lines,s)
end
end
local function eat_last_comma ()
local n,lastch = #lines
local lastch = lines[n]:sub(-1,-1)
if lastch == ',' then
lines[n] = lines[n]:sub(1,-2)
end
end
local function quote (s)
return ('%q'):format(tostring(s))
end
local function index (numkey,key)
if not numkey then key = quote(key) end
return '['..key..']'
end
local writeit
writeit = function (t,oldindent,indent)
local tp = type(t)
if tp ~= 'string' and tp ~= 'table' then
putln(quote_if_necessary(tostring(t))..',')
elseif tp == 'string' then
if t:find('\n') then
putln('[[\n'..t..']],')
else
putln(quote(t)..', ')
end
elseif tp == 'table' then
if tables[t] then
putln('<cycle>,')
return
end
tables[t] = true
local newindent = indent..space
putln('{')
local max = 0
if not not_clever then
for i,val in ipairs(t) do
put(indent)
writeit(val,indent,newindent)
max = i
end
end
for key,val in pairs(t) do
local numkey = type(key) == 'number'
if not_clever then
key = tostring(key)
put(indent..index(numkey,key)..' = ')
writeit(val,indent,newindent)
else
if not numkey or key < 1 or key > max then -- non-array indices
if numkey or not is_identifier(key) then
key = index(numkey,key)
end
put(indent..key..' = ')
writeit(val,indent,newindent)
end
end
end
eat_last_comma()
putln(oldindent..'},')
else
putln(tostring(t)..',')
end
end
writeit(tbl,'',space)
eat_last_comma()
return concat(lines,#space > 0 and '\n' or '')
end
--- dump a Lua table out to a file or stdout
-- @param t a table
-- @param file (optional) file name
function dump (t,...)
if select('#',...) == 0 then
print(write(t))
return true
else
return utils.raise(utils.writefile((select(1,...)),t))
end
end

512
moo/moolua/pl/seq.lua Normal file
View File

@ -0,0 +1,512 @@
------------------------------------------
--- Manipulating sequences as iterators.
local next,assert,type,pairs,tonumber,type,setmetatable,getmetatable,_G = next,assert,type,pairs,tonumber,type,setmetatable,getmetatable,_G
local strfind = string.find
local strmatch = string.match
local format = string.format
local mrandom = math.random
local remove,tsort,tappend = table.remove,table.sort,table.insert
local io = io
local utils = require 'pl.utils'
local function_arg = utils.function_arg
local _List = utils.stdmt.List
local _Map = utils.stdmt.Map
local assert_arg = utils.assert_arg
module("pl.seq",utils._module)
local seq = _G.pl.seq
-- given a number, return a function(y) which returns true if y > x
-- @param x a number
function greater_than(x)
return function(v)
return tonumber(v) > x
end
end
-- given a number, returns a function(y) which returns true if y < x
-- @param x a number
function less_than(x)
return function(v)
return tonumber(v) < x
end
end
-- given any value, return a function(y) which returns true if y == x
-- @param x
function equal_to(x)
if type(x) == "number" then
return function(v)
return tonumber(v) == x
end
else
return function(v)
return v == x
end
end
end
--- given a string, return a function(y) which matches y against the string.
-- @param a string
function matching(s)
return function(v)
return strfind(v,s)
end
end
--- sequence adaptor for a table. Note that if any generic function is
-- passed a table, it will automatically use seq.list()
-- @param t a list-like table
-- @usage sum(list(t)) is the sum of all elements of t
-- @usage for x in list(t) do...end
function list(t)
assert_arg(1,t,'table')
local key,value
return function()
key,value = next(t,key)
return value
end
end
--- return the keys of the table.
-- @param t a list-like table
-- @return iterator over keys
function keys(t)
assert_arg(1,t,'table')
local key,value
return function()
key,value = next(t,key)
return key
end
end
local function default_iter(iter)
if type(iter) == 'table' then return list(iter)
else return iter end
end
iter = default_iter
--- create an iterator over a numerical range. Like the standard Python function xrange.
-- @param start a number
-- @param finish a number greater than start
function range(start,finish)
local i = start - 1
return function()
i = i + 1
if i > finish then return nil
else return i end
end
end
-- count the number of elements in the sequence which satisfy the predicate
-- @param iter a sequence
-- @param condn a predicate function (must return either true or false)
-- @param optional argument to be passed to predicate as second argument.
function count(iter,condn,arg)
local i = 0
foreach(iter,function(val)
if condn(v,arg) then i = i + 1 end
end)
return i
end
--- return the minimum and the maximum value of the sequence.
-- @param iter a sequence
function minmax(iter)
local vmin,vmax = 1e70,-1e70
for v in default_iter(iter) do
v = tonumber(v)
if v < vmin then vmin = v end
if v > vmax then vmax = v end
end
return vmin,vmax
end
--- return the sum and element count of the sequence.
-- @param iter a sequence
-- @param fn an optional function to apply to the values
function sum(iter,fn)
local s = 0
local i = 0
for v in default_iter(iter) do
if fn then v = fn(v) end
s = s + v
i = i + 1
end
return s,i
end
--- create a table from the sequence. (This will make the result a List.)
-- @param iter a sequence
-- @return a List
-- @usage copy(list(ls)) is equal to ls
-- @usage copy(list {1,2,3},List) == List{1,2,3}
function copy(iter)
local res = {}
for v in default_iter(iter) do
tappend(res,v)
end
setmetatable(res,_List)
return res
end
--- create a table of pairs from the double-valued sequence.
-- @param iter a double-valued sequence
-- @return a list-like table
function copy2 (iter,i1,i2)
local res = {}
for v1,v2 in iter,i1,i2 do
tappend(res,{v1,v2})
end
return res
end
--- create a table of 'tuples' from a multi-valued sequence.
-- A generalization of copy2 above
-- @param iter a multiple-valued sequence
-- @return a list-like table
function copy_tuples (iter)
iter = default_iter(iter)
local res = {}
local row = {iter()}
while #row > 0 do
tappend(res,row)
row = {iter()}
end
return res
end
--- return an iterator of random numbers.
-- @param n the length of the sequence
-- @param l same as the first optional argument to math.random
-- @param u same as the second optional argument to math.random
-- @return a sequnce
function random(n,l,u)
local rand
assert(type(n) == 'number')
if u then
rand = function() return mrandom(l,u) end
elseif l then
rand = function() return mrandom(l) end
else
rand = mrandom
end
return function()
if n == 0 then return nil
else
n = n - 1
return rand()
end
end
end
--- return an iterator to the sorted elements of a sequence.
-- @param iter a sequence
-- @param comp an optional comparison function (comp(x,y) is true if x < y)
function sort(iter,comp)
local t = copy(iter)
tsort(t,comp)
return list(t)
end
--- return an iterator which returns elements of two sequences.
-- @param iter1 a sequence
-- @param iter2 a sequence
-- @usage for x,y in seq.zip(ls1,ls2) do....end
function zip(iter1,iter2)
iter1 = default_iter(iter1)
iter2 = default_iter(iter2)
return function()
return iter1(),iter2()
end
end
--- A table where the key/values are the values and value counts of the sequence.
-- This version works with 'hashable' values like strings and numbers. <br>
-- pl.tablex.count_map is more general.
-- @return a map-like table
-- @return a table
-- @see pl.tablex.count_map
function count_map(iter)
local t = {}
local v
for s in default_iter(iter) do
v = t[s]
if v then t[s] = v + 1
else t[s] = 1 end
end
return setmetatable(t,_Map)
end
-- given a sequence, return all the unique values in that sequence.
-- @param iter a sequence
-- @param returns_table true if we return a table, not a sequence
-- @return a sequence or a table; defaults to a sequence.
function unique(iter,returns_table)
local t = count_map(iter)
local res = {}
for k in pairs(t) do tappend(res,k) end
if returns_table then
return res
else
return list(res)
end
end
-- print out a sequence @iter, with a separator @sep (default space)
-- and maximum number of values per line @nfields (default 7)
-- @fmt is an optional format function to create a representation of each value.
function printall(iter,sep,nfields,fmt)
local write = io.write
if not sep then sep = ' ' end
if not nfields then
if sep == '\n' then nfields = 1e30
else nfields = 7 end
end
if fmt then
local fstr = fmt
fmt = function(v) return format(fstr,v) end
end
local k = 1
for v in default_iter(iter) do
if fmt then v = fmt(v) end
if k < nfields then
write(v,sep)
k = k + 1
else
write(v,'\n')
k = 1
end
end
write '\n'
end
-- return an iterator running over every element of two sequences (concatenation).
-- @param iter1 a sequence
-- @param iter2 a sequence
function splice(iter1,iter2)
iter1 = default_iter(iter1)
iter2 = default_iter(iter2)
local iter = iter1
return function()
local ret = iter()
if ret == nil then
if iter == iter1 then
iter = iter2
return iter()
else return nil end
else
return ret
end
end
end
--- return a sequence where every element of a sequence has been transformed
-- by a function. If you don't supply an argument, then the function will
-- receive both values of a double-valued sequence, otherwise behaves rather like
-- tablex.map.
-- @param iter a sequence of one or two values
-- @param fn a function to apply to elements; may take two arguments
-- @param arg optional argument to pass to function.
function map(fn,iter,arg)
fn = function_arg(fn)
iter = default_iter(iter)
return function()
local v1,v2 = iter()
if v1 == nil then return nil end
if arg then return fn(v1,arg)
else return fn(v1,v2)
end
end
end
--- filter a sequence using a predicate function
-- @param iter a sequence of one or two values
-- @param pred a boolean function; may take two arguments
-- @param arg optional argument to pass to function.
function filter (iter,pred,arg)
pred = function_arg(pred)
return function ()
local v1,v2
while true do
v1,v2 = iter()
if v1 == nil then return nil end
if arg then
if pred(v1,arg) then return v1,v2 end
else
if pred(v1,v2) then return v1,v2 end
end
end
end
end
--- 'reduce' a sequence using a binary function.
-- @param seq a sequence
-- @param fun a function of two arguments
-- @usage seq.reduce(operator.add,seq.list{1,2,3,4}) == 10
function reduce (fun,seq,oldval)
if not oldval then
seq = default_iter(seq)
oldval = seq()
fun = function_arg(fun)
end
local val = seq()
if val==nil then return oldval
else return fun(oldval,reduce(fun,seq,val))
end
end
--- take the first n values from the sequence.
-- @param iter a sequence of one or two values
-- @param n number of items to take
-- @return a sequence of at most n items
function take (iter,n)
local i = 1
iter = default_iter(iter)
return function()
if i > n then return end
local val1,val2 = iter()
if not val1 then return end
i = i + 1
return val1,val2
end
end
--- skip the first n values of a sequence
-- @param iter a sequence of one or more values
-- @param n number of items to skip
function skip (iter,n)
n = n or 1
for i = 1,n do iter() end
return iter
end
--- a sequence with a sequence count and the original value. <br>
-- enum(copy(ls)) is a roundabout way of saying ipairs(ls).
-- @param iter a single or double valued sequence
-- @return sequence of (i,v), i = 1..n and v is from iter.
function enum (iter)
local i = 0
iter = default_iter(iter)
return function ()
local val1,val2 = iter()
if not val1 then return end
i = i + 1
return i,val1,val2
end
end
--- map using a named method over a sequence.
-- @param iter a sequence
-- @param name the method name
-- @param arg1 optional first extra argument
-- @param arg1 optional second extra argument
function mapmethod (iter,name,arg1,arg2)
iter = default_iter(iter)
return function()
local val = iter()
if not val then return end
local fn = val[name]
if not fn then error(type(val).." does not have method "..name) end
return fn(val,arg1,arg2)
end
end
--- a sequence of (last,current) values from another sequence.
-- This will return S(i-1),S(i) if given S(i)
-- @param iter a sequence
function last (iter)
iter = default_iter(iter)
local l = iter()
if l == nil then return nil end
return function ()
local val,ll
val = iter()
if val == nil then return nil end
ll = l
l = val
return val,ll
end
end
--- call the function on each element of the sequence.
-- @param iter a sequence with up to 3 values
-- @param fn a function
function foreach(iter,fn)
fn = function_arg(fn)
for i1,i2,i3 in default_iter(iter) do fn(i1,i2,i3) end
end
---------------------- Sequence Adapters ---------------------
local SMT
local callable = utils.is_callable
local function SW (iter,...)
if callable(iter) then
return setmetatable({iter=iter},SMT)
else
return iter,...
end
end
-- can't directly look these up in seq because of the wrong argument order...
local overrides = {
map = function(self,fun,arg)
return map(fun,self,arg)
end,
reduce = function(self,fun)
return reduce(fun,self)
end
}
SMT = {
__index = function (tbl,key)
local s = overrides[key] or seq[key]
if s then
return function(sw,...) return SW(s(sw.iter,...)) end
else
return function(sw,...) return SW(mapmethod(sw.iter,key,...)) end
end
end,
__call = function (sw)
return sw.iter()
end,
}
setmetatable(seq,{
__call = function(tbl,iter)
if not callable(iter) then
if type(iter) == 'table' then iter = list(iter)
else return iter
end
end
return setmetatable({iter=iter},SMT)
end
})
--- create a wrapped iterator over all lines in the file.
-- @param f either a filename or nil (for standard input)
-- @return a sequence wrapper
function lines (f)
local iter = f and io.lines(f) or io.lines()
return SW(iter)
end
function import ()
_G.debug.setmetatable(function() end,{
__index = function(tbl,key)
local s = overrides[key] or seq[key]
if s then return s
else
return function(s,...) return mapmethod(s,key,...) end
end
end
})
end

295
moo/moolua/pl/sip.lua Normal file
View File

@ -0,0 +1,295 @@
---------------------------------
--- Simple Input Patterns (SIP). SIP patterns start with '$', then a
-- one-letter type, and then an optional variable in curly braces. <br>
-- Example:
-- <pre class=example>sip.match('($q{first},$q{second})','("john","smith")',res)</pre>
-- <pre class=example>result is true and 'res' is: {second='smith',first='john'} </pre>
-- See <a href="../../index.html#sip">the Guide</a>
local utils = require 'pl.utils'
local patterns = utils.patterns
local append,concat = table.insert,table.concat
local concat = table.concat
local ipairs,loadstring,type,unpack = ipairs,loadstring,type,unpack
local io,_G = io,_G
local print,rawget = print,rawget
local assert_arg = utils.assert_arg
module ('pl.sip',utils._module)
local brackets = {['<'] = '>', ['('] = ')', ['{'] = '}', ['['] = ']' }
local stdclasses = {a=1,c=0,d=1,l=1,p=0,u=1,w=1,x=1,s=0}
local _patterns = {}
local function group(s)
return '('..s..')'
end
-- escape all magic characters except $, which has special meaning
-- Also, un-escape any characters after $, so $( passes through as is.
local function escape (spec)
--_G.print('spec',spec)
local res = spec:gsub('[%-%.%+%[%]%(%)%^%%%?%*]','%%%1'):gsub('%$%%(%S)','$%1')
--_G.print('res',res)
return res
end
local function compress_space (s)
return s:gsub('%s+','%%s*')
end
-- [handling of spaces in patterns]
-- spaces may be 'compressed' (i.e will match zero or more spaces)
-- before or after a alphanum pattern,
-- if the character before the space is not alphanum
-- otherwise, always just before or after a pattern
local function compress_spaces (s)
s = s:gsub('%W%s+%$[vifadxlu]',compress_space)
s = s:gsub('%$[vifadxlu]%s+[^%$%w]',compress_space)
s = s:gsub('%$[^vifadxlu]%s+',compress_space)
s = s:gsub('%s+%$[^vifadxlu]',compress_space)
return s
end
--- convert a SIP pattern into the equivalent Lua regular expression.
-- @param spec a SIP pattern
-- @param fieldnames an optional table which is to be filled with fieldnames
-- @param fieldtypes an optional table which maps the names to their types
function create_pattern (spec,options)
assert_arg(1,spec,'string')
local fieldnames,fieldtypes = {},{}
if type(spec) == 'string' then
spec = escape(spec)
else
local res = {}
for i,s in ipairs(spec) do
res[i] = escape(s)
end
spec = concat(res,'.-')
end
local kount = 1
local function addfield (name,type)
if not name then name = kount end
if fieldnames then append(fieldnames,name) end
if fieldtypes then fieldtypes[name] = type end
kount = kount + 1
end
local named_vars, pattern
named_vars = spec:find('{%a+}')
pattern = '%$%S'
if options and options.at_start then
spec = '^'..spec
end
if spec:sub(-1,-1) == '$' then
spec = spec:sub(1,-2)..'$r'
if named_vars then spec = spec..'{rest}' end
end
local names
if named_vars then
names = {}
spec = spec:gsub('{(%a+)}',function(name)
append(names,name)
return ''
end)
end
spec = compress_spaces(spec)
local k = 1
local err
local r = (spec:gsub(pattern,function(s)
local type,name
type = s:sub(2,2)
if names then name = names[k]; k=k+1 end
-- this kludge is necessary because %q generates two matches, and
-- we want to ignore the first. Not a problem for named captures.
if not names and type == 'q' then
addfield(nil,type)
else
addfield(name,type)
end
local res
if type == 'v' then
res = group(patterns.IDEN)
elseif type == 'i' then
res = group(patterns.INTEGER)
elseif type == 'f' then
res = group(patterns.FLOAT)
elseif type == 'r' then
res = '(%S.*)'
elseif type == 'q' then
-- some Lua pattern matching voodoo; we want to match '...' as
-- well as "...", and can use the fact that %n will match a
-- previous capture. Adding an extra field comes from needing
-- to accomodate the extra spurious match (which is either ' or ")
addfield(name,type)
res = '(["\'])(.-)%'..(kount-2)
elseif type == 'p' then
res = '([%a]?[:]?[\\/%.%w_]+)'
else
local endbracket = brackets[type]
if endbracket then
res = '(%b'..type..endbracket..')'
elseif stdclasses[type] or stdclasses[type:lower()] then
res = '(%'..type..'+)'
else
err = "unknown format type or character class"
end
end
return res
end))
--print(r,err)
if err then
return nil,err
else
return r,fieldnames,fieldtypes
end
end
local function tnumber (s)
return s == 'd' or s == 'i' or s == 'f'
end
function create_spec_fun(spec,options)
local fieldtypes,fieldnames
local ls = {}
spec,fieldnames,fieldtypes = create_pattern(spec,options)
if not spec then return spec,fieldnames end
local named_vars = type(fieldnames[1]) == 'string'
for i = 1,#fieldnames do
append(ls,'mm'..i)
end
local fun = ('return (function(s,res)\n\t\local %s = s:match(%q)\n'):format(concat(ls,','),spec)
fun = fun..'\tif not mm1 then return false end\n'
local k = 1
for i,f in ipairs(fieldnames) do
if f ~= '_' then
local var = 'mm'..i
if tnumber(fieldtypes[f]) then
var = 'tonumber('..var..')'
elseif brackets[fieldtypes[f]] then
var = var..':sub(2,-2)'
end
if named_vars then
fun = ('%s\tres.%s = %s\n'):format(fun,f,var)
else
fun = ('%s\tres[%d] = %s\n'):format(fun,k,var)
end
k = k + 1
end
end
return fun..'\treturn true\nend)\n', named_vars
end
--- convert a SIP pattern into a matching function.
-- The returned function takes two arguments, the line and an empty table.
-- If the line matched the pattern, then this function return true
-- and the table is filled with field-value pairs.
-- @param spec a SIP pattern
-- @param options optional table; {anywhere=true} will stop pattern anchoring at start
-- @return a function if successful, or nil,<error>
function compile(spec,options)
assert_arg(1,spec,'string')
local fun,names = create_spec_fun(spec,options)
if not fun then return nil,names end
if rawget(_G,'_DEBUG') then print(fun) end
chunk,err = loadstring(fun,'tmp')
if err then return nil,err end
return chunk(),names
end
local cache = {}
--- match a SIP pattern against a string.
-- @param spec a SIP pattern
-- @param line a string
-- @param res a table to receive values
-- @param options (optional) option table
-- @return true or false
function match (spec,line,res,options)
assert_arg(1,spec,'string')
assert_arg(2,line,'string')
assert_arg(3,res,'table')
if not cache[spec] then
cache[spec] = compile(spec,options)
end
return cache[spec](line,res)
end
--- match a SIP pattern against the start of a string.
-- @param spec a SIP pattern
-- @param line a string
-- @param res a table to receive values
-- @return true or false
function match_at_start (spec,line,res)
return match(spec,line,res,{at_start=true})
end
--- given a pattern and a file object, return an iterator over the results
-- @param spec a SIP pattern
-- @param f a file - use standard input if not specified.
function fields (spec,f)
assert_arg(1,spec,'string')
f = f or io.stdin
local fun,err = compile(spec)
if not fun then return nil,err end
local res = {}
return function()
while true do
local line = f:read()
if not line then return end
if fun(line,res) then
local values = res
res = {}
return unpack(values)
end
end
end
end
--- register a match which will be used in the read function.
-- @param spec a SIP pattern
-- @param fun a function to be called with the results of the match
-- @see read
function pattern (spec,fun)
assert_arg(1,spec,'string')
local pat,named = compile(spec)
append(_patterns,{pat=pat,named=named,callback=fun or false})
end
--- enter a loop which applies all registered matches to the input file.
-- @param f a file object; if nil, then io.stdin is assumed.
function read (f)
local owned,err
f = f or io.stdin
if type(f) == 'string' then
f,err = io.open(f)
if not f then utils.quit(1,err) end
owned = true
end
local res = {}
for line in f:lines() do
for _,item in ipairs(_patterns) do
if item.pat(line,res) then
if item.callback then
if item.named then
item.callback(res)
else
item.callback(unpack(res))
end
end
res = {}
break
end
end
end
if owned then f:close() end
end

51
moo/moolua/pl/strict.lua Normal file
View File

@ -0,0 +1,51 @@
--- checks uses of undeclared global variables.
-- All global variables must be 'declared' through a regular assignment
-- (even assigning nil will do) in a main chunk before being used
-- anywhere or assigned to inside a function.
-- @class module
-- @name pl.strict
local getinfo, error, rawset, rawget = debug.getinfo, error, rawset, rawget
local handler,hooked
local mt = getmetatable(_G)
if mt == nil then
mt = {}
setmetatable(_G, mt)
elseif mt.hook then
hooked = true
end
-- predeclaring _PROMPT keeps the Lua Interpreter happy
mt.__declared = {_PROMPT=true}
local function what ()
local d = getinfo(3, "S")
return d and d.what or "C"
end
mt.__newindex = function (t, n, v)
if not mt.__declared[n] then
local w = what()
if w ~= "main" and w ~= "C" then
error("assign to undeclared variable '"..n.."'", 2)
end
mt.__declared[n] = true
end
rawset(t, n, v)
end
handler = function(t,n)
if not mt.__declared[n] and what() ~= "C" then
error("variable '"..n.."' is not declared", 2)
end
return rawget(t, n)
end
if not hooked then
mt.__index = handler
else
mt.hook(handler)
end

52
moo/moolua/pl/stringio.lua Normal file
View File

@ -0,0 +1,52 @@
------------------------------------------
--- reading and writing strings using Lua IO
local tmpname = require('pl.path').tmpname
local getmetatable,fopen,remove = getmetatable,io.open,os.remove
local utils = require 'pl.utils'
local assert_arg = utils.assert_arg
module ('pl.stringio',utils._module)
local files = {}
local function value(fi)
fi:close()
local file = files[fi]
files[fi] = nil
fi = fopen(file,'r')
local s = fi:read('*a')
fi:close()
remove(file)
return s
end
--- create a file object which can be used to construct a string.
-- The resulting file object will have an extra value() method for
-- retrieving the string value.
-- @usage f = create(); f:write('hello, dolly\n'); print(f:value())
function create()
local file = tmpname()
local f = fopen(file,'w')
files[f] = file
getmetatable(f).value = value
return f
end
--- create a file object for reading from a given string.
-- @param s The input string.
function open(s)
assert_arg(1,s,'string')
local file = tmpname()
local f = fopen(file,'w')
f:write(s)
f:close()
files[f] = file
return fopen(file,'r')
end
function cleanup ()
for _,file in pairs(files) do
remove(file)
end
end

335
moo/moolua/pl/stringx.lua Normal file
View File

@ -0,0 +1,335 @@
----------------------------------------------
--- Python-style string library.
-- see 3.6.1 of the Python reference. <br> <br>
-- If you want to make these available as string methods, then say
-- <code>stringx.import()</code> to bring them into the standard <code>string</code>
-- table.
-- @class module
-- @name pl.stringx
local string = string
local find = string.find
local type,setmetatable,getmetatable,ipairs,unpack = type,setmetatable,getmetatable,ipairs,unpack
local error,tostring = error,tostring
local gsub = string.gsub
local rep = string.rep
local sub = string.sub
local concat = table.concat
local utils = require 'pl.utils'
local escape = utils.escape
local _G = _G
local assert_arg,usplit,list_MT = utils.assert_arg,utils.split,utils.stdmt.List
local function assert_string (n,s)
assert_arg(n,s,'string')
end
module ('pl.stringx',utils._module)
--- does s only contain alphabetic characters?.
function isalpha(s)
assert_string(1,s)
return find(s,'^%a+$') == 1
end
--- does s only contain digits?.
function isdigit(s)
assert_string(1,s)
return find(s,'^%d+$') == 1
end
--- does s only contain alphanumeric characters?.
function isalnum(s)
assert_string(1,s)
return find(s,'^%d+$') == 1
end
--- does s only contain spaces?.
function isspace(s)
assert_string(1,s)
return find(s,'^%s+$') == 1
end
--- does s only contain lower case characters?.
function islower(s)
assert_string(1,s)
return find(s,'^%l+$') == 1
end
--- does s only contain upper case characters?.
function isupper(s)
assert_string(1,s)
return find(s,'^%u+$') == 1
end
--- concatenate the strings using this string as a delimiter.
-- @param seq a table of strings or numbers
-- @usage (' '):join {1,2,3} == '1 2 3'
function join (self,seq)
assert_string(1,self)
return concat(seq,self)
end
--- does string start with the substring?.
-- @param s2 a string
function startswith(self,s2)
assert_string(1,self)
assert_string(2,s2)
return find(self,s2,1,true) == 1
end
local function _find_all(s,sub,first,last)
local i1,i2 = find(s,sub,first,true)
local res
local k = 0
while i1 do
res = i1
k = k + 1
i1,i2 = find(s,sub,i2+1,true)
if last and i1 > last then break end
end
return res,k
end
--- does string end with the given substring?.
-- @param s a substring or a table of suffixes
function endswith(self,s,first,last)
assert_string(1,self)
first = first or 1
if type(s) == 'string' then
local i1 = _find_all(self,s,first,last)
return i1 == #self - #s + 1
elseif type(s) == 'table' then
for _,suffix in ipairs(s) do
if endswith(self,suffix,first,last) then return true end
end
return false
else
utils.error('argument #2: either a substring or a table of suffixes expected')
end
end
-- break string into a list of lines
function splitlines (self,keepends)
assert_string(1,self)
return setmetatable(usplit(self,'\n'),list_MT)
end
--- replace all tabs in s with n spaces. If not specified, n defaults to 8.
-- @param n number of spaces to expand each tab
function expandtabs(self,n)
assert_string(1,self)
n = n or 8
local tab = rep(' ',n)
return (gsub(s,'\t',tab))
end
--- find index of first instance of sub in s from the left.
-- @param sub substring
-- @param i1 start index
function lfind(self,sub,i1)
assert_string(1,self)
assert_string(2,sub)
local idx = find(self,sub,i1,true)
if idx then return idx else return -1 end
end
--- find index of first instance of sub in s from the right.
-- @param sub substring
-- @param first first index
-- @param last last index
function rfind(self,sub,first,last)
assert_string(1,self)
assert_string(2,sub)
local idx = _find_all(self,sub,first,last)
if idx then return idx else return -1 end
end
--- replace up to n instances of old by new in the string s.
-- if n is not present, replace all instances.
-- @param s the string
-- @param old the target substring
-- @param new the substitution
-- @param n optional maximum number of substitutions
-- @return result string
-- @return the number of substitutions
function replace(s,old,new,n)
assert_string(1,s)
assert_string(1,old)
return gsub(s,escape(old),new,n)
end
--- split a string into a list of strings using a pattern.
-- @class function
-- @name split
-- @param self the string
-- @param re a Lua string pattern (defaults to whitespace)
-- @usage #(('one two'):split()) == 2
function split(self,re)
return setmetatable(usplit(self,re),list_MT)
end
--- split a string using a pattern. Note that at least one value will be returned!
-- @param self the string
-- @param re a Lua string pattern (defaults to whitespace)
-- @return the parts of the string
-- @usage a,b = line:splitv('=')
function splitv (self,re)
assert_string(1,self)
return unpack(split(self,re))
end
local function copy(self)
return self..''
end
-- capitalize the string
function capitalize(self)
assert_string(1,self)
return self:sub(1,1):upper()..self:sub(2)
end
--- count all instances of substring in string.
-- @param sub substring
function count(self,sub)
assert_string(1,self)
local i,k = _find_all(self,sub,1)
return k
end
function _just(s,w,ch,left,right)
local n = #s
if w > n then
if not ch then ch = ' ' end
local f1,f2
if left and right then
f1 = rep(ch,(w-n)/2)
f2 = f1
elseif left then
f1 = rep(ch,w-n)
f2 = ''
else
f2 = rep(ch,w-n)
f1 = ''
end
return f1..s..f2
else
return copy(s)
end
end
--- left-justify s with width w.
-- @param w width of justification
-- @param ch padding character, default ' '
function ljust(self,w,ch)
assert_string(1,self)
assert_arg(2,w,'number')
return _just(self,w,ch,true,false)
end
--- right-justify s with width w.
-- @param w width of justification
-- @param ch padding character, default ' '
function rjust(s,w,ch)
assert_string(1,s)
assert_arg(2,w,'number')
return _just(s,w,ch,false,true)
end
--- center-justify s with width w.
-- @param w width of justification
-- @param ch padding character, default ' '
function center(s,w,ch)
assert_string(1,s)
assert_arg(2,w,'number')
return _just(s,w,ch,true,true)
end
local function _strip(s,chrs,left,right)
if left then
local i1,i2 = find(s,'^%s*')
if i2 >= i1 then
s = sub(s,i2+1)
end
end
if right then
local i1,i2 = find(s,'%s*$')
if i2 >= i1 then
s = sub(s,1,i1-1)
end
end
return s
end
--- trim any whitespace on the left of s.
function lstrip(self,chrs)
assert_string(1,self)
return _strip(self,chrs,true,false)
end
--- trim any whitespace on the right of s.
function rstrip(s,chrs)
assert_string(1,s)
return _strip(s,chrs,false,true)
end
--- trim any whitespace on both left and right of s.
function strip(self,chrs)
assert_string(1,self)
return _strip(self,chrs,true,true)
end
-- The partition functions split a string using a delimiter into three parts:
-- the part before, the delimiter itself, and the part afterwards
local function _partition(p,delim,fn)
local i1,i2 = fn(p,delim)
if not i1 or i1 == -1 then
return p,'',''
else
if not i2 then i2 = i1 end
return sub(p,1,i1-1),sub(p,i1,i2),sub(p,i2+1)
end
end
--- partition the string using first occurance of a delimiter
-- @param ch delimiter
-- @return part before ch, ch, part after ch
function partition(self,ch)
assert_string(1,self)
assert_string(2,ch)
return _partition(self,ch,lfind)
end
--- partition the string p using last occurance of a delimiter
-- @param ch delimiter
-- @return part before ch, ch, part after ch
function rpartition(self,ch)
assert_string(1,self)
assert_string(2,ch)
return _partition(self,ch,rfind)
end
--- return the 'character' at the index.
-- @param self the string
-- @param idx an index (can be negative)
-- @return a substring of length 1 if successful, empty string otherwise.
function at(self,idx)
assert_string(1,self)
assert_arg(2,idx,'number')
return sub(self,idx,idx)
end
--- return an interator over all lines in a string
-- @param self the string
-- @return an iterator
function lines (self)
assert_string(1,self)
local s = self
if not s:find '\n$' then s = s..'\n' end
return self:gfind('([^\n]*)\n')
end
function import(dont_overload)
utils.import(_G.pl.stringx,string)
end

746
moo/moolua/pl/tablex.lua Normal file
View File

@ -0,0 +1,746 @@
------------------------------------
-- Extended operations on Lua tables
local getmetatable,setmetatable,require = getmetatable,setmetatable,require
local append,remove = table.insert,table.remove
local min,max = math.min,math.max
local pairs,type,unpack,next,ipairs,select,tostring = pairs,type,unpack,next,ipairs,select,tostring
local utils = require ('pl.utils')
local function_arg = utils.function_arg
local Set = utils.stdmt.Set
local List = utils.stdmt.List
local assert_arg = utils.assert_arg
local print = print
module ('pl.tablex',utils._module)
-- generally, functions that make copies of tables try to preserve the metatable.
-- However, when the source has no obvious type, then we attach appropriate metatables
-- like List, Map, etc to the result.
local function setmeta (res,tbl,def)
return setmetatable(res,getmetatable(tbl) or def)
end
local function makelist (res)
return setmetatable(res,List)
end
--- copy a table into another, in-place.
-- @param t1 destination table
-- @param t2 source table
-- @return first table
function update (t1,t2)
assert_arg(1,t1,'table')
assert_arg(2,t2,'table')
for k,v in pairs(t2) do
t1[k] = v
end
return t1
end
--- total number of elements in this table. <br>
-- Note that this is distinct from #t, which is the number
-- of values in the array part; this value will always
-- be greater or equal. The difference gives the size of
-- the hash part, for practical purposes.
-- @param t a table
-- @return the size
function size (t)
assert_arg(1,t,'table')
local i = 0
for k in pairs(t) do i = i + 1 end
return i
end
--- make a shallow copy of a table
-- @param t source table
-- @return new table
function copy (t)
assert_arg(1,t,'table')
local res = {}
for k,v in pairs(t) do
res[k] = v
end
return setmeta(res,t)
end
--- make a deep copy of a table, recursively copying all the keys and fields.
-- This will also set the copied table's metatable to that of the original.
-- @param t A table
-- @return new table
function deepcopy(t)
assert_arg(1,t,'table')
if type(t) ~= 'table' then return t end
local mt = getmetatable(t)
local res = {}
for k,v in pairs(t) do
if type(v) == 'table' then
v = deepcopy(v)
end
res[k] = v
end
setmetatable(res,mt)
return res
end
--- compare two values.
-- if they are tables, then compare their keys and fields recursively.
-- @param t1 A value
-- @param t2 A value
-- @param ignore_mt if true, ignore __eq metamethod (default false)
-- @return true or false
function deepcompare(t1,t2,ignore_mt)
local ty1 = type(t1)
local ty2 = type(t2)
if ty1 ~= ty2 then return false end
-- non-table types can be directly compared
if ty1 ~= 'table' and ty2 ~= 'table' then return t1 == t2 end
-- as well as tables which have the metamethod __eq
local mt = getmetatable(t1)
if not ignore_mt and mt and mt.__eq then return t1 == t2 end
for k1,v1 in pairs(t1) do
local v2 = t2[k1]
if v2 == nil or not deepcompare(v1,v2,ignore_mt) then return false end
end
for k2,v2 in pairs(t2) do
local v1 = t1[k2]
if v1 == nil or not deepcompare(v1,v2,ignore_mt) then return false end
end
return true
end
--- compare two list-like tables using a predicate.
-- @param t1 a table
-- @param t2 a table
-- @param cmp A comparison function
function compare (t1,t2,cmp)
assert_arg(1,t1,'table')
assert_arg(2,t2,'table')
if #t1 ~= #t2 then return false end
cmp = function_arg(cmp)
for k in ipairs(t1) do
if not cmp(t1[k],t2[k]) then return false end
end
return true
end
--- compare two list-like tables using an optional predicate, without regard for element order.
-- @param t1 a list-like table
-- @param t2 a list-like table
-- @param cmp A comparison function (may be nil)
function compare_no_order (t1,t2,cmp)
assert_arg(1,t1,'table')
assert_arg(2,t2,'table')
if cmp then cmp = function_arg(cmp) end
if #t1 ~= #t2 then return false end
local visited = {}
for i = 1,#t1 do
local val = t1[i]
local gotcha
for j = 1,#t2 do if not visited[j] then
local match
if cmp then match = cmp(val,t2[j]) else match = val == t2[j] end
if match then
gotcha = j
break
end
end end
if not gotcha then return false end
visited[gotcha] = true
end
return true
end
--- return the index of a value in a list.
-- Like string.find, there is an optional index to start searching,
-- which can be negative.
-- @param t A list-like table (i.e. with numerical indices)
-- @param val A value
-- @param idx index to start; -1 means last element,etc (default 1)
-- @return index of value or nil if not found
-- @usage find({10,20,30},20) == 2
-- @usage find({'a','b','a','c'},'a',2) == 3
function find(t,val,idx)
assert_arg(1,t,'table')
idx = idx or 1
if idx < 0 then idx = #t + idx + 1 end
for i = idx,#t do
if t[i] == val then return i end
end
return nil
end
--- return the index of a value in a list, searching from the end.
-- Like string.find, there is an optional index to start searching,
-- which can be negative.
-- @param t A list-like table (i.e. with numerical indices)
-- @param val A value
-- @param idx index to start; -1 means last element,etc (default 1)
-- @return index of value or nil if not found
-- @usage rfind({10,10,10},10) == 3
function rfind(t,val,idx)
assert_arg(1,t,'table')
idx = idx or #t
if idx < 0 then idx = #t + idx + 1 end
for i = idx,1,-1 do
if t[i] == val then return i end
end
return nil
end
--- return the index (or key) of a value in a table using a comparison function.
-- @param t A table
-- @param cmp A comparison function
-- @param arg an optional second argument to the function
-- @return index of value, or nil if not found
-- @return value returned by comparison function
function find_if(t,cmp,arg)
assert_arg(1,t,'table')
cmp = function_arg(cmp)
for k,v in pairs(t) do
local c = cmp(v,arg)
if c then return k,c end
end
return nil
end
--- return a list of all values in a table indexed by another list.
-- @param tbl a table
-- @param idx an index table (a list of keys)
-- @return a list-like table
-- @usage index_by({10,20,30,40},{2,4}) == {20,40}
-- @usage index_by({one=1,two=2,three=3},{'one','three'}) == {1,3}
function index_by(tbl,idx)
assert_arg(1,tbl,'table')
assert_arg(2,idx,'table')
local res = {}
for _,i in ipairs(idx) do
append(res,tbl[i])
end
return setmeta(res,tbl,List)
end
--- apply a function to all values of a table.
-- This returns a table of the results.
-- Any extra arguments are passed to the function.
-- @param fun A function that takes at least one argument
-- @param t A table
-- @usage map(function(v) return v*v end, {10,20,30,fred=2}) is {100,400,900,fred=4}
function map(fun,t,...)
assert_arg(1,t,'table')
fun = function_arg(fun)
local res = {}
for k,v in pairs(t) do
res[k] = fun(v,...)
end
return setmeta(res,t)
end
--- apply a function to all values of a list.
-- This returns a table of the results.
-- Any extra arguments are passed to the function.
-- @param fun A function that takes at least one argument
-- @param t a table (applies to array part)
-- @return a list-like table
-- @usage imap(function(v) return v*v end, {10,20,30,fred=2}) is {100,400,900}
function imap(fun,t,...)
assert_arg(1,t,'table')
fun = function_arg(fun)
local res = {}
for i = 1,#t do
res[i] = fun(t[i],...)
end
return setmeta(res,t,List)
end
--- apply a named method to values from a table.
-- @param name the method name
-- @param t a list-like table
-- @param ... any extra arguments to the method
function map_named_method (name,t,...)
assert_arg(1,name,'string')
assert_arg(2,t,'table')
local res = {}
for i = 1,#t do
local val = t[i]
local fun = val[name]
res[i] = fun(val,...)
end
return setmeta(res,t,List)
end
--- apply a function to all values of a table, in-place.
-- Any extra arguments are passed to the function.
-- @param fun A function that takes at least one argument
-- @param t a table
-- @param ... extra arguments
function transform (fun,t,...)
assert_arg(1,t,'table')
fun = function_arg(fun)
for k,v in pairs(t) do
t[v] = fun(v,...)
end
end
--- generate a table of all numbers in a range
-- @param start number
-- @param finish number
-- @param step optional increment (default 1 for increasing, -1 for decreasing)
function range (start,finish,step)
local res = {}
local k = 1
if not step then
if finish > start then step = finish > start and 1 or -1 end
end
for i=start,finish,step do res[k]=i; k=k+1 end
return res
end
--- apply a function to values from two tables.
-- @param fun a function of at least two arguments
-- @param t1 a table
-- @param t2 a table
-- @param ... extra arguments
-- @return a table
-- @usage map2('+',{1,2,3,m=4},{10,20,30,m=40}) is {11,22,23,m=44}
function map2 (fun,t1,t2,...)
assert_arg(1,t1,'table')
assert_arg(2,t2,'table')
fun = function_arg(fun)
local res = {}
for k,v in pairs(t1) do
res[k] = fun(v,t2[k],...)
end
return setmeta(res,t,List)
end
--- apply a function to values from two arrays.
-- @param fun a function of at least two arguments
-- @param t1 a list-like table
-- @param t2 a list-like table
-- @param ... extra arguments
-- @usage imap2('+',{1,2,3,m=4},{10,20,30,m=40}) is {11,22,23}
function imap2 (fun,t1,t2,...)
assert_arg(2,t1,'table')
assert_arg(3,t2,'table')
fun = function_arg(fun)
local res = {}
for i = 1,#t1 do
res[i] = fun(t1[i],t2[i],...)
end
return res
end
--- 'reduce' a list using a binary function.
-- @param fun a function of two arguments
-- @param t a list-like table
-- @return the result of the function
-- @usage reduce('+',{1,2,3,4}) == 10
function reduce (fun,t)
assert_arg(2,t,'table')
fun = function_arg(fun)
local n = #t
local res = t[1]
for i = 2,n do
res = fun(res,t[i])
end
return res
end
--- apply a function to all elements of a table.
-- The arguments to the function will be the value,
-- the key and <i>finally</i> any extra arguments passed to this function.
-- Note that the Lua 5.0 function table.foreach passed the <i>key</i> first.
-- @param t a table
-- @param fun a function with at least one argument
-- @param ... extra arguments
function foreach(t,fun,...)
assert_arg(1,t,'table')
fun = function_arg(fun)
for k,v in pairs(t) do
fun(v,k,...)
end
end
--- apply a function to all elements of a list-like table in order.
-- The arguments to the function will be the value,
-- the index and <i>finally</i> any extra arguments passed to this function
-- @param t a table
-- @param fun a function with at least one argument
function foreachi(t,fun,...)
assert_arg(1,t,'table')
fun = function_arg(fun)
for k,v in ipairs(t) do
fun(v,k,...)
end
end
--- Apply a function to a number of tables.
-- A more general version of map
-- The result is a table containing the result of applying that function to the
-- ith value of each table. Length of output list is the minimum length of all the lists
-- @usage mapn(function(x,y,z) return x+y+z end, {1,2,3},{10,20,30},{100,200,300}) is {111,222,333}
-- @usage mapn(math.max, {1,20,300},{10,2,3},{100,200,100}) is {100,200,300}
-- @param fun A function that takes as many arguments as there are tables
function mapn(fun,...)
fun = function_arg(fun)
local res = {}
local lists = {...}
local minn = 1e40
for i = 1,#lists do
minn = min(minn,#(lists[i]))
end
for i = 1,minn do
local args = {}
for j = 1,#lists do
args[#args+1] = lists[j][i]
end
res[#res+1] = fun(unpack(args))
end
return res
end
--- call the function with the key and value pairs from a table.
-- The function can return a value and a key (note the order!). If both
-- are not nil, then this pair is inserted into the result. If only value is not nil, then
-- it is appended to the result.
-- @param fun A function which will be passed each key and value as arguments, plus any extra arguments to pairmap.
-- @param t A table
-- @usage pairmap({fred=10,bonzo=20},function(k,v) return v end) is {10,20}
-- @usage pairmap({one=1,two=2},function(k,v) return {k,v},k end) is {one={'one',1},two={'two',2}}
function pairmap(fun,t,...)
assert_arg(1,t,'table')
fun = function_arg(fun)
local res = {}
for k,v in pairs(t) do
local rv,rk = fun(k,v,...)
if rk then
res[rk] = rv
else
res[#res+1] = rv
end
end
return res
end
local function keys_op(i,v) return i end
--- return all the keys of a table in arbitrary order.
-- @param t A table
function keys(t)
assert_arg(1,t,'table')
return makelist(pairmap(keys_op,t))
end
local function values_op(i,v) return v end
--- return all the values of the table in arbitrary order
-- @param t A table
function values(t)
assert_arg(1,t,'table')
return makelist(pairmap(values_op,t))
end
local function index_map_op (i,v) return i,v end
--- create an index map from a list-like table. The original values become keys,
-- and the associated values are the indices into the original list.
-- @param t a list-like table
-- @return a map-like table
function index_map (t)
assert_arg(1,t,'table')
return setmetatable(pairmap(index_map_op,t),Map)
end
local function set_op(i,v) return true,v end
--- create a set from a list-like table. A set is a table where the original values
-- become keys, and the associated values are all true.
-- @param t a list-like table
-- @return a set (a map-like table)
function makeset (t)
assert_arg(1,t,'table')
return setmetatable(pairmap(set_op,t),Set)
end
--- combine two tables, either as union or intersection. Corresponds to
-- set operations for sets () but more general. Not particularly
-- useful for list-like tables.
-- @param t1 a table
-- @param t2 a table
-- @param dup true for a union, false for an intersection.
-- @usage merge({alice=23,fred=34},{bob=25,fred=34}) is {fred=34}
-- @usage merge({alice=23,fred=34},{bob=25,fred=34},true) is {bob=25,fred=34,alice=23}
-- @see index_map
function merge (t1,t2,dup)
assert_arg(1,t1,'table')
assert_arg(2,t2,'table')
local res = {}
for k,v in pairs(t1) do
if dup or t2[k] then res[k] = v end
end
for k,v in pairs(t2) do
if dup or t1[k] then res[k] = v end
end
return setmeta(res,t1,Map)
end
--- a new table which is the difference of two tables.
-- With sets (where the values are all true) this is set difference and
-- symmetric difference depending on the third parameter.
-- @param s1 a map-like table or set
-- @param s2 a map-like table or set
-- @param symm symmetric difference (default false)
-- @return a map-like table or set
function difference (s1,s2,symm)
assert_arg(1,s1,'table')
assert_arg(2,s2,'table')
local res = {}
for k,v in pairs(s1) do
if not s2[k] then res[k] = v end
end
if symm then
for k,v in pairs(s2) do
if not s1[k] then res[k] = v end
end
end
return setmeta(res,s1,Map)
end
--- A table where the key/values are the values and value counts of the table.
-- @param t a list-like table
-- @param cmp a function that defines equality (otherwise uses ==)
-- @return a map-like table
-- @see pl.seq.count_map
function count_map (t,cmp)
assert_arg(1,t,'table')
local res,mask = {},{}
cmp = function_arg(cmp)
local n = #t
for i,v in ipairs(t) do
if not mask[v] then
mask[v] = true
-- check this value against all other values
res[v] = 1 -- there's at least one instance
for j = i+1,n do
local w = t[j]
if cmp and cmp(v,w) or v == w then
res[v] = res[v] + 1
mask[w] = true
end
end
end
end
return setmetatable(res,Map)
end
--- filter a table's values using a predicate function
-- @param t a list-like table
-- @param pred a boolean function
-- @param optional argument to be passed as second argument of the predicate
function filter (t,pred,arg)
assert_arg(1,t,'table')
pred = function_arg(pred)
local res = {}
for k,v in ipairs(t) do
if pred(v,arg) then append(res,v) end
end
return setmeta(res,t,List)
end
--- return a table where each element is a table of the ith values of an arbitrary
-- number of tables. It is equivalent to a matrix transpose.
-- @usage zip({10,20,30},{100,200,300}) is {{10,100},{20,200},{30,300}}
function zip(...)
return mapn(function(...) return {...} end,...)
end
local _copy
function _copy (dest,src,idest,isrc,nsrc,clean_tail)
idest = idest or 1
isrc = isrc or 1
local iend
if not nsrc then
nsrc = #src
iend = #src
else
iend = isrc + min(nsrc-1,#src-isrc)
end
if dest == src then -- special case
if idest > isrc and iend >= idest then -- overlapping ranges
src = sub(src,isrc,nsrc)
isrc = 1; iend = #src
end
end
for i = isrc,iend do
dest[idest] = src[i]
idest = idest + 1
end
if clean_tail then
clear(dest,idest)
end
return dest
end
--- copy an array into another one, resizing the destination if necessary. <br>
-- @param dest a list-like table
-- @param src a list-like table
-- @param isrc where to start copying values into destination (default 1)
-- @param idest where to start copying values from source (default 1)
-- @param n number of elements to copy from source (default source size)
function icopy (dest,src,idest,isrc,nsrc)
assert_arg(1,dest,'table')
assert_arg(2,src,'table')
return _copy(dest,src,idest,isrc,ndest,true)
end
--- copy an array into another one. <br>
-- @param dest a list-like table
-- @param src a list-like table
-- @param isrc where to start copying values into destination (default 1)
-- @param idest where to start copying values from source (default 1)
-- @param n number of elements to copy from source (default source size)
function move (dest,src,idest,isrc,nsrc)
assert_arg(1,dest,'table')
assert_arg(2,src,'table')
return _copy(dest,src,idest,isrc,nsrc,false)
end
function _normalize_slice(self,first,last)
local sz = #self
if not first then first=1 end
if first<0 then first=sz+first+1 end
-- make the range _inclusive_!
if not last then last=sz end
if last < 0 then last=sz+1+last end
return first,last
end
--- Extract a range from a table, like 'string.sub'.
-- If first or last are negative then they are relative to the end of the list
-- eg. sub(t,-2) gives last 2 entries in a list, and
-- sub(t,-4,-2) gives from -4th to -2nd
-- @param t a list-like table
-- @param first An index
-- @param last An index
-- @return a new List
function sub(t,first,last)
assert_arg(1,t,'table')
first,last = _normalize_slice(t,first,last)
local res={}
for i=first,last do append(res,t[i]) end
return setmeta(res,t,List)
end
--- set an array range to a value. If it's a function we use the result
-- of applying it to the indices.
-- @param t a list-like table
-- @param val a value
-- @param i1 start range (default 1)
-- @param i2 end range (default table size)
function set (t,val,i1,i2)
i1,i2 = i1 or 1,i2 or #t
if utils.is_callable(val) then
for i = i1,i2 do
t[i] = val(i)
end
else
for i = i1,i2 do
t[i] = val
end
end
end
--- create a new array of specified size with initial value.
-- @param n size
-- @param val initial value (can be nil, but don't expect # to work!)
-- @return the table
function new (n,val)
local res = {}
set(res,val,1,n)
return res
end
--- clear out the contents of a table.
-- @param t a table
function clear(t,istart)
istart = istart or 1
for i = istart,#t do remove(t) end
end
--- insert values into a table. <br>
-- insertvalues(t, [pos,] values) <br>
-- similar to table.insert but inserts values from given table "values",
-- not the object itself, into table "t" at position "pos".
function insertvalues(t, ...)
local pos, values
if select('#', ...) == 1 then
pos,values = #t+1, ...
else
pos,values = ...
end
if #values > 0 then
for i=#t,pos,-1 do
t[i+#values] = t[i]
end
local offset = 1 - pos
for i=pos,pos+#values-1 do
t[i] = values[i + offset]
end
end
return t
end
--- remove a range of values from a table.
-- @param t a list-like table
-- @param i1 start index
-- @param i2 end index
-- @return the table
function removevalues (t,i1,i2)
i1,i2 = _normalize_slice(t,i1,i2)
for i = i1,i2 do
remove(t,i1)
end
return t
end
local _find
_find = function (t,value,tables)
for k,v in pairs(t) do
if v == value then return k end
end
for k,v in pairs(t) do
if not tables[v] and type(v) == 'table' then
tables[v] = true
local res = _find(v,value,tables)
if res then
res = tostring(res)
if type(k) ~= 'string' then
return '['..k..']'..res
else
return k..'.'..res
end
end
end
end
end
--- find a value in a table by recursive search.
-- @param t the table
-- @param value the value
-- @param exclude any tables to avoid searching
-- @usage search(_G,math.sin,{package.path}) == 'math.sin'
-- @return a fieldspec, e.g. 'a.b' or 'math.sin'
function search (t,value,exclude)
assert_arg(1,t,'table')
local tables = {[t]=true}
if exclude then
for _,v in pairs(exclude) do tables[v] = true end
end
return _find(t,value,tables)
end

66
moo/moolua/pl/test.lua Normal file
View File

@ -0,0 +1,66 @@
--------------------------------------------
--- Useful test utilities.
local tablex = require 'pl.tablex'
local utils = require 'pl.utils'
local pretty = require 'pl.pretty'
local path = require 'pl.path'
local print,type = print,type
local clock = os.clock
local io,debug = io,debug
local function dump(x)
if type(x) == 'table' then
return pretty.write(x,' ',true)
else
return print(x)
end
end
module ('pl.test',utils._module)
local function complain (x,y)
local i = debug.getinfo(3)
io.stderr:write('assertion failed at '..path.basename(i.short_src)..':'..i.currentline..'\n')
print("x:",dump(x))
print("y:",dump(y))
utils.quit(1,"these values were not equal")
end
--- like assert, except takes two arguments that must be equal and can be tables.
-- If they are plain tables, it will use tablex.deepcompare.
-- @param x any value
-- @param y a value equal to x
function asserteq (x,y)
if x ~= y then
local res = false
if type(x) == 'table' and type(y) == 'table' then
res = tablex.deepcompare(x,y,true)
end
if not res then
complain(x,y)
end
end
end
--- a version of asserteq that takes two pairs of values.
-- <code>x1==y1 and x2==y2</code> must be true. Useful for functions that naturally
-- return two values.
-- @param x1 any value
-- @param x2 any value
-- @param y1 any value
-- @param y2 any value
function asserteq2 (x1,x2,y1,y2)
if x1 ~= y1 then complain(x1,y1) end
if x2 ~= y2 then complain(x2,y2) end
end
--- Time a function. Call the function a given number of times, and report the number of seconds taken,
-- together with a message. Any extra arguments will be passed to the function.
-- @param msg a descriptive message
-- @param n number of times to call the function
-- @param fun the function
function timer(msg,n,fun,...)
local start = clock()
for i = 1,n do fun(...) end
utils.printf("%s: took %7.2f sec\n",msg,clock()-start)
end

168
moo/moolua/pl/text.lua Normal file
View File

@ -0,0 +1,168 @@
--- Text processing utilities. <br>
-- This provides a Template class (modeled after the same from the Python <br>
-- libraries, see string.Template). It also provides dedent, wrap and
-- fill as found in the textwrap module, as well as indent.
-- @class module
-- @name pl.text
local print = print
local gsub = string.gsub
local stringx = require 'pl.stringx'
local concat = table.concat
local imap = require 'pl.tablex'.imap
local utils = require 'pl.utils'
local bind1 = utils.bind1
local split = stringx.split
local setmetatable,getmetatable,tostring,string = setmetatable,getmetatable,tostring,string
local List = require 'pl.list'.List
local lstrip,strip = stringx.lstrip,stringx.strip
local assert_arg = utils.assert_arg
module ('pl.text',utils._module)
local function _indent (s,sp)
local sl = split(s,'\n')
return concat(imap(bind1('..',sp),sl),'\n')..'\n'
end
--- indent a multiline string.
-- @param s the string
-- @param n the size of the indent
-- @param ch the character to use when indenting (default ' ')
-- @return indented string
function indent (s,n,ch)
assert_arg(1,s,'string')
assert_arg(2,s,'number')
return _indent(s,string.rep(ch or ' ',n))
end
--- dedent a multiline string by removing any initial indent.
-- useful when working with [[..]] strings.
-- @param s the string
-- @return a string with initial indent zero.
function dedent (s)
assert_arg(1,s,'string')
local sl = split(s,'\n')
local i1,i2 = sl[1]:find('^%s*')
sl = sl:map(string.sub,i2+1)
return sl:concat('\n')..'\n'
end
--- format a paragraph into lines so that they fit into a line width.
-- It will not break long words, so lines can be over the length
-- to that extent.
-- @param s the string
-- @param width the margin width, default 70
-- @return a list of lines
function wrap (s,width)
assert_arg(1,s,'string')
width = width or 70
s = s:gsub('\n',' ')
local i,nxt = 1
local lines = List()
while i < #s do
nxt = i+width
if s:find("[%w']",nxt) then -- inside a word
nxt = s:find('%W',nxt+1) -- so find word boundary
end
line = s:sub(i,nxt)
i = i + #line
lines:append(strip(line))
end
return lines
end
--- format a paragraph so that it fits into a line width.
-- @param s the string
-- @param width the margin width, default 70
-- @return a string
-- @see wrap
function fill (s,width)
return wrap(s,width):concat '\n' .. '\n'
end
Template = {}
Template.__index = Template
setmetatable(Template, {
__call = function(obj,tmpl)
return Template.new(tmpl)
end})
function Template.new(tmpl)
assert_arg(1,tmpl,'string')
local res = {}
res.tmpl = tmpl
setmetatable(res,Template)
return res
end
local function _substitute(s,tbl,safe)
local function subst(f)
local s = tbl[f]
if not s then
if safe then
return f
else
error("not present in table "..f)
end
else
return s
end
end
local res = gsub(s,'%${([%w_]+)}',subst)
return (gsub(res,'%$([%w_]+)',subst))
end
--- substitute values into a template, throwing an error.
-- This will throw an error if no name is found.
-- @param tbl a table of name-value pairs.
function Template:substitute(tbl)
assert_arg(1,tbl,'table')
return _substitute(self.tmpl,tbl,false)
end
--- substitute values into a template.
-- This version just passes unknown names through.
-- @param tbl a table of name-value pairs.
function Template:safe_substitute(tbl)
assert_arg(1,tbl,'table')
return _substitute(self.tmpl,tbl,true)
end
--- substitute values into a template, preserving indentation. <br>
-- If the value is a multiline string _or_ a template, it will insert
-- the lines at the correct indentation. <br>
-- Furthermore, if a template, then that template will be subsituted
-- using the same table.
-- @param tbl a table of name-value pairs.
function Template:indent_substitute(tbl)
assert_arg(1,tbl,'table')
if not self.strings then
self.strings = split(self.tmpl,'\n')
end
-- the idea is to substitute line by line, grabbing any spaces as
-- well as the $var. If the value to be substituted contains newlines,
-- then we split that into lines and adjust the indent before inserting.
local function subst(line)
return line:gsub('(%s*)%$([%w_]+)',function(sp,f)
local subtmpl
local s = tbl[f]
if not s then error("not present in table "..f) end
if getmetatable(s) == Template then
subtmpl = s
s = s.tmpl
else
s = tostring(s)
end
if s:find '\n' then
s = _indent(s,sp)
end
if subtmpl then return _substitute(s,tbl)
else return s
end
end)
end
local lines = imap(subst,self.strings)
return concat(lines,'\n')..'\n'
end

390
moo/moolua/pl/utils.lua Normal file
View File

@ -0,0 +1,390 @@
---------------------------------------------------
--- Generally useful routines.
-- @class module
-- @name pl.utils
require 'pl.compat52'
local _G = _G
local type,getfenv,rawget,pairs,ipairs,getmetatable,require,setmetatable,tonumber,assert,rawset = type,getfenv,rawget,pairs,ipairs,getmetatable,require,setmetatable,tonumber,assert,rawset
local select,unpack,pcall,g_error = select,unpack,pcall,error
local io,debug = io,debug
local format,gsub,byte = string.format,string.gsub,string.byte
local clock = os.clock
local stdout = io.stdout
local append = table.insert
local exit = os.exit
local collisions = {}
module ('pl.utils')
dir_separator = _G.package.config:sub(1,1)
--- end this program gracefully.
-- @param code The exit code
-- @param msg A message to be printed
-- @param ... extra arguments for fprintf
-- @see pl.utils.fprintf
function quit(code,msg,...)
if type(code) == 'string' then
msg = code
code = -1
end
fprintf(io.stderr,msg,...)
io.stderr:write('\n')
exit(code)
end
--- print an arbitrary number of arguments using a format.
-- @param fmt The format (see string.format)
function printf(fmt,...)
fprintf(stdout,fmt,...)
end
--- write an arbitrary number of arguments to a file using a format.
-- @param fmt The format (see string.format)
function fprintf(f,fmt,...)
assert_string(2,fmt)
f:write(format(fmt,...))
end
local function import_symbol(T,k,v,libname)
local key = rawget(T,k)
-- warn about collisions!
if key and k ~= '_M' and k ~= '_NAME' and k ~= '_PACKAGE' and k ~= '_VERSION' then
printf("warning: '%s.%s' overrides existing symbol\n",libname,k)
end
rawset(T,k,v)
end
local function lookup_lib(T,t)
for k,v in pairs(T) do
if v == t then return k end
end
return '?'
end
local already_imported = {}
--- take a table and 'inject' it into the local namespace.
-- @param t The Table
-- @param T An optional destination table (defaults to callers environment)
function import(t,T)
T = T or getfenv(2)
t = t or _G.pl.utils
if type(t) == 'string' then
t = require (t)
end
_G.print("importing",T,t,_G)
local libname = lookup_lib(T,t)
if already_imported[t] then return end
already_imported[t] = libname
for k,v in pairs(t) do
import_symbol(T,k,v,libname)
end
end
patterns = {
FLOAT = '[%+%-%d]%d*%.?%d*[eE]?[%+%-]?%d*',
INTEGER = '[+%-%d]%d*',
IDEN = '[%a_][%w_]*',
FILE = '[%a%.\\][:%][%w%._%-\\]*'
}
--- escape any 'magic' characters in a string
-- @param s The input string
function escape(s)
assert_string(1,s)
return (s:gsub('[%-%.%+%[%]%(%)%$%^%%%?%*]','%%%1'))
end
--- return either of two values, depending on a condition.
-- @param cond A condition
-- @param value1 Value returned if cond is true
-- @param value2 Value returned if cond is false (can be optional)
function choose(cond,value1,value2)
if cond then return value1
else return value2
end
end
--- return the contents of a file as a string
-- @param filename The file path
-- @return file contents
function readfile(filename,is_bin)
local mode = is_bin and 'b' or ''
assert_string(1,filename)
local f,err = io.open(filename,'r'..mode)
if not f then return raise (err) end
local res,err = f:read('*a')
f:close()
if not res then return raise (err) end
return res
end
--- write a string to a file
-- @param filename The file path
-- @param str The string
function writefile(filename,str)
assert_string(1,filename)
assert_string(2,str)
local f,err = io.open(filename,'w')
if not f then return raise(err) end
f:write(str)
f:close()
return true
end
--- return the contents of a file as a list of lines
-- @param filename The file path
-- @return file contents as a table
function readlines(filename)
assert_string(1,filename)
local f,err = io.open(filename,'r')
if not f then return raise(err) end
local res = {}
for line in f:lines() do
append(res,line)
end
f:close()
return res
end
---- split a string into a list of strings separated by a delimiter.
-- @param s The input string
-- @param re A regular expression; defaults to spaces
-- @return a list-like table
function split(s,re)
assert_string(1,s)
local i1 = 1
local ls = {}
if not re then re = '%s+' end
if re == '' then return {s} end
while true do
local i2,i3 = s:find(re,i1)
if not i2 then
local last = s:sub(i1)
if last ~= '' then append(ls,last) end
if #ls == 1 and ls[1] == '' then
return {}
else
return ls
end
end
append(ls,s:sub(i1,i2-1))
i1 = i3+1
end
end
--- split a string into a number of values.
-- @param s the string
-- @param re the delimiter, default space
-- @return n values
-- @usage first,next = splitv('jane:doe',':')
-- @see split
function splitv (s,re)
return unpack(split(s,re))
end
--- split a string into a list of strings separated by either spaces or commas.
-- @param s The input string
-- @return a list-like table
function splitl(s)
return split(s,'[%s,]+')
end
--- take an arbitrary set of arguments and make into a table.
-- This returns the table and the size; works fine for nil arguments
-- @param ... arguments
-- @return table
-- @return table size
-- @usage local t,n = utils.args(...)
function args (...)
return {...},select('#',...)
end
--- 'memoize' a function (cache returned value for next call).
-- This is useful if you have a function which is relatively expensive,
-- but you don't know in advance what values will be required, so
-- building a table upfront is wasteful/impossible.
-- @param func a function of at least one argument
-- @return a function with at least one argument, which is used as the key.
function memoize(func)
return setmetatable({}, {
__index = function(self, k, ...)
local v = func(k,...)
self[k] = v
return v
end,
__call = function(self, k) return self[k] end
})
end
--- is the object either a function or a callable object?.
function is_callable (obj)
return type(obj) == 'function' or getmetatable(obj) and getmetatable(obj).__call
end
--- is the object of the specified type?.
-- If the type is a string, then use type, otherwise compare with metatable
-- @param obj an object
-- @param tp a type
function is_type (obj,tp)
if type(tp) == 'string' then return type(obj) == tp end
local mt = getmetatable(obj)
return tp == mt
end
stdmt = { List = {}, Map = {}, Set = {}, MultiMap = {} }
local _function_factories = {}
function add_function_factory (mt,fun)
_function_factories[mt] = fun
end
local ops
local function _operator_str (f)
if f:find '^|' then
local args,body = f:match '|([^|]*)|(.+)'
if not args then return raise 'bad string lambda' end
local fstr = 'return function('..args..') return '..body..' end'
local fn,err = _G.loadstring(fstr)
if not fn then return raise(err) end
fn = fn()
return fn
end
local op,val = splitv(f,' ')
if val then
fn = ops[op]
if not fn then return raise 'unknown operator' end
if val:find '^["\']' then
val = val:sub(2,-2)
else
val = tonumber(val)
end
return function(v)
return fn(v,val)
end
end
end
local operator_str = memoize(_operator_str)
--- process a function argument. <br>
-- This is used throughout Penlight and defines what is meant by a function: <br>
-- Something that is_callable, or an operator string as defined by pl.operator, <br>
-- such as '>' or '#'.
-- @param f a function, operator string, or callable object
-- @return a callable
function function_arg (f)
local tp = type(f)
if tp == 'function' then return f end -- no worries!
-- ok, a string can correspond to an operator (like '==')
if tp == 'string' then
if not ops then ops = require 'pl.operator'.optable end
local fn = ops[f]
if fn then return fn end
fn,err = operator_str(f)
if err then error(err,3) end
if fn then return fn end
elseif tp == 'table' or tp == 'userdata' then
local mt = getmetatable(f)
if not mt then error('not a callable object') end
local ff = _function_factories[mt]
if not ff then
if not mt.__call then error('not a callable object') end
return f
else
return ff(f) -- we have a function factory for this type!
end
else
error("'"..tp.."' is not callable")
end
end
--- bind the first argument of the function to a value.
-- @param fn a function of at least two values (may be an operator string)
-- @param p a value
-- @return a function such that f(x) is fn(p,x)
-- @see pl.func.curry
function bind1 (fn,p)
fn = function_arg(fn)
return function(...) return fn(p,...) end
end
local pl_mods = {[_G.pl.utils] = true}
local print = _G.print
function _module (mod)
--print ('registering',mod,mod._NAME)
pl_mods[mod] = true
end
_module(_M)
--local tablex = require 'pl.tablex'
function error (msg,level)
level = level or 2
local current_env = getfenv(level)
local throwing_fun = debug.getinfo(level+1,'f').func
while true do
local is_success, result = pcall(function()
return getfenv(level+2)
end)
--print(is_success,level,result,result._NAME)
if is_success then
local env = result
local info = debug.getinfo(level)
if not pl_mods[env] then
local tablex = require 'pl.tablex'
local name
name = tablex.search(_G.pl,throwing_fun) or '?'
quit(name..': '..debug.traceback(msg, level))
break
end
elseif result:find("(invalid level)",1,true) then
break
end
level = level + 1
if level > 15 then break end --temporary
end
end
function throw (msg)
error(msg,2)
end
function assert_arg (n,val,tp,verify,msg,lev)
if type(val) ~= tp then
error(("argument %d expected a '%s', got a '%s'"):format(n,tp,type(val)))
end
if verify and not verify(val) then
error(("argument %d: '%s' %s"):format(n,val,msg),lev or 2)
end
end
function assert_string (n,val)
assert_arg(n,val,'string',nil,nil,nil,3)
end
local err_mode = 'default'
function on_error (mode)
err_mode = mode
if err_mode == 'raw' then error = _G.error end
end
function raise (err)
if err_mode == 'default' then return nil,err
elseif err_mode == 'quit' then quit(err)
else error(err,2)
end
end

5
moo/mooscript/mooscript-classes.cpp
View File

@ -779,10 +779,7 @@ Variant Document::set_selection(const VariantArray &args)
Variant Document::has_selection(const VariantArray &args)
{
check_no_args(args);
GtkTextBuffer *buf = buffer();
GtkTextIter start, end;
gtk_text_buffer_get_selection_bounds(buf, &start, &end);
return bool(gtk_text_iter_equal(&start, &end));
return bool(gtk_text_buffer_get_selection_bounds(buffer(), NULL, NULL));
}
Variant Document::char_count(const VariantArray &args)

8
moo/plugins/usertools/lua/lua2-tool-setup.lua
View File

@ -1,8 +1,8 @@
local _g = getfenv(0)
local medit = require("medit")
_g.app = medit.get_app_obj()
_g.editor = _g.app.editor
_g.doc = _g.app.active_document
_g.view = _g.app.active_view
_g.window = _g.app.active_window
_g.editor = _g.app.editor()
_g.doc = _g.app.active_document()
_g.view = _g.app.active_view()
_g.window = _g.app.active_window()
setfenv(0, _g)

26
moo/plugins/usertools/unix/context.cfg
View File

@ -4,19 +4,23 @@ id = SwitchHeaderAndImplementation
name = Switch _Header and Implementation
langs = c, cpp, objc, chdr, gap
type = lua
version = 2
options = need-file
require("medit")
local tblx = require('pl.tablex'); local path = require('pl.path')
extensions = {
{ {".h", ".hh", ".hpp", ".hxx", ".H"}, {".c", ".cc", ".cpp", ".cxx", ".C", ".m"} },
{ {".gd"}, {".gi"} },
}
extensions = {{{[".h"] = 1, [".hh"] = 1, [".hpp"] = 1, [".hxx"] = 1, [".H"] = 1},
{[".c"] = 1, [".cc"] = 1, [".cpp"] = 1, [".cxx"] = 1, [".C"] = 1, [".m"] = 1}},
{{[".gd"] = 1}, {[".gi"] = 1}}}
new = nil
base, ext = pl.path.splitext(doc.filename())
for k, p in pairs(extensions) do
if p[1][doc.ext] then
for _, p in ipairs(extensions) do
if tblx.find(p[1], ext) then
new = p[2];
break
elseif p[2][doc.ext] then
elseif tblx.find(p[2], ext) then
new = p[1];
break
end
@ -26,10 +30,10 @@ options = need-file
return
end
for e in pairs(new) do
file = doc.dir .. "/" .. doc.base .. e
if lfs.attributes(file) then
medit.open(file)
for _, e in ipairs(new) do
file = base .. e
if pl.path.exists(file) then
editor.open_file(file)
return
end
end

13
moo/plugins/usertools/unix/menu.cfg
View File

@ -131,18 +131,19 @@ output=async
id=Math
file-filter=*.tex
type=lua
version=2
name=Math
options=need-doc
accel=<alt>M
selection = Selection()
if selection then
Insert("$", selection, "$")
if doc.has_selection() then
doc.replace_selected_text('$' .. doc.selected_text() .. '$')
else
Insert("$ $")
Left()
Select(-1)
pos = doc.cursor_pos()
doc.insert_text('$ $')
doc.set_selection(pos + 1, pos + 2)
end
[tool]
id=InsertDateAndTime
type=python

25
moo/plugins/usertools/win32/context.cfg
View File

@ -5,18 +5,21 @@ name = Switch _Header and Implementation
langs = c, cpp, objc, chdr, gap
type = lua
options = need-file
require("medit")
local tblx = require('pl.tablex'); local path = require('pl.path')
extensions = {
{ {".h", ".hh", ".hpp", ".hxx", ".H"}, {".c", ".cc", ".cpp", ".cxx", ".C", ".m"} },
{ {".gd"}, {".gi"} },
}
extensions = {{{[".h"] = 1, [".hh"] = 1, [".hpp"] = 1, [".hxx"] = 1, [".H"] = 1},
{[".c"] = 1, [".cc"] = 1, [".cpp"] = 1, [".cxx"] = 1, [".C"] = 1, [".m"] = 1}},
{{[".gd"] = 1}, {[".gi"] = 1}}}
new = nil
base, ext = pl.path.splitext(doc.filename())
for k, p in pairs(extensions) do
if p[1][doc.ext] then
for _, p in ipairs(extensions) do
if tblx.find(p[1], ext) then
new = p[2];
break
elseif p[2][doc.ext] then
elseif tblx.find(p[2], ext) then
new = p[1];
break
end
@ -26,10 +29,10 @@ options = need-file
return
end
for e in pairs(new) do
file = doc.dir .. "/" .. doc.base .. e
if lfs.attributes(file) then
medit.open(file)
for _, e in ipairs(new) do
file = base .. e
if pl.path.exists(file) then
editor.open_file(file)
return
end
end

13
moo/plugins/usertools/win32/menu.cfg
View File

@ -3,18 +3,19 @@
id=Math
file-filter=*.tex
type=lua
version=2
name=Math
options=need-doc
accel=<alt>M
selection = Selection()
if selection then
Insert("$", selection, "$")
if doc.has_selection() then
doc.replace_selected_text('$' .. doc.selected_text() .. '$')
else
Insert("$ $")
Left()
Select(-1)
pos = doc.cursor_pos()
doc.insert_text('$ $')
doc.set_selection(pos + 1, pos + 2)
end
[tool]
id=InsertDateAndTime
type=python