languages/lua/src/lib/luatable.pir

   1 # Copyright (C) 2005-2008, The Perl Foundation.
   2 # $Id$
   3
   4 =head1 NAME
   5
   6 lib/luatable.pir - Lua Table Library
   7
   8 =head1 DESCRIPTION
   9
  10 This library provides generic functions for table manipulation. It provides
  11 all its functions inside the table C<table>.
  12
  13 Most functions in the table library assume that the table represents an
  14 array or a list. For these functions, when we talk about the "length" of a
  15 table we mean the result of the length operator.
  16
  17 See "Lua 5.1 Reference Manual", section 5.5 "Table Manipulation",
  18 L<http://www.lua.org/manual/5.1/manual.html#5.5>.
  19
  20 =head2 Functions
  21
  22 =over 4
  23
  24 =cut
  25
  26 .HLL 'Lua', 'lua_group'
  27 .namespace [ 'Lua::table' ]
  28
  29 .sub 'luaopen_table'
  30 #    print "init Lua Table\n"
  31
  32     .local pmc _lua__GLOBAL
  33     _lua__GLOBAL = get_hll_global '_G'
  34     new $P1, 'LuaString'
  35
  36     .local pmc _table
  37     new _table, 'LuaTable'
  38     set $P1, 'table'
  39     _lua__GLOBAL[$P1] = _table
  40
  41     lua_register($P1, _table)
  42
  43     .const .Sub _table_concat = 'concat'
  44     _table_concat.'setfenv'(_lua__GLOBAL)
  45     set $P1, 'concat'
  46     _table[$P1] = _table_concat
  47
  48     .const .Sub _table_foreach = 'foreach'
  49     _table_foreach.'setfenv'(_lua__GLOBAL)
  50     set $P1, 'foreach'
  51     _table[$P1] = _table_foreach
  52
  53     .const .Sub _table_foreachi = 'foreachi'
  54     _table_foreachi.'setfenv'(_lua__GLOBAL)
  55     set $P1, 'foreachi'
  56     _table[$P1] = _table_foreachi
  57
  58     # LUA_COMPAT_GETN
  59     .const .Sub _table_getn = 'getn'
  60     _table_getn.'setfenv'(_lua__GLOBAL)
  61     set $P1, 'getn'
  62     _table[$P1] = _table_getn
  63
  64     .const .Sub _table_insert = 'insert'
  65     _table_insert.'setfenv'(_lua__GLOBAL)
  66     set $P1, 'insert'
  67     _table[$P1] = _table_insert
  68
  69     .const .Sub _table_maxn = 'maxn'
  70     _table_maxn.'setfenv'(_lua__GLOBAL)
  71     set $P1, 'maxn'
  72     _table[$P1] = _table_maxn
  73
  74     .const .Sub _table_remove = 'remove'
  75     _table_remove.'setfenv'(_lua__GLOBAL)
  76     set $P1, 'remove'
  77     _table[$P1] = _table_remove
  78
  79     .const .Sub _table_setn = 'setn'
  80     _table_setn.'setfenv'(_lua__GLOBAL)
  81     set $P1, 'setn'
  82     _table[$P1] = _table_setn
  83
  84     .const .Sub _table_sort = 'sort'
  85     _table_sort.'setfenv'(_lua__GLOBAL)
  86     set $P1, 'sort'
  87     _table[$P1] = _table_sort
  88
  89 .end
  90
  91 =item C<table.concat (table [, sep [, i [, j]]])>
  92
  93 Returns C<table[i]..sep..table[i+1] ... sep..table[j]>. The default value for
  94 C<sep> is the empty string, the default for C<i> is 1, and the default for
  95 C<j> is the length of the table. If C<i> is greater than C<j>, returns the
  96 empty string.
  97
  98 Returns C<table[i]..sep..table[i+1] ... sep..table[j]>. The default value for
  99
 100 =cut
 101
 102 .sub 'concat' :anon
 103     .param pmc table :optional
 104     .param pmc sep :optional
 105     .param pmc i :optional
 106     .param pmc j :optional
 107     .param pmc extra :slurpy
 108     .local pmc idx
 109     .local pmc value
 110     .local string res
 111     .local int last
 112     $S2 = lua_optstring(2, sep, '')
 113     lua_checktype(1, table, 'table')
 114     $I3 = lua_optint(3, i, 1)
 115     $I0 = table.'len'()
 116     last = lua_optint(4, j, $I0)
 117     res = ''
 118     new idx, 'LuaNumber'
 119   L1:
 120     unless $I3 <= last goto L2
 121     set idx, $I3
 122     value = table.'rawget'(idx)
 123     $I0 = isa value, 'LuaString'
 124     if $I0 goto L3
 125     $I0 = isa value, 'LuaNumber'
 126     if $I0 goto L3
 127     lua_argerror(1, "table contains non-strings")
 128   L3:
 129     $S0 = value
 130     concat res, $S0
 131     unless $I3 != last goto L4
 132     concat res, $S2
 133   L4:
 134     inc $I3
 135     goto L1
 136   L2:
 137     new $P0, 'LuaString'
 138     set $P0, res
 139     .return ($P0)
 140 .end
 141
 142
 143 =item C<table.foreach (table, f)>
 144
 145 Executes the given C<f> over all elements of C<table>. For each element, C<f>
 146 is called with the index and respective value as arguments. If C<f> returns
 147 a non-B<nil> value, then the loop is broken, and this value is returned as
 148 the final value of C<foreach>.
 149
 150 See the C<next> function for extra information about table traversals.
 151
 152 B<DEPRECATED>
 153
 154 =cut
 155
 156 .sub 'foreach' :anon
 157     .param pmc table :optional
 158     .param pmc f :optional
 159     .param pmc extra :slurpy
 160     .local pmc idx
 161     .local pmc value
 162     .local pmc res
 163     lua_checktype(1, table, 'table')
 164     lua_checktype(2, f, 'function')
 165     new idx, 'LuaNil'
 166   L1:
 167     $P0 = table.'next'(idx)
 168     unless $P0 goto L2
 169     idx = $P0[0]
 170     value = $P0[1]
 171     (res) = f(idx, value)
 172     $I0 = defined res
 173     unless $I0 goto L1
 174     .return (res)
 175   L2:
 176     .return ()
 177 .end
 178
 179
 180 =item C<table.foreachi (table, f)>
 181
 182 Executes the given C<f> over the numerical indices of C<table>. For each
 183 index, C<f> is called with the index and respective value as arguments.
 184 Indices are visited in sequential order, from 1 to C<n>, where C<n> is the
 185 size of the table. If C<f> returns a non-B<nil> value, then the loop is
 186 broken and this value is returned as the result of C<foreachi>.
 187
 188 B<DEPRECATED>
 189
 190 =cut
 191
 192 .sub 'foreachi' :anon
 193     .param pmc table :optional
 194     .param pmc f :optional
 195     .param pmc extra :slurpy
 196     .local pmc idx
 197     .local pmc value
 198     .local pmc res
 199     .local int i
 200     .local int n
 201     lua_checktype(1, table, 'table')
 202     lua_checktype(2, f, 'function')
 203     n = table.'len'()
 204     i = 0
 205     new idx, 'LuaNumber'
 206   L1:
 207     inc i
 208     unless i <= n goto L2
 209     set idx, i
 210     value = table.'rawget'(idx)
 211     (res) = f(idx, value)
 212     $I0 = defined res
 213     unless $I0 goto L1
 214     .return (res)
 215   L2:
 216     .return ()
 217 .end
 218
 219
 220 =item C<table.getn (table)>
 221
 222 Returns the size of a table.
 223
 224 B<DEPRECATED>
 225
 226 =cut
 227
 228 .sub 'getn' :anon
 229     .param pmc table :optional
 230     .param pmc extra :slurpy
 231     .local pmc res
 232     lua_checktype(1, table, 'table')
 233     res = table.'len'()
 234     .return (res)
 235 .end
 236
 237
 238 =item C<table.insert (table, [pos,] value)>
 239
 240 Inserts element C<value> at position C<pos> in C<table>, shifting up other
 241 elements to open space, if necessary. The default value for C<pos> is C<n+1>,
 242 where C<n> is the length of the table, so that a call C<table.insert(t,x)>
 243 inserts C<x> at the end of table C<t>.
 244
 245 =cut
 246
 247 .sub 'insert' :anon
 248     .param pmc table :optional
 249     .param pmc arg2 :optional
 250     .param pmc arg3 :optional
 251     .param pmc extra :slurpy
 252     .local pmc value
 253     .local pmc idx
 254     .local int e
 255     .local int pos
 256     new idx, 'LuaNumber'
 257     lua_checktype(1, table, 'table')
 258     e = table.'len'()
 259     inc e
 260     unless null arg3 goto L1
 261     pos = e
 262     value = arg2
 263     goto L2
 264   L1:
 265     pos = lua_checknumber(2, arg2)
 266     unless pos > e goto L3
 267     e = pos
 268   L3:
 269     value = arg3
 270   L4:
 271     dec e
 272     unless e >= pos goto L2
 273     set idx, e
 274     $P0 = table.'rawget'(idx)
 275     inc idx
 276     table.'rawset'(idx, $P0)
 277     goto L4
 278   L2:
 279     set idx, pos
 280     table.'rawset'(idx, value)
 281 .end
 282
 283
 284 =item C<table.maxn (table)>
 285
 286 Returns the largest positive numerical index of the given table, or zero if
 287 the table has no positive numerical indices. (To do its job this function
 288 does a linear traversal of the whole table.)
 289
 290 =cut
 291
 292 .sub 'maxn' :anon
 293     .param pmc table :optional
 294     .param pmc extra :slurpy
 295     .local pmc idx
 296     .local pmc max
 297     lua_checktype(1, table, 'table')
 298     new max, 'LuaNumber'
 299     set max, 0
 300     new idx, 'LuaNil'
 301   L1:
 302     $P0 = table.'next'(idx)
 303     unless $P0 goto L2
 304     idx = $P0[0]
 305     $I0 = isa idx, 'LuaNumber'
 306     unless $I0 goto L1
 307     unless idx > max goto L1
 308     max = clone idx
 309     goto L1
 310   L2:
 311     .return (max)
 312 .end
 313
 314
 315 =item C<table.remove (table [, pos])>
 316
 317 Removes from C<table> the element at position C<pos>, shifting down other
 318 elements to close the space, if necessary. Returns the value of the removed
 319 element. The default value for C<pos> is C<n>, where C<n> is the length of
 320 the table, so that a call C<table.remove(t)> removes the last element of
 321 table C<t>.
 322
 323 =cut
 324
 325 .sub 'remove' :anon
 326     .param pmc table :optional
 327     .param pmc pos :optional
 328     .param pmc extra :slurpy
 329     .local pmc idx
 330     .local pmc res
 331     .local int e
 332     .local int ipos
 333     lua_checktype(1, table, 'table')
 334     e = table.'len'()
 335     ipos = lua_optint(2, pos, e)
 336     # position is outside bounds?
 337     unless 1 <= ipos goto L1
 338     if ipos <= e goto L2
 339   L1:
 340     # nothing to remove
 341     new res, 'LuaNil'
 342     .return (res)
 343   L2:
 344     new idx, 'LuaNumber'
 345     set idx, ipos
 346     res = table.'rawget'(idx)
 347   L3:
 348     unless ipos < e goto L4
 349     $I2 = ipos + 1
 350     set idx, $I2
 351     $P0 = table.'rawget'(idx)
 352     set idx, ipos
 353     table.'rawset'(idx, $P0)
 354     ipos = $I2
 355     goto L3
 356   L4:
 357     new $P0, 'LuaNil'
 358     set idx, e
 359     table.'rawset'(idx, $P0)
 360     .return (res)
 361 .end
 362
 363 =item C<table.setn (table, n)>
 364
 365 B<OBSOLETE>
 366
 367 =cut
 368
 369 .sub 'setn' :anon
 370     .param pmc table :optional
 371     .param pmc n :optional
 372     .param pmc extra :slurpy
 373     lua_checktype(1, table, 'table')
 374     lua_error("'setn' is obsolete")
 375 .end
 376
 377
 378 =item C<table.sort (table [, comp])>
 379
 380 Sorts table elements in a given order, I<in-place>, from C<table[1]> to
 381 C<table[n]>, where C<n> is the length of the table. If C<comp> is given,
 382 then it must be a function that receives two table elements, and returns
 383 true when the first is less than the second (so that C<not comp(a[i+1],a[i]>)
 384 will be true after the sort). If C<comp> is not given, then the standard Lua
 385 operator C<<> is used instead.
 386
 387 The sort algorithm is I<not> stable; that is, elements considered equal by
 388 the given order may have their relative positions changed by the sort.
 389
 390 =cut
 391
 392 .sub 'sort' :anon
 393     .param pmc table :optional
 394     .param pmc comp :optional
 395     .param pmc extra :slurpy
 396     .local int n
 397     lua_checktype(1, table, 'table')
 398     n = table.'len'()
 399     if null comp goto L1
 400     $I0 = isa comp, 'LuaNil'
 401     if $I0 goto L1
 402     lua_checktype(2, comp, 'function')
 403   L1:
 404     auxsort(table, comp, 1, n)
 405 .end
 406
 407 .sub 'auxsort' :anon
 408     .param pmc table
 409     .param pmc comp
 410     .param int l
 411     .param int u
 412     .local pmc idx1
 413     .local pmc idx2
 414     .local int i
 415     .local int j
 416     .local int tmp
 417     new idx1, 'LuaNumber'
 418     new idx2, 'LuaNumber'
 419   L1:
 420     unless l < u goto L2
 421     # sort elements a[l], a[(l+u)/2] and a[u]
 422     set idx1, l
 423     set idx2, u
 424     $P1 = table.'rawget'(idx1)
 425     $P2 = table.'rawget'(idx2)
 426     $I0 = sort_comp(comp, $P2, $P1) # a[u] < a[l]?
 427     unless $I0 goto L3
 428     # swap a[l] - a[u]
 429     table.'rawset'(idx1, $P2)
 430     table.'rawset'(idx2, $P1)
 431   L3:
 432     tmp = u - l
 433     if tmp == 1 goto L2 # break: only 2 elements
 434     i = l + u
 435     i /= 2
 436     set idx1, i
 437     set idx2, l
 438     $P1 = table.'rawget'(idx1)
 439     $P2 = table.'rawget'(idx2)
 440     $I0 = sort_comp(comp, $P1, $P2) # a[i]<a[l]?
 441     unless $I0 goto L4
 442     table.'rawset'(idx1, $P2)
 443     table.'rawset'(idx2, $P1)
 444     goto L5
 445   L4:
 446     set idx2, u
 447     $P2 = table.'rawget'(idx2)
 448     $I0 = sort_comp(comp, $P2, $P1) # a[u]<a[i]?
 449     unless $I0 goto L5
 450     table.'rawset'(idx1, $P2)
 451     table.'rawset'(idx2, $P1)
 452   L5:
 453     tmp = u - l
 454     if tmp == 2 goto L2 # break: only 3 elements
 455     set idx1, i
 456     $P1 = table.'rawget'(idx1)    # Pivot
 457     tmp = u - 1
 458     set idx2, tmp
 459     $P2 = table.'rawget'(idx2)
 460     table.'rawset'(idx1, $P2)
 461     table.'rawset'(idx2, $P1)
 462     # a[l] <= P == a[u-1] <= a[u], only need to sort from l+1 to u-2 */
 463     i = l
 464     j = u - 1
 465   L6: # invariant: a[l..i] <= P <= a[j..u]
 466     # repeat ++i until a[i] >= P
 467     inc i
 468     set idx2, i
 469     $P2 = table.'rawget'(idx2)
 470     $I0 = sort_comp(comp, $P2, $P1)
 471     unless $I0 goto L7
 472     unless i >= u goto L6
 473     lua_error("invalid order function for sorting")
 474     goto L6
 475   L7:
 476     # repeat --j until a[j] <= P
 477     dec j
 478     set idx1, j
 479     $P3 = table.'rawget'(idx1)
 480     $I0 = sort_comp(comp, $P1, $P3)
 481     unless $I0 goto L8
 482     unless j <= l goto L7
 483     lua_error("invalid order function for sorting")
 484     goto L7
 485   L8:
 486     if j < i goto L9
 487     table.'rawset'(idx2, $P3)
 488     table.'rawset'(idx1, $P2)
 489     goto L6
 490   L9:
 491     tmp = u - 1
 492     set idx1, tmp
 493     set idx2, i
 494     $P1 = table.'rawget'(idx1)
 495     $P2 = table.'rawget'(idx2)
 496     # swap pivot (a[u-1]) with a[i]
 497     table.'rawset'(idx1, $P2)
 498     table.'rawset'(idx2, $P1)
 499     # a[l..i-1] <= a[i] == P <= a[i+1..u]
 500     # adjust so that smaller half is in [j..i] and larger one in [l..u]
 501     tmp += l
 502     unless i < tmp goto L10
 503     j = l
 504     i = i - 1
 505     l = i + 2
 506     goto L11
 507   L10:
 508     j = i + 1
 509     i = u
 510     u = j - 2
 511   L11:
 512     # call recursively the smaller one
 513     auxsort(table, comp, j, i)
 514     # repeat the routine for the larger one
 515     goto L1
 516   L2:
 517 .end
 518
 519 .sub 'sort_comp' :anon
 520     .param pmc comp
 521     .param pmc a
 522     .param pmc b
 523     if null comp goto L1
 524     unless comp goto L1
 525     $P0 = comp(a, b)
 526     $I0 = istrue $P0
 527     .return ($I0)
 528   L1:
 529     $I0 = islt a, b
 530     .return ($I0)
 531 .end
 532
 533 =back
 534
 535 =head1 AUTHORS
 536
 537 Francois Perrad
 538
 539 =cut
 540
 541
 542 # Local Variables:
 543 #   mode: pir
 544 #   fill-column: 100
 545 # End:
 546 # vim: expandtab shiftwidth=4 ft=pir: