Author: fperrad
Date: Fri Feb 2 12:01:17 2007
New Revision: 16867
Modified:
trunk/languages/lua/lib/luaaux.pir
trunk/languages/lua/lib/luabasic.pir
trunk/languages/lua/lib/luastring.pir
trunk/languages/lua/lib/luatable.pir
trunk/languages/lua/t/shootout.t
trunk/languages/lua/t/table.t
Log:
[Lua]
- remove getn() in luaaux.pir
- refactor checknumber()
- implement table.sort()
- and add tests
Modified: trunk/languages/lua/lib/luaaux.pir
==============================================================================
--- trunk/languages/lua/lib/luaaux.pir (original)
+++ trunk/languages/lua/lib/luaaux.pir Fri Feb 2 12:01:17 2007
@@ -71,22 +71,19 @@
.sub 'checknumber'
.param pmc arg
- .local float val
$S0 = "no value"
if_null arg, L0
$S0 = typeof arg
$I0 = isa arg, 'LuaNumber'
unless $I0 goto L1
- val = arg
- .return (val)
+ .return (arg)
L1:
$I0 = isa arg, 'LuaString'
unless $I0 goto L0
$P0 = arg.'tonumber'()
$I0 = isa $P0, 'LuaNumber'
unless $I0 goto L0
- val = $P0
- .return (val)
+ .return ($P0)
L0:
tag_error($S0, "number")
.end
@@ -173,18 +170,6 @@
.end
-=item C<getn (table)>
-
-=cut
-
-.sub 'getn'
- .param pmc table
- $P0 = table.'len'()
- $I0 = $P0
- .return ($I0)
-.end
-
-
=item C<mkarg (argv)>
Support variable number of arguments function call.
Modified: trunk/languages/lua/lib/luabasic.pir
==============================================================================
--- trunk/languages/lua/lib/luabasic.pir (original)
+++ trunk/languages/lua/lib/luabasic.pir Fri Feb 2 12:01:17 2007
@@ -260,7 +260,7 @@
.sub '_lua_dofile' :anon
.param pmc filename :optional
- $S0 = optstring(filename, "")
+ $S0 = optstring(filename, '')
not_implemented()
.end
@@ -361,18 +361,16 @@
ipairs = _G.'rawget'(key_ipairs)
.local pmc zero
new zero, .LuaNumber
- zero = 0.0
+ set zero, 0.0
.return (ipairs, t, zero)
L0:
- $N0 = checknumber(i)
- inc $N0
+ $P0 = checknumber(i)
+ $P1 = clone $P0
+ inc $P1
.local pmc ret
- .local pmc n
- new n, .LuaNumber
- n = $N0
- ret = t.'rawget'(n)
+ ret = t.'rawget'($P1)
unless ret goto L1
- .return (n, ret)
+ .return ($P1, ret)
L1:
.return ()
.end
@@ -829,7 +827,7 @@
.local int e
.local int n
checktype(list, 'table')
- $I0 = getn(list)
+ $I0 = list.'len'()
$I1 = optint(i, 1)
e = optint(j, $I0)
n = e - $I1
Modified: trunk/languages/lua/lib/luastring.pir
==============================================================================
--- trunk/languages/lua/lib/luastring.pir (original)
+++ trunk/languages/lua/lib/luastring.pir Fri Feb 2 12:01:17 2007
@@ -151,12 +151,13 @@
$P0 = split '', specials
L6:
$I0 = $P0
- unless $I0 > 0 goto L3
+ unless $I0 goto L5
$S0 = shift $P0
$I0 = index $S2, $S0
- unless $I0 >= 0 goto L5
+ if $I0 >= 0 goto L3
goto L6
L5:
+ # do a plain search
.local int idx
$S1 = substr $S1, $I3
idx = index $S1, $S2
@@ -166,11 +167,11 @@
new start, .LuaNumber
$I0 = $I3 + idx
inc $I0
- start = $I0
+ set start, $I0
new end, .LuaNumber
$I0 = $I3 + idx
$I0 += $I2
- end = $I0
+ set end, $I0
.return (start, end)
L3:
.local int anchor
@@ -184,6 +185,7 @@
s1 = substr $S1, $I3
not_implemented()
L7:
+ # not found
.local pmc ret
new ret, .LuaNil
.return (ret)
@@ -234,7 +236,7 @@
dec $I0
$I1 = ord $S0, $I0
new $P0, .LuaNumber
- $P0 = $I1
+ set $P0, $I1
ret[i] = $P0
inc i
goto L3
@@ -275,7 +277,7 @@
goto L1
L2:
new ret, .LuaString
- ret = b
+ set ret, b
.return (ret)
.end
@@ -467,7 +469,7 @@
$S0 = checkstring(s)
$I0 = length $S0
new ret, .LuaNumber
- ret = $I0
+ set ret, $I0
.return (ret)
.end
@@ -486,7 +488,7 @@
$S0 = checkstring(s)
downcase $S0
new ret, .LuaString
- ret = $S0
+ set ret, $S0
.return (ret)
.end
@@ -526,7 +528,7 @@
L0:
$S1 = repeat $S0, $I0
new ret, .LuaString
- ret = $S1
+ set ret, $S1
.return (ret)
.end
@@ -557,7 +559,7 @@
L2:
$S1 = join '', $P0
new ret, .LuaString
- ret = $S1
+ set ret, $S1
.return (ret)
.end
@@ -598,7 +600,7 @@
$S1 = ''
L3:
new ret, .LuaString
- ret = $S1
+ set ret, $S1
.return (ret)
.end
@@ -617,7 +619,7 @@
$S0 = checkstring(s)
upcase $S0
new ret, .LuaString
- ret = $S0
+ set ret, $S0
.return (ret)
.end
Modified: trunk/languages/lua/lib/luatable.pir
==============================================================================
--- trunk/languages/lua/lib/luatable.pir (original)
+++ trunk/languages/lua/lib/luatable.pir Fri Feb 2 12:01:17 2007
@@ -100,7 +100,7 @@
$S0 = optstring(sep, '')
checktype(table, 'table')
$I0 = optint(i, 1)
- $I1 = getn(table)
+ $I1 = table.'len'()
last = optint(j, $I1)
$S1 = ''
new idx, .LuaNumber
@@ -186,7 +186,7 @@
.local int n
checktype(table, 'table')
checktype(f, 'function')
- n = getn(table)
+ n = table.'len'()
i = 0
new index, .LuaNumber
L1:
@@ -239,7 +239,7 @@
.local int pos
new index, .LuaNumber
checktype(table, 'table')
- e = getn(table)
+ e = table.'len'()
inc e
unless_null arg3, L1
pos = e
@@ -262,7 +262,7 @@
goto L4
L2:
index = pos
- table[index] = value
+ table.'rawset'(index, value)
.end
@@ -314,7 +314,7 @@
.local int e
.local int ipos
checktype(table, 'table')
- e = getn(table)
+ e = table.'len'()
ipos = optint(pos, e)
unless e <= 0 goto L1
new ret, .LuaNil
@@ -367,8 +367,6 @@
The sort algorithm is I<not> stable; that is, elements considered equal by
the given order may have their relative positions changed by the sort.
-NOT YET IMPLEMENTED (see auxsort).
-
=cut
.sub '_table_sort' :anon
@@ -376,31 +374,149 @@
.param pmc comp :optional
.local int n
checktype(table, 'table')
- n = getn(table)
+ n = table.'len'()
if_null comp, L1
- if comp goto L1
+ $I0 = isa comp, 'LuaNil'
+ if $I0 goto L1
checktype(comp, 'function')
- goto L2
L1:
- .const .Sub lessthan = 'lessthan'
- comp = lessthan
-L2:
- auxsort(table, comp, n)
+ auxsort(table, comp, 1, n)
.end
.sub 'auxsort' :anon
.param pmc table
.param pmc comp
+ .param int l
.param int u
- not_implemented()
+ .local pmc index
+ .local int i
+ .local int j
+ .local int tmp
+ new index, .LuaNumber
+L1:
+ unless l < u goto L2
+ # sort elements a[l], a[(l+u)/2] and a[u]
+ set index, l
+ $P1 = table.'rawget'(index)
+ set index, u
+ $P2 = table.'rawget'(index)
+ $I0 = sort_comp(comp, $P2, $P1) # a[u] < a[l]?
+ unless $I0 goto L3
+ # swap a[l] - a[u]
+ set index, l
+ table.'rawset'(index, $P2)
+ set index, u
+ table.'rawset'(index, $P1)
+L3:
+ tmp = u - l
+ if tmp == 1 goto L2 # break: only 2 elements
+ i = l + u
+ i /= 2
+ set index, i
+ $P1 = table.'rawget'(index)
+ set index, l
+ $P2 = table.'rawget'(index)
+ $I0 = sort_comp(comp, $P1, $P2) # a[i]<a[l]?
+ unless $I0 goto L4
+ set index, i
+ table.'rawset'(index, $P2)
+ set index, l
+ table.'rawset'(index, $P1)
+ goto L5
+L4:
+ set index, u
+ $P2 = table.'rawget'(index)
+ $I0 = sort_comp(comp, $P2, $P1) # a[u]<a[i]?
+ unless $I0 goto L5
+ set index, i
+ table.'rawset'(index, $P2)
+ set index, u
+ table.'rawset'(index, $P1)
+L5:
+ tmp = u - l
+ if tmp == 2 goto L2 # break: only 3 elements
+ set index, i
+ $P1 = table.'rawget'(index) # Pivot
+ tmp = u - 1
+ set index, tmp
+ $P2 = table.'rawget'(index)
+ set index, i
+ table.'rawset'(index, $P2)
+ set index, tmp
+ table.'rawset'(index, $P1)
+ # a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */
+ i = l
+ j = u - 1
+L6: # invariant: a[l..i] <= P <= a[j..u]
+ # repeat ++i until a[i] >= P
+ inc i
+ set index, i
+ $P2 = table.'rawget'(index)
+ $I0 = sort_comp(comp, $P2, $P1)
+ unless $I0 goto L7
+ unless i > u goto L6
+ error("invalid order function for sorting")
+ goto L6
+L7:
+ # repeat --j until a[j] <= P
+ dec j
+ set index, j
+ $P3 = table.'rawget'(index)
+ $I0 = sort_comp(comp, $P1, $P3)
+ unless $I0 goto L8
+ unless j < l goto L7
+ error("invalid order function for sorting")
+ goto L7
+L8:
+ if j < i goto L9
+ set index, i
+ table.'rawset'(index, $P3)
+ set index, j
+ table.'rawset'(index, $P2)
+ goto L6
+L9:
+ tmp = u - 1
+ set index, tmp
+ $P1 = table.'rawget'(index)
+ set index, i
+ $P2 = table.'rawget'(index)
+ # swap pivot (a[u-1]) with a[i]
+ set index, tmp
+ table.'rawset'(index, $P2)
+ set index, i
+ table.'rawset'(index, $P1)
+ # a[l..i-1] <= a[i] == P <= a[i+1..u]
+ # adjust so that smaller half is in [j..i] and larger one in [l..u]
+ tmp += l
+ unless i < tmp goto L10
+ j = l
+ i = i - 1
+ l = i + 2
+ goto L11
+L10:
+ j = i + 1
+ i = u
+ u = j - 2
+L11:
+ # call recursively the smaller one
+ auxsort(table, comp, j, i)
+ # repeat the routine for the larger one
+ goto L1
+L2:
.end
-.sub 'lessthan' :anon
- .param pmc l
- .param pmc r
- .local int ret
- ret = cmp l, r
- .return (ret)
+.sub sort_comp
+ .param pmc comp
+ .param pmc a
+ .param pmc b
+ if_null comp, L1
+ unless comp goto L1
+ $P0 = comp(a, b)
+ $I0 = istrue $P0
+ .return ($I0)
+L1:
+ $I0 = islt a, b
+ .return ($I0)
.end
=back
Modified: trunk/languages/lua/t/shootout.t
==============================================================================
--- trunk/languages/lua/t/shootout.t (original)
+++ trunk/languages/lua/t/shootout.t Fri Feb 2 12:01:17 2007
@@ -34,15 +34,10 @@
# Hashtable update and k-nucleotide strings
#
-TODO:
-{
- local $TODO = 'table.sort is not implemented';
-
$code = Parrot::Test::slurp_file(File::Spec->catfile( @dir,
'knucleotide.lua-2.lua' ));
$out = Parrot::Test::slurp_file(File::Spec->catfile( @dir,
'knucleotide-output.txt' ));
$in = File::Spec->catfile( 'languages', @dir, 'knucleotide-input.txt' );
language_output_is( 'lua', $code, $out, 'k-nucleotide', params => "< $in" );
-}
#
# partial-sums
Modified: trunk/languages/lua/t/table.t
==============================================================================
--- trunk/languages/lua/t/table.t (original)
+++ trunk/languages/lua/t/table.t Fri Feb 2 12:01:17 2007
@@ -27,7 +27,7 @@
use FindBin;
use lib "$FindBin::Bin";
-use Parrot::Test tests => 13;
+use Parrot::Test tests => 16;
use Test::More;
language_output_is( 'lua', << 'CODE', << 'OUTPUT', 'function concat' );
@@ -185,6 +185,106 @@
/'setn' is obsolete/
OUTPUT
+language_output_is( 'lua', << 'CODE', << 'OUTPUT', 'function sort' );
+lines = {
+ luaH_set = 10,
+ luaH_get = 24,
+ luaH_present = 48,
+}
+
+a = {}
+for n in pairs(lines) do a[#a + 1] = n end
+table.sort(a)
+for i,n in ipairs(a) do print(n) end
+CODE
+luaH_get
+luaH_present
+luaH_set
+OUTPUT
+
+language_output_is( 'lua', << 'CODE', << 'OUTPUT', 'function sort' );
+lines = {
+ luaH_set = 10,
+ luaH_get = 24,
+ luaH_present = 48,
+}
+
+function pairsByKeys (t, f)
+ local a = {}
+ for n in pairs(t) do a[#a + 1] = n end
+ table.sort(a, f)
+ local i = 0 -- iterator variable
+ return function () -- iterator function
+ i = i + 1
+ return a[i], t[a[i]]
+ end
+end
+
+for name, line in pairsByKeys(lines) do
+ print(name, line)
+end
+CODE
+luaH_get 24
+luaH_present 48
+luaH_set 10
+OUTPUT
+
+language_output_is( 'lua', << 'CODE', << 'OUTPUT', 'function sort (all
permutations)' );
+function permgen (a, n)
+ n = n or #a
+ if n <= 1 then
+ coroutine.yield(a)
+ else
+ for i=1,n do
+ a[n], a[i] = a[i], a[n]
+ permgen(a, n - 1)
+ a[n], a[i] = a[i], a[n]
+ end
+ end
+end
+
+function permutations (a)
+ local co = coroutine.create(function () permgen(a) end)
+ return function ()
+ local code, res = coroutine.resume(co)
+ return res
+ end
+end
+
+local t = {}
+for _, v in ipairs{'a', 'b', 'c', 'd', 'e', 'f', 'g'} do
+ table.insert(t, v)
+ local ref = table.concat(t, ' ')
+ print(ref)
+ local n = 0
+ for p in permutations(t) do
+ local c = {}
+ for i, v in ipairs(p) do
+ c[i] = v
+ end
+ table.sort(c)
+ assert(ref == table.concat(c, ' '), table.concat(p, ' '))
+ n = n + 1
+ end
+ print(n)
+end
+CODE
+a
+1
+a b
+2
+a b c
+6
+a b c d
+24
+a b c d e
+120
+a b c d e f
+720
+a b c d e f g
+5040
+OUTPUT
+
# Local Variables:
# mode: cperl
# cperl-indent-level: 4
