« back to all changes in this revision
Viewing changes to src/classes/Signature.pir
- browse files at revision 5
- compare with another revision
- download diff
- download tarball
- view history from revision 5
- Committer: Bazaar Package Importer
- Author(s): Ryan Niebur
- Date: 2010-03-29 22:47:34 UTC
- mfrom: (1.1.1 upstream)
- Revision ID: james.westby@ubuntu.com-20100329224734-7bwt61rrhpn6g7m4
Tags: 0.1~2010.01-1
* generate a manpage from docs/running.pod
* update the d/watch file
* New Upstream Version
- update dependencies
* update the d/watch file
* New Upstream Version
- update dependencies
- files added:
- debian/manpages
- src/binder
- files removed:
- src/classes/Complex.pir
- files modified:
- .gitignore
added
removed
src/classes/Signature.pir
6
6
7
7
=head1 DESCRIPTION
8
8
9
This file sets up the Perl 6 C<Signature> class.
10
11
=head1 GUTS
12
13
This class will evolve over time as we understand signatures and how we will
14
expose there insides better. For now, a signature under the hood is just an
15
array of hashes, with each hash being a "descriptor" for something that is
16
bindable. Its keys are as follows.
17
18
* name - string holding the name of the thing we're binding to, if any
19
* type - the class or role type of the parameter; this references the actual
20
type object rather than just naming it, and may well be parametric (but that
21
will have been resolved already)
22
* constraints - any additional "where" refinement types on the parameter;
23
will be a junction of types
24
* invocant - is this the invocant (as in, self for a method, not multi)
25
* multi_invocant - is this an invocant for the purpose of MMD
26
* optional - is this an optional parameter?
27
* slurpy - is this a slurpy parameter?
28
29
Again, this probably isn't definitive either, but it'll get us going.
9
This file sets up the high level Perl 6 C<Signature> class. It wraps around a
10
P6LowLevelSig and provides higher level access to it.
30
11
31
12
=cut
32
13
36
17
load_bytecode 'PCT.pbc'
37
18
.local pmc p6meta
38
19
p6meta = get_hll_global ['Perl6Object'], '$!P6META'
39
p6meta.'new_class'('Signature', 'parent'=>'Any', 'attr'=>'@!params $!default_type')
20
p6meta.'new_class'('Signature', 'parent'=>'Any', 'attr'=>'$!ll_sig')
40
21
.end
41
22
23
42
24
=head2 Methods
43
25
44
26
=over 4
45
27
46
=item !add_param( $varname, *%attr )
47
48
Add the attributes given by C<%attr> as the entry for C<$var> in
49
the Signature.
50
51
=cut
52
53
.sub '!add_param' :method
54
.param string varname
55
.param pmc attr :slurpy :named
56
57
attr['name'] = varname
58
59
# If no multi_invocant value, set it to 1 (meaning it is one).
60
$I0 = exists attr['multi_invocant']
61
if $I0 goto have_mi
62
attr['multi_invocant'] = 1
63
have_mi:
64
65
# Work out any role type that the sigil implies. (Skip for slurpy, though.)
66
$I0 = attr["slurpy"]
67
if $I0 goto sigil_done
68
.local pmc role_type
69
.local string sigil
70
sigil = substr varname, 0, 1
71
if sigil == '$' goto sigil_done
72
if sigil == '@' goto sigil_array
73
if sigil == '%' goto sigil_hash
74
if sigil == ':' goto sigil_done
75
goto sigil_code
76
sigil_array:
77
role_type = get_hll_global 'Positional'
78
goto sigil_done
79
sigil_hash:
80
role_type = get_hll_global 'Associative'
81
goto sigil_done
82
sigil_code:
83
role_type = get_hll_global 'Callable'
84
goto sigil_done
85
sigil_done:
86
87
# Get constraints list, which may have class and role types as well as
88
# subset types. If we have no unique role or class type, they all become
89
# constraints; otherwise, we find the unique type. Finally, we turn the
90
# list of constraints into a junction.
91
.local pmc cur_list, cur_list_iter, constraints, type, test_item
92
constraints = root_new ['parrot';'ResizablePMCArray']
93
type = null
94
cur_list = attr["type"]
95
if null cur_list goto cur_list_loop_end
96
have_type_attr:
97
cur_list = cur_list.'eigenstates'()
98
cur_list_iter = iter cur_list
99
cur_list_loop:
100
unless cur_list_iter goto cur_list_loop_end
101
test_item = shift cur_list_iter
102
$I0 = isa test_item, "Role"
103
if $I0 goto is_type
104
$P0 = getprop "subtype_realtype", test_item
105
if null $P0 goto not_refinement
106
unless null type goto all_constraints
107
type = $P0
108
push constraints, test_item
109
goto cur_list_loop
110
not_refinement:
111
$I0 = isa test_item, "P6protoobject"
112
if $I0 goto is_type
113
push constraints, test_item
114
goto cur_list_loop
115
is_type:
116
unless null type goto all_constraints
117
type = test_item
118
goto cur_list_loop
119
all_constraints:
120
type = null
121
constraints = cur_list
122
cur_list_loop_end:
123
124
# Set parametric type, if any.
125
unless null type goto have_type
126
$I0 = attr['slurpy']
127
if $I0 goto object_type
128
unless null role_type goto simple_role_type
129
type = getattribute self, '$!default_type'
130
unless null type goto done_role_type
131
object_type:
132
type = get_hll_global 'Object'
133
goto done_role_type
134
simple_role_type:
135
type = role_type
136
goto done_role_type
137
have_type:
138
if null role_type goto done_role_type
139
type = role_type.'!select'(type)
140
done_role_type:
141
attr["nom_type"] = type
142
$I0 = elements constraints
143
if $I0 == 0 goto no_constraints
144
$P0 = 'infix:&'(type, constraints :flat)
145
attr["type"] = $P0
146
constraints = 'infix:&'(constraints :flat)
147
goto set_constraints
148
no_constraints:
149
null constraints
150
attr["type"] = type
151
set_constraints:
152
attr["cons_type"] = constraints
153
154
# Add to parameters list.
155
.local pmc params
156
params = self.'params'()
157
push params, attr
158
.end
159
160
161
=item !set_default_param_type
162
163
Sets the default parameter type if none is supplied (since it differs for
164
blocks and routines).
165
166
=cut
167
168
.sub '!set_default_param_type' :method
169
.param pmc type
170
setattribute self, '$!default_type', type
171
.end
172
173
174
=item !add_implicit_self
175
176
Ensures that if there is no explicit invocant, we add one.
177
178
=cut
179
180
.sub '!add_implicit_self' :method
181
.param pmc type :optional
182
unless null type goto have_type
183
type = get_hll_global 'Object'
184
have_type:
185
186
.local pmc params
187
params = self.'params'()
188
$I0 = elements params
189
if $I0 == 0 goto add_implicit_self
190
$P0 = params[0]
191
$I0 = $P0['invocant']
192
if $I0 != 1 goto add_implicit_self
193
.return ()
194
195
add_implicit_self:
196
$P0 = root_new ['parrot';'Hash']
197
$P0['name'] = 'self'
198
$P0['invocant'] = 1
199
$P0['multi_invocant'] = 1
200
$P0['nom_type'] = type
201
unshift params, $P0
202
.end
203
204
205
=item !make_parameters_rw
206
207
Makes all parameters have readtype rw (used to implement e.g. <->).
208
209
=cut
210
211
.sub '!make_parameters_rw' :method
212
.local pmc params, it, param
213
params = self.'params'()
214
it = iter params
215
it_loop:
216
unless it goto it_loop_end
217
param = shift it
218
$P0 = param['readtype']
219
unless null $P0 goto it_loop
220
param['readtype'] = 'rw'
221
goto it_loop
222
it_loop_end:
223
.end
224
225
226
28
=item params
227
29
228
Get the array of parameter describing hashes.
30
Returns a C<List> of C<Parameter> descriptors.
229
31
230
32
=cut
231
33
232
34
.sub 'params' :method
233
$P0 = getattribute self, "@!params"
234
unless null $P0 goto done
235
$P0 = root_new ['parrot';'ResizablePMCArray']
236
setattribute self, "@!params", $P0
237
done:
238
.return ($P0)
239
.end
240
241
=item perl
242
243
Gets a perl representation of the signature.
244
245
=cut
246
247
.sub 'perl' :method
248
.local pmc s
249
s = new ['Str']
250
concat s, ':('
251
252
# Output parameters.
253
.local pmc params, param_iter, cur_param
254
.local int last_was_multi_inv, want_colon, first
255
last_was_multi_inv = 1
256
want_colon = 0
257
first = 1
258
params = self.'params'()
259
param_iter = iter params
260
param_iter_loop:
261
unless param_iter goto param_iter_loop_end
262
cur_param = shift param_iter
263
264
# If it's the first time, no separator.
265
if first goto first_time
266
if want_colon goto emit_colon
267
$P0 = cur_param["multi_invocant"]
268
if $P0 goto emit_comma
269
unless last_was_multi_inv goto emit_comma
270
concat s, ';; '
271
last_was_multi_inv = 0
272
goto separator_done
273
emit_comma:
274
concat s, ', '
275
goto separator_done
276
emit_colon:
277
concat s, ': '
278
goto separator_done
279
first_time:
280
first = 0
281
separator_done:
282
283
# First any nominal type.
284
$P0 = cur_param["nom_type"]
285
if null $P0 goto any_type
286
$I0 = isa $P0, 'Role'
287
unless $I0 goto type_as_is
288
$S0 = cur_param["name"]
289
$S0 = substr $S0, 0, 1
290
if $S0 == '$' goto type_as_is
291
$S1 = $P0.'perl'()
292
$I0 = index $S1, '['
293
inc $I0
294
$I1 = length $S1
295
$I1 -= $I0
296
dec $I1
297
$S1 = substr $S1, $I0, $I1
298
concat s, $S1
299
goto type_done
300
type_as_is:
301
$P0 = $P0.'perl'()
302
if $P0 == 'Positional' goto no_type
303
if $P0 == 'Associative' goto no_type
304
if $P0 == 'Callable' goto no_type
305
concat s, $P0
306
goto type_done
307
any_type:
308
concat s, "Any"
309
type_done:
310
concat s, " "
311
no_type:
312
313
# If it's slurpy, the *.
314
$P0 = cur_param["slurpy"]
315
if null $P0 goto slurpy_done
316
unless $P0 goto slurpy_done
317
concat s, '*'
318
goto named_done
319
slurpy_done:
320
321
# If it's named, the :.
322
$S0 = cur_param['named']
323
if null $S0 goto named_done
324
if $S0 == '' goto named_done
325
concat s, ':'
326
named_done:
327
328
# Now the name.
329
$P0 = cur_param["name"]
330
concat s, $P0
331
332
# If it's optional, the ?.
333
$P0 = cur_param["optional"]
334
if null $P0 goto optional_done
335
unless $P0 goto optional_done
336
concat s, '?'
337
optional_done:
338
339
# Now any constraints.
340
$P0 = cur_param["cons_type"]
341
if null $P0 goto constraints_done
342
unless $P0 goto constraints_done
343
concat s, " where "
344
$P0 = $P0.'perl'()
345
concat s, $P0
346
constraints_done:
347
348
goto param_iter_loop
349
param_iter_loop_end:
350
351
# If we just had an invocant, need the colon.
352
unless want_colon goto no_trailing_colon
353
concat s, ':'
354
no_trailing_colon:
355
356
# Done.
357
concat s, ')'
358
.return (s)
359
.end
360
361
=item !SIGNATURE_BIND
362
363
Analyze the signature of the caller, (re)binding the caller's
364
lexicals as needed and performing type checks.
365
366
=cut
367
368
.namespace []
369
.sub '!SIGNATURE_BIND'
370
.local pmc callersub, callerlex, callersig
371
$P0 = getinterp
372
callersub = $P0['sub';1]
373
callerlex = $P0['lexpad';1]
374
getprop callersig, '$!signature', callersub
375
if null callersig goto end
376
.local pmc params
377
params = getattribute callersig, "@!params"
378
if null params goto end
35
# Create result.
36
.local pmc result
37
result = new 'ResizablePMCArray'
38
39
# Grab low level signature we're wrapping.
40
.local pmc signature
41
signature = getattribute self, '$!ll_sig'
42
signature = descalarref signature
43
44
# And Parameter proto.
45
.local pmc parameter
46
parameter = get_hll_global 'Parameter'
47
48
# Loop over parameters.
379
49
.local int cur_param, count
380
count = elements params
50
count = get_signature_size signature
381
51
cur_param = -1
382
52
param_loop:
383
53
inc cur_param
384
54
unless cur_param < count goto param_done
385
.local pmc param
386
param = params[cur_param]
387
.local string name, sigil
388
name = param['name']
389
if name == 'self' goto param_loop
390
sigil = substr name, 0, 1
391
.local pmc type, optional, orig, var
392
type = param['type']
393
optional = param['optional']
394
orig = callerlex[name]
395
if sigil == '@' goto param_array
396
if sigil == '%' goto param_hash
397
var = '!CALLMETHOD'('Scalar', orig)
398
## typecheck the argument unless it's undef (for optional parameter)
399
if null optional goto not_optional
400
$I0 = defined orig
401
unless $I0 goto param_val_done
402
not_optional:
403
if null type goto param_val_done
404
.lex '$/', $P99
405
$P0 = type.'ACCEPTS'(var)
406
unless $P0 goto err_param_type
407
goto param_val_done
408
param_array:
409
$P0 = type.'ACCEPTS'(orig)
410
unless $P0 goto err_param_type_non_scalar
411
var = descalarref orig
412
var = '!CALLMETHOD'('Array', var)
413
goto param_val_done
414
param_hash:
415
$P0 = type.'ACCEPTS'(orig)
416
unless $P0 goto err_param_type_non_scalar
417
var = descalarref orig
418
var = '!CALLMETHOD'('Hash', var)
419
goto param_val_done
420
param_val_done:
421
## handle readonly/copy traits
422
$S0 = param['readtype']
423
if $S0 == 'rw' goto param_readtype_done
424
if $S0 == 'copy' goto param_readtype_copy
425
ne_addr orig, var, param_readtype_var
426
var = root_new ['parrot';'ObjectRef'], var
427
param_readtype_var:
428
$P0 = get_hll_global ['Bool'], 'True'
429
setprop var, 'readonly', $P0
430
goto param_readtype_done
431
param_readtype_copy:
432
if sigil == '@' goto param_readtype_copy_array
433
if sigil == '%' goto param_readtype_copy_hash
434
var = clone var
435
goto param_readtype_done
436
param_readtype_copy_array:
437
$P0 = new ['Perl6Array']
438
'infix:='($P0, var)
439
var = $P0
440
goto param_readtype_done
441
param_readtype_copy_hash:
442
$P0 = new ['Perl6Hash']
443
'infix:='($P0, var)
444
var = $P0
445
param_readtype_done:
446
## set any type properties
447
setprop var, 'type', type
448
## place the updated variable back into lex
449
callerlex[name] = var
55
56
# Get all curent parameter info.
57
.local pmc nom_type, cons_type, names, type_captures, default, sub_sig
58
.local int flags, optional, invocant, multi_invocant, slurpy, rw, ref, copy, named
59
.local string name
60
get_signature_elem signature, cur_param, name, flags, nom_type, cons_type, names, type_captures, default, sub_sig
61
optional = flags & SIG_ELEM_IS_OPTIONAL
62
invocant = flags & SIG_ELEM_INVOCANT
63
multi_invocant = flags & SIG_ELEM_MULTI_INVOCANT
64
slurpy = flags & SIG_ELEM_SLURPY
65
rw = flags & SIG_ELEM_IS_RW
66
ref = flags & SIG_ELEM_IS_REF
67
copy = flags & SIG_ELEM_IS_COPY
68
69
# Make sure constraints is non-null.
70
unless null cons_type goto have_cons
71
cons_type = get_hll_global ['Bool'], 'True'
72
goto cons_done
73
have_cons:
74
cons_type = 'infix:&'(cons_type :flat)
75
cons_done:
76
77
# Any names?
78
named = 0
79
if null names goto no_names
80
named = 1
81
names = 'list'(names :flat)
82
goto names_done
83
no_names:
84
names = 'list'()
85
$I0 = flags & SIG_ELEM_SLURPY_NAMED
86
unless $I0 goto names_done
87
named = 1
88
names_done:
89
90
# Any type captures?
91
if null type_captures goto no_type_captures
92
type_captures = 'list'(type_captures :flat)
93
goto type_captures_done
94
no_type_captures:
95
type_captures = 'list'()
96
type_captures_done:
97
98
# Make sure default and sub-signature are non-null.
99
unless null default goto default_done
100
default = 'undef'()
101
default_done:
102
unless null sub_sig goto sub_sig_done
103
sub_sig = 'undef'()
104
sub_sig_done:
105
106
# Create parameter instance.
107
$P0 = parameter.'new'('name'=>name, 'type'=>nom_type, 'constraints'=>cons_type, 'optional'=>optional, 'slurpy'=>slurpy, 'invocant'=>invocant, 'multi_invocant'=>multi_invocant, 'rw'=>rw, 'ref'=>ref, 'copy'=>copy, 'named'=>named, 'named_names'=>names, 'type_captures'=>type_captures, 'default'=>default, 'signature'=>sub_sig)
108
push result, $P0
450
109
goto param_loop
451
452
110
param_done:
453
end:
454
455
# In theory we're done now, however we may be doing only a bindability check
456
# for the purposes of MMD. In that case, throw a resumable exception here.
457
$P0 = getprop '$!bind_check_only', callersub
458
if null $P0 goto done
459
die '__BIND_SUCCESSFUL__' # XXX A little fragile...think of something better
460
done:
461
.return ()
462
463
err_param_type_non_scalar:
464
set var, orig
465
err_param_type:
466
# Is it a junctional parameter?
467
$I0 = isa var, 'Junction'
468
unless $I0 goto not_junctional
469
$P0 = '!DISPATCH_JUNCTION_SINGLE'(callersub, callerlex, callersig)
470
'return'($P0)
471
not_junctional:
472
.local string errmsg, callername
473
errmsg = '!make_type_fail_message'('Parameter', orig, type)
474
callername = callersub
475
if callername goto have_callername
476
callername = '<anon>'
477
have_callername:
478
'die'(errmsg, ' for ', name, ' in call to ', callername)
111
112
# Turn into a List.
113
.tailcall 'list'(result :flat)
479
114
.end
480
115
481
482
116
=back
483
117
484
118
=cut
485
119
486
487
120
# Local Variables:
488
121
# mode: pir
489
122
# fill-column: 100
Loggerhead is a web-based interface for Breezy
Version: 2.0.1