← Back to branch summary

~ubuntu-branches/ubuntu/precise/rakudo/precise

« back to all changes in this revision

Viewing changes to src/classes/Array.pir

  • Committer: Bazaar Package Importer
  • Author(s): Ryan Niebur
  • Date: 2009-10-04 14:31:57 UTC
  • Revision ID: james.westby@ubuntu.com-20091004143157-ubq3wu0grk0f1e6a
Tags: upstream-0.1~2009.09
Import upstream version 0.1~2009.09

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/classes/Array.pir
 
1
## $Id$
 
2
 
 
3
=head1 NAME
 
4
 
 
5
src/classes/Array.pir - Perl 6 Array class and related functions
 
6
 
 
7
=cut
 
8
 
 
9
.namespace []
 
10
.sub '' :anon :load :init
 
11
    .local pmc p6meta, arrayproto
 
12
    p6meta = get_hll_global ['Perl6Object'], '$!P6META'
 
13
    arrayproto = p6meta.'new_class'('Perl6Array', 'parent'=>'List', 'name'=>'Array')
 
14
    arrayproto.'!MUTABLE'()
 
15
 
 
16
    $P0 = get_hll_namespace ['Perl6Array']
 
17
    '!EXPORT'('delete,exists,pop,push,shift,unshift', 'from'=>$P0, 'to_p6_multi'=>1)
 
18
.end
 
19
 
 
20
 
 
21
=head2 Methods
 
22
 
 
23
=item delete
 
24
 
 
25
Remove items from an array.
 
26
 
 
27
=cut
 
28
 
 
29
.namespace ['Perl6Array']
 
30
.sub 'delete' :method :multi() :subid('array_delete')
 
31
    .param pmc indices :slurpy
 
32
    .local pmc result
 
33
    result = new ['List']
 
34
    null $P99
 
35
 
 
36
    indices.'!flatten'()
 
37
  indices_loop:
 
38
    unless indices goto indices_end
 
39
    $I0 = shift indices
 
40
    $P0 = self[$I0]
 
41
    push result, $P0
 
42
    self[$I0] = $P99
 
43
 
 
44
  shorten:
 
45
    $I0 = self.'elems'()
 
46
    dec $I0
 
47
  shorten_loop:
 
48
    if $I0 < 0 goto shorten_end
 
49
    $P0 = self[$I0]
 
50
    if null $P0 goto do_shorten
 
51
    $I1 = $P0.'defined'()
 
52
    if $I1 goto shorten_end
 
53
  do_shorten:
 
54
    delete self[$I0]
 
55
    dec $I0
 
56
    goto shorten_loop
 
57
  shorten_end:
 
58
    goto indices_loop
 
59
 
 
60
  indices_end:
 
61
    .return (result)
 
62
.end
 
63
.sub '' :init :load
 
64
    .local pmc block, signature
 
65
    .const 'Sub' $P0 = "array_delete"
 
66
    block = $P0
 
67
    signature = new ["Signature"]
 
68
    setprop block, "$!signature", signature
 
69
    signature."!add_param"("@indices", 1 :named("slurpy"))
 
70
    $P0 = get_hll_global 'Array'
 
71
    signature."!add_implicit_self"($P0)
 
72
.end
 
73
 
 
74
 
 
75
=item exists(indices :slurpy)
 
76
 
 
77
Return true if the elements at C<indices> have been assigned to.
 
78
 
 
79
=cut
 
80
 
 
81
.sub 'exists' :method :multi() :subid('array_exists')
 
82
    .param pmc indices :slurpy
 
83
    .local int test
 
84
 
 
85
    test = 0
 
86
  indices_loop:
 
87
    unless indices goto indices_end
 
88
    $I0 = shift indices
 
89
    test = exists self[$I0]
 
90
    if test goto indices_loop
 
91
  indices_end:
 
92
    .tailcall 'prefix:?'(test)
 
93
.end
 
94
.sub '' :init :load
 
95
    .local pmc block, signature
 
96
    .const 'Sub' $P0 = "array_exists"
 
97
    block = $P0
 
98
    signature = new ["Signature"]
 
99
    setprop block, "$!signature", signature
 
100
    signature."!add_param"("@indices", 1 :named("slurpy"))
 
101
    $P0 = get_hll_global 'Array'
 
102
    signature."!add_implicit_self"($P0)
 
103
.end
 
104
 
 
105
 
 
106
=item item()
 
107
 
 
108
Return Array in item context (i.e., self)
 
109
 
 
110
=cut
 
111
 
 
112
.namespace ['Perl6Array']
 
113
.sub 'item' :method
 
114
    .return (self)
 
115
.end
 
116
 
 
117
 
 
118
=item list
 
119
 
 
120
Return invocant as a List.
 
121
 
 
122
=cut
 
123
 
 
124
.namespace ['Perl6Array']
 
125
.sub '' :method('list')
 
126
    .tailcall self.'values'()
 
127
.end
 
128
 
 
129
 
 
130
=item pop()
 
131
 
 
132
Remove the last item from the array and return it.
 
133
 
 
134
=cut
 
135
 
 
136
.sub 'pop' :method :multi() :subid('array_pop')
 
137
    .local pmc x
 
138
    unless self goto empty
 
139
    x = pop self
 
140
    goto done
 
141
  empty:
 
142
    x = '!FAIL'('Undefined value popped from empty array')
 
143
  done:
 
144
    .return (x)
 
145
.end
 
146
.sub '' :init :load
 
147
    .local pmc block, signature
 
148
    .const 'Sub' $P0 = "array_pop"
 
149
    block = $P0
 
150
    signature = new ["Signature"]
 
151
    setprop block, "$!signature", signature
 
152
    $P0 = get_hll_global 'Array'
 
153
    signature."!add_implicit_self"($P0)
 
154
.end
 
155
 
 
156
 
 
157
=item push(args :slurpy)
 
158
 
 
159
Add C<args> to the end of the Array.
 
160
 
 
161
=cut
 
162
 
 
163
.sub 'push' :method :multi() :subid('array_push')
 
164
    .param pmc args :slurpy
 
165
    .local pmc type, it
 
166
    type = self.'of'()
 
167
    args.'!flatten'()
 
168
    it = iter args
 
169
  it_loop:
 
170
    unless it goto it_loop_end
 
171
    $P0 = shift it
 
172
    $I0 = type.'ACCEPTS'($P0)
 
173
    unless $I0 goto type_error
 
174
    goto it_loop
 
175
  it_loop_end:
 
176
    $I0 = elements self
 
177
    splice self, args, $I0, 0
 
178
    .return (self)
 
179
  type_error:
 
180
    'die'('Type check failure in push')
 
181
.end
 
182
.sub '' :init :load
 
183
    .local pmc block, signature
 
184
    .const 'Sub' $P0 = "array_push"
 
185
    block = $P0
 
186
    signature = new ["Signature"]
 
187
    setprop block, "$!signature", signature
 
188
    signature."!add_param"("@items", 1 :named("slurpy"))
 
189
    $P0 = get_hll_global 'Array'
 
190
    signature."!add_implicit_self"($P0)
 
191
.end
 
192
 
 
193
 
 
194
=item shift()
 
195
 
 
196
Shift the first item off the array and return it.
 
197
 
 
198
=cut
 
199
 
 
200
.sub 'shift' :method :multi() :subid('array_shift')
 
201
    .local pmc x
 
202
    unless self goto empty
 
203
    x = shift self
 
204
    goto done
 
205
  empty:
 
206
    x = '!FAIL'('Undefined value shifted from empty array')
 
207
  done:
 
208
    .return (x)
 
209
.end
 
210
.sub '' :init :load
 
211
    .local pmc block, signature
 
212
    .const 'Sub' $P0 = "array_shift"
 
213
    block = $P0
 
214
    signature = new ["Signature"]
 
215
    setprop block, "$!signature", signature
 
216
    $P0 = get_hll_global 'Array'
 
217
    signature."!add_implicit_self"($P0)
 
218
.end
 
219
 
 
220
 
 
221
=item unshift(args :slurpy)
 
222
 
 
223
Adds C<args> to the beginning of the Array.
 
224
 
 
225
=cut
 
226
 
 
227
.sub 'unshift' :method :multi() :subid('array_unshift')
 
228
    .param pmc args :slurpy
 
229
    .local pmc type, it
 
230
    type = self.'of'()
 
231
    args.'!flatten'()
 
232
    it = iter args
 
233
  it_loop:
 
234
    unless it goto it_loop_end
 
235
    $P0 = shift it
 
236
    $I0 = type.'ACCEPTS'($P0)
 
237
    unless $I0 goto type_error
 
238
    goto it_loop
 
239
  it_loop_end:
 
240
    splice self, args, 0, 0
 
241
    .return (self)
 
242
  type_error:
 
243
    'die'('Type check failure in push')
 
244
.end
 
245
.sub '' :init :load
 
246
    .local pmc block, signature
 
247
    .const 'Sub' $P0 = "array_unshift"
 
248
    block = $P0
 
249
    signature = new ["Signature"]
 
250
    setprop block, "$!signature", signature
 
251
    signature."!add_param"("@items", 1 :named("slurpy"))
 
252
    $P0 = get_hll_global 'Array'
 
253
    signature."!add_implicit_self"($P0)
 
254
.end
 
255
 
 
256
=item values()
 
257
 
 
258
Return Array as a List of its values.
 
259
 
 
260
=cut
 
261
 
 
262
.namespace ['Perl6Array']
 
263
.sub 'values' :method
 
264
    $P0 = new ['List']
 
265
    splice $P0, self, 0, 0
 
266
    .return ($P0)
 
267
.end
 
268
 
 
269
=back
 
270
 
 
271
=head2 Operators
 
272
 
 
273
=over
 
274
 
 
275
=item circumfix:[]
 
276
 
 
277
Create an array.
 
278
 
 
279
=cut
 
280
 
 
281
.namespace []
 
282
.sub 'circumfix:[ ]'
 
283
    .param pmc values          :slurpy
 
284
    .tailcall values.'Scalar'()
 
285
.end
 
286
 
 
287
 
 
288
=back
 
289
 
 
290
=head2 Coercion methods
 
291
 
 
292
=over
 
293
 
 
294
=item Array
 
295
 
 
296
=cut
 
297
 
 
298
.namespace ['Perl6Array']
 
299
.sub 'Array' :method
 
300
    .return (self)
 
301
.end
 
302
 
 
303
 
 
304
=back
 
305
 
 
306
=head2 Private Methods
 
307
 
 
308
=over
 
309
 
 
310
=item !flatten()
 
311
 
 
312
Return self, as Arrays are already flattened.
 
313
 
 
314
=cut
 
315
 
 
316
.namespace ['Perl6Array']
 
317
.sub '!flatten' :method
 
318
    .return (self)
 
319
.end
 
320
 
 
321
=item !STORE()
 
322
 
 
323
Store things into an Array (e.g., upon assignment)
 
324
 
 
325
=cut
 
326
 
 
327
.namespace ['Perl6Array']
 
328
.sub '!STORE' :method
 
329
    .param pmc source
 
330
    .local pmc array, it, type
 
331
    type = self.'of'()
 
332
    ## we create a new array here instead of emptying self in case
 
333
    ## the source argument contains self or elements of self.
 
334
    array = root_new ['parrot';'ResizablePMCArray']
 
335
    source = 'list'(source)
 
336
    it = iter source
 
337
  array_loop:
 
338
    unless it goto array_done
 
339
    $P0 = shift it
 
340
    $I0 = type.'ACCEPTS'($P0)
 
341
    unless $I0 goto type_error
 
342
    $P0 = '!CALLMETHOD'('Scalar',$P0)
 
343
    $P1 = clone $P0
 
344
    .fixup_cloned_sub($P0, $P1)
 
345
    setprop $P1, 'type', type
 
346
    push array, $P1
 
347
    goto array_loop
 
348
  array_done:
 
349
    $I0 = elements self
 
350
    splice self, array, 0, $I0
 
351
    .return (self)
 
352
  type_error:
 
353
    $S0 = '!make_type_fail_message'('Array assignment', $P0, type)
 
354
    'die'($S0)
 
355
.end
 
356
 
 
357
=back
 
358
 
 
359
=cut
 
360
 
 
361
# Local Variables:
 
362
#   mode: pir
 
363
#   fill-column: 100
 
364
# End:
 
365
# vim: expandtab shiftwidth=4 ft=pir: