Author: jonathan
Date: Wed Dec 3 16:55:10 2008
New Revision: 33474
Modified:
trunk/languages/perl6/src/classes/Signature.pir
Log:
[rakudo] First cut of .perl for Signature.
Modified: trunk/languages/perl6/src/classes/Signature.pir
==============================================================================
--- trunk/languages/perl6/src/classes/Signature.pir (original)
+++ trunk/languages/perl6/src/classes/Signature.pir Wed Dec 3 16:55:10 2008
@@ -128,6 +128,101 @@
.return ($P0)
.end
+=item perl
+
+Gets a perl representation of the signature.
+
+=cut
+
+.sub 'perl' :method
+ .local pmc s
+ s = new 'Perl6Str'
+ concat s, ':('
+
+ # Output parameters.
+ .local pmc params, param_iter, cur_param
+ .local int last_was_multi_inv, want_colon, first
+ last_was_multi_inv = 1
+ want_colon = 0
+ first = 1
+ params = self.'params'()
+ param_iter = iter params
+ param_iter_loop:
+ unless param_iter goto param_iter_loop_end
+ cur_param = shift param_iter
+
+ # If it's the first time, no separator.
+ if first goto first_time
+ if want_colon goto emit_colon
+ $P0 = cur_param["multi_invocant"]
+ if $P0 goto emit_comma
+ unless last_was_multi_inv goto emit_comma
+ concat s, ';; '
+ last_was_multi_inv = 0
+ goto separator_done
+ emit_comma:
+ concat s, ', '
+ goto separator_done
+ emit_colon:
+ concat s, ': '
+ goto separator_done
+ first_time:
+ first = 0
+ separator_done:
+
+ # First any nominal type.
+ $P0 = cur_param["type"]
+ if null $P0 goto any_type
+ $P0 = $P0.'perl'()
+ concat s, $P0
+ goto type_done
+ any_type:
+ concat s, "Any"
+ type_done:
+ concat s, " "
+
+ # If it's slurpy, the *.
+ $P0 = cur_param["slurpy"]
+ if null $P0 goto slurpy_done
+ unless $P0 goto slurpy_done
+ concat s, '*'
+ slurpy_done:
+
+ # Now the name.
+ $P0 = cur_param["name"]
+ concat s, $P0
+
+ # If it's optional, the ?.
+ $P0 = cur_param["optional"]
+ if null $P0 goto optional_done
+ unless $P0 goto optional_done
+ concat s, '?'
+ optional_done:
+
+ # Now any constraints.
+ $P0 = cur_param["constraints"]
+ if null $P0 goto constraints_done
+ unless $P0 goto constraints_done
+ concat s, " where "
+ $P0 = $P0.'perl'()
+ concat s, $P0
+ constraints_done:
+
+ goto param_iter_loop
+ param_iter_loop_end:
+
+ # If we just had an invocant, need the colon.
+ unless want_colon goto no_trailing_colon
+ concat s, ':'
+ no_trailing_colon:
+
+ # XXX TODO: Return type, once we support those.
+
+ # Done.
+ concat s, ')'
+ .return (s)
+.end
+
=back
=cut
