1# Copyright (C) 2007-2012, Parrot Foundation.
2
3=head1 DESCRIPTION
4
5Based on the Range object described in S03:
6L<http://design.perl6.org/S03.html#Range_semantics>
7
8=cut
9
10.HLL 'parrot'
11.namespace [ 'Range' ]
12
13=head1 macros
14
15=cut
16
17.macro exhausted_check()
18  .local pmc exhausted_check
19  exhausted_check = getattribute self, 'exhausted'
20  unless exhausted_check goto .$more
21  .local pmc exception
22  exception = new 'Exception'
23  exception[0] = 'Exhausted Range'
24  throw exception
25.label $more:
26.endm
27
28.macro exhausted()
29  .local pmc exhausted
30  exhausted = new 'Boolean'
31  exhausted = 1
32  setattribute self, 'exhausted', exhausted
33.endm
34
35=head1 :load
36
37Create the class, with attributes, when this PBC is loaded.
38
39=cut
40
41.sub class_init :anon :load
42
43  $P1 = newclass 'Range'
44
45  addattribute $P1, 'from'
46  addattribute $P1, 'to'
47  addattribute $P1, 'by'
48  addattribute $P1, 'exhausted'
49.end
50
51=head1 :vtable
52
53=head2 init
54
55Set some defaults for our attributes.
56
57=cut
58
59.sub 'init' :vtable :method
60  $P1 = new 'Integer'
61  $P1 = 1
62  setattribute self, 'by', $P1
63  $P1 = new 'Boolean'
64  $P1 = 0
65  setattribute self, 'exhausted', $P1
66.end
67
68=head1 :method
69
70=head2 get_from
71
72Return the from attribute
73
74=cut
75
76.sub get_from :method
77  .local pmc from
78  from = getattribute self, 'from'
79  .return (from)
80.end
81
82=head2 get_to
83
84Return the to attribute
85
86=cut
87
88.sub get_to :method
89  .local pmc to
90  to = getattribute self, 'to'
91  .return (to)
92.end
93
94=head2 get_min
95
96Return the min attribute
97
98=cut
99
100.sub get_min :method
101  .local pmc from, to
102  from = getattribute self, 'from'
103  to   = getattribute self, 'to'
104  if from < to goto use_from
105  .return (to)
106use_from:
107  .return (from)
108.end
109
110=head2 get_max
111
112Return the max attribute
113
114=cut
115
116.sub get_max :method
117  .local pmc from, to
118  from = getattribute self, 'from'
119  to   = getattribute self, 'to'
120  if from > to goto use_from
121  .return (to)
122use_from:
123  .return (from)
124.end
125
126=head2 get_minmax
127
128Return the min and max attributes as a 2 element list.
129
130=cut
131
132.sub get_minmax :method
133  $P1 = new 'ResizablePMCArray'
134  $P1 = 2
135  .local pmc min, max
136  min = self.'get_min'()
137  max = self.'get_max'()
138  $P1[0] = min
139  $P1[1] = max
140  .return ($P1)
141.end
142
143=head2 shift
144
145shift a value off the "front" of the range.
146
147Throw an exception if we're out of values.
148
149=cut
150
151.sub 'shift' :vtable('shift_pmc') :method
152  .exhausted_check()
153
154  .local pmc from, to, by
155  from = getattribute self, 'from'
156  to   = getattribute self, 'to'
157  by   = getattribute self, 'by'
158
159  $P0 = clone from
160  $P0 += by
161  setattribute self, 'from', $P0
162
163  if by < 0 goto neg
164  if $P0 <= to goto done
165  goto exhaust
166neg:
167  if $P0 >= to goto done
168exhaust:
169  .exhausted()
170done:
171  .return (from)
172.end
173
174# Wrappers for the shift_pmc vtable - rely on autoboxing.
175.sub 'shift_integer' :vtable :method
176  $P0 = shift self
177  .return ($P0)
178.end
179
180.sub 'shift_float' :vtable :method
181  $P0 = shift self
182  .return ($P0)
183.end
184
185.sub 'shift_string' :vtable :method
186  $P0 = shift self
187  .return ($P0)
188.end
189
190=head2 pop
191
192pop a value off the "end" of the range.
193
194Throw an exception if we're out of values.
195
196=cut
197
198.sub 'pop' :vtable('pop_pmc') :method
199  .exhausted_check()
200  # can we pull a number off the end?
201  # return it.
202
203  .local pmc from, to, by
204  from = getattribute self, 'from'
205  to   = getattribute self, 'to'
206  by   = getattribute self, 'by'
207  $P0 = clone to
208  $P0 -= by
209  setattribute self, 'to', $P0
210
211  if by < 0 goto neg
212  if $P0 >= from goto done
213  goto exhaust
214neg:
215  if $P0 <= from goto done
216exhaust:
217  .exhausted()
218done:
219  .return (to)
220.end
221
222# Wrappers for the shift_pmc vtable - rely on autoboxing.
223.sub 'pop_integer' :vtable :method
224  $P0 = pop self
225  .return ($P0)
226.end
227
228.sub 'pop_float' :vtable :method
229  $P0 = pop self
230  .return ($P0)
231.end
232
233.sub 'pop_string' :vtable :method
234  $P0 = pop self
235  .return ($P0)
236.end
237
238
239=head2 reverse
240
241Reverse the direction of the range.
242
243=cut
244
245.sub reverse :method
246  .local pmc from, to, by
247  from = getattribute self, 'from'
248  to   = getattribute self, 'to'
249  setattribute self, 'from', to
250  setattribute self, 'to',   from
251
252  by = getattribute self, 'by'
253  by = neg by
254  setattribute self, 'by', by
255  .return(self)
256.end
257
258# Local Variables:
259#   mode: pir
260#   fill-column: 100
261# End:
262# vim: expandtab shiftwidth=4 ft=pir:
263