From 80fd5c5074f197e96fe326cf94fa384279448c73 Mon Sep 17 00:00:00 2001 From: jnthn Date: Wed, 18 Feb 2009 21:56:57 +0100 Subject: [PATCH] Move a few methods on List and Pair over to the Perl 6 setting. --- build/Makefile.in | 4 +- perl6_s1.pir | 29 ------ src/classes/List.pir | 30 ------ src/classes/Pair.pir | 68 ------------- src/cli.pir | 223 ------------------------------------------- src/setting/List.pm | 12 +++ src/setting/Pair.pm | 47 +++++++++ 7 files changed, 62 insertions(+), 351 deletions(-) delete mode 100644 perl6_s1.pir delete mode 100644 src/cli.pir create mode 100644 src/setting/List.pm create mode 100644 src/setting/Pair.pm diff --git a/build/Makefile.in b/build/Makefile.in index 2a16d433bb7..5a00f3eb27c 100644 --- a/build/Makefile.in +++ b/build/Makefile.in @@ -106,7 +106,9 @@ BUILTINS_PIR = \ src/builtins/traits.pir \ SETTING = \ - src/setting/Whatever.pm + src/setting/List.pm \ + src/setting/Pair.pm \ + src/setting/Whatever.pm \ PMCS = perl6str objectref perl6scalar mutablevar perl6multisub diff --git a/perl6_s1.pir b/perl6_s1.pir deleted file mode 100644 index bedfd620c99..00000000000 --- a/perl6_s1.pir +++ /dev/null @@ -1,29 +0,0 @@ -=head1 TITLE - -perl6_s1.pir - The Rakudo Perl 6 Stage 1 compiler. - -=head2 Description - -This is the base file for the Rakudo Perl 6 Stage 1 compiler. We build this -in order to compile the setting; we then build the main compiler out of this -bundled with the setting. - -=cut - -.loadlib 'perl6_group' -.loadlib 'perl6_ops' -.include 'src/gen_builtins.pir' -.include 'src/cli.pir' -.include 'src/gen_grammar.pir' -.include 'src/parser/expression.pir' -.include 'src/parser/methods.pir' -.include 'src/parser/quote_expression.pir' -.include 'src/gen_actions.pir' -.include 'src/gen_metaop.pir' -.include 'src/gen_junction.pir' - -# Local Variables: -# mode: pir -# fill-column: 100 -# End: -# vim: expandtab shiftwidth=4 ft=pir: diff --git a/src/classes/List.pir b/src/classes/List.pir index 4375e6f80c0..a8ee6345169 100644 --- a/src/classes/List.pir +++ b/src/classes/List.pir @@ -205,36 +205,6 @@ Return the number of elements in the list. .return ($I0) .end -=item perl() - -Returns a Perl representation of a List. - -=cut - -.sub 'perl' :method - .local string result - result = '[' - - .local pmc iter - iter = self.'iterator'() - unless iter goto iter_done - iter_loop: - $P1 = shift iter - if null $P1 goto iter_null - $S1 = $P1.'perl'() - result .= $S1 - goto iter_next - iter_null: - result .= 'undef' - iter_next: - unless iter goto iter_done - result .= ', ' - goto iter_loop - iter_done: - result .= ']' - .return (result) -.end - .namespace ['List'] .sub 'reverse' :method diff --git a/src/classes/Pair.pir b/src/classes/Pair.pir index cec18e325aa..d45d1a69fa9 100644 --- a/src/classes/Pair.pir +++ b/src/classes/Pair.pir @@ -38,52 +38,6 @@ Delegates on to a method call '.:Xkey(Xval)'. .tailcall topic.$S0($P0) .end -=item key - -Gets the key of the pair. - -=cut - -.sub 'key' :method - $P0 = getattribute self, '$!key' - .return ($P0) -.end - -=item kv - -Return key and value as a 2-element List. - -=cut - -.namespace ['Perl6Pair'] -.sub 'kv' :method - $P0 = self.'key'() - $P1 = self.'value'() - .tailcall 'list'($P0, $P1) -.end - - -=item pairs - -=cut - -.sub 'pairs' :method - .tailcall self.'list'() -.end - - -=item value - -Gets the value of the pair. - -=cut - -.sub 'value' :method - $P0 = getattribute self, '$!value' - .return ($P0) -.end - - =item get_string() (vtable method) @@ -123,28 +77,6 @@ the key and value. .return(retv) .end -=item perl - -Returns a Perl code representation of the pair. - -=cut - -.sub perl :method - # Get key and value. - $P0 = self.'key'() - $P1 = self.'value'() - - # Get perl representation - $S0 = $P0.'perl'() - $S1 = $P1.'perl'() - - # build result - .local string result - result = concat $S0, ' => ' - result .= $S1 - .return (result) -.end - .namespace [] diff --git a/src/cli.pir b/src/cli.pir deleted file mode 100644 index 2a4ea4fd178..00000000000 --- a/src/cli.pir +++ /dev/null @@ -1,223 +0,0 @@ -=head1 TITLE - -src/cli.pir - The Rakudo Perl 6 compiler command line interface. - -=head2 Description - -This is the command line front end of the Rakudo Perl 6 compiler. - -=head2 Functions - -=over 4 - -=item onload() - -Creates the Perl 6 compiler by subclassing a C object. - -=cut - -.namespace [ 'Perl6';'Compiler' ] - -.sub 'onload' :load :init :anon - load_bytecode 'PCT.pbc' - - .local pmc p6meta, perl6 - p6meta = get_hll_global ['Perl6Object'], '$!P6META' - perl6 = p6meta.'new_class'('Perl6::Compiler', 'parent'=>'PCT::HLLCompiler') - - load_bytecode 'config.pbc' - - perl6.'language'('Perl6') - perl6.'parsegrammar'('Perl6::Grammar') - perl6.'parseactions'('Perl6::Grammar::Actions') - - ## set the compilation stages in the @stages attribute - $P0 = split ' ', 'parse past check_syntax post pir evalpmc' - setattribute perl6, '@stages', $P0 - - ## set the command line options - $P0 = split ' ', 'c e=s help|h target=s trace|t=s encoding=s output|o=s version|v' - setattribute perl6, '@cmdoptions', $P0 - - ## set the $usage attribute - $P0 = new 'String' - $P0 = <<'USAGE' -Usage: perl6 [switches] [--] [programfile] [arguments] - -c check syntax only (runs BEGIN and CHECK blocks) - -e program one line of program - -h, --help display this help text - --target=[stage] specify compilation stage to emit - -t, --trace=[flags] enable trace flags - --encoding=[mode] specify string encoding mode - -o, --output=[name] specify name of output file - -v, --version display version information -USAGE - setattribute perl6, '$usage', $P0 - - ## set the $version attribute - .local pmc cfg - $P0 = new 'String' - $P0 = 'This is Rakudo Perl 6' - push_eh _handler - - # currently works in the build tree, but not in the install tree - cfg = _config() - $P0 .= ', revision ' - $S0 = cfg['revision'] - $P0 .= $S0 - $P0 .= ' built on parrot ' - $S0 = cfg['VERSION'] - $P0 .= $S0 - $S0 = cfg['DEVEL'] - $P0 .= $S0 - $P0 .= "\n" - $P0 .= 'for ' - $S0 = cfg['archname'] - $P0 .= $S0 - _handler: - pop_eh - $P0 .= ".\n\nCopyright 2006-2008, The Perl Foundation.\n" - setattribute perl6, '$version', $P0 - - ## create a list for holding the stack of nested blocks - $P0 = new ['List'] - set_hll_global ['Perl6';'Grammar';'Actions'], '@?BLOCK', $P0 - - ## create a list for holding the stack of nested package - ## declarators - $P0 = new 'List' - set_hll_global ['Perl6';'Grammar';'Actions'], '@?PKGDECL', $P0 - - ## create a list for holding the stack of nested package - ## namespaces (we store the namespace as a flat, :: - ## separated string for now, for handing to .parse_name) - $P0 = new 'List' - set_hll_global ['Perl6';'Grammar';'Actions'], '@?NS', $P0 - - ## create a (shared) metaclass node - $P0 = get_hll_global ['PAST'], 'Var' - $P0 = $P0.'new'( 'name'=>'metaclass', 'scope'=>'register' ) - set_hll_global ['Perl6';'Grammar';'Actions'], '$?METACLASS', $P0 - - ## create the $?CLASSMAP hash - $P0 = new ['Hash'] - set_hll_global ['Perl6';'Grammar';'Actions'], '%?CLASSMAP', $P0 - - ## create a list of END blocks to be run - $P0 = new 'List' - set_hll_global ['Perl6'], '@?END_BLOCKS', $P0 - - ## tell PAST::Var how to encode Perl6Str and Str values - $P0 = get_hll_global ['PAST';'Compiler'], '%valflags' - $P0['Perl6Str'] = 'e' - $P0['Str'] = 'e' -.end - - -.namespace ['Perl6';'Compiler'] - -=item check_syntax(source [, "option" => value, ...]) - -Check the syntax of C after PAST tree has been built, -to ensure C and C blocks have been executed. - -=cut - -.sub 'check_syntax' :method - .param pmc source - .param pmc adverbs :slurpy :named - - $I0 = adverbs['c'] - if $I0 goto check_syntax - .return () - check_syntax: - ## if we're here, then syntax is OK - say 'syntax OK' - exit 0 -.end - - -=item main(args :slurpy) :main - -Start compilation by passing any command line C -to the Perl 6 compiler. - -=cut - -.sub 'main' :main - .param pmc args_str - - $S0 = args_str[1] - if $S0 != '-le' goto not_harness - exit 0 - not_harness: - - $P0 = compreg 'Perl6' - $P1 = $P0.'command_line'(args_str, 'encoding'=>'utf8', 'transcode'=>'ascii') - - .include 'iterator.pasm' - .local pmc iter - $P0 = get_hll_global ['Perl6'], '@?END_BLOCKS' - iter = new 'Iterator', $P0 - iter = .ITERATE_FROM_END - iter_loop: - unless iter goto iter_end - $P0 = pop iter - $P0() - goto iter_loop - iter_end: -.end - - -.sub 'parse_name' :method - .param string name - ## remove any type parameterization for now - .local string type_param - type_param = '' - $I0 = index name, '[' - if $I0 == -1 goto type_param_done - type_param = substr name, $I0 - name = substr name, 0, $I0 - type_param_done: - ## divide name based on :: - .local pmc list - list = split '::', name - ## move any leading sigil to the last item - .local string sigil - $S0 = list[0] - sigil = substr $S0, 0, 1 - $I0 = index '$@%&', $S1 - if $I0 < 0 goto sigil_done - substr $S0, 0, 1, '' - list[0] = $S0 - $S0 = list[-1] - $S0 = concat sigil, $S0 - list[-1] = $S0 - sigil_done: - ## remove any empty items from the list - $P0 = iter list - list = new 'ResizablePMCArray' - iter_loop: - unless $P0 goto iter_done - $S0 = shift $P0 - unless $S0 goto iter_loop - push list, $S0 - goto iter_loop - iter_done: - if type_param == '' goto no_add_type_param - $S0 = pop list - concat $S0, type_param - push list, $S0 - no_add_type_param: - .return (list) -.end - -=back - -=cut - -# Local Variables: -# mode: pir -# fill-column: 100 -# End: -# vim: expandtab shiftwidth=4 ft=pir: diff --git a/src/setting/List.pm b/src/setting/List.pm new file mode 100644 index 00000000000..9f34eac8e70 --- /dev/null +++ b/src/setting/List.pm @@ -0,0 +1,12 @@ +class List is also { + +=begin item perl() + +Returns a Perl representation of a List. + +=end item + method perl() { + return '[' ~ self.map({ .perl }).join(", ") ~ ']'; + } + +} diff --git a/src/setting/Pair.pm b/src/setting/Pair.pm new file mode 100644 index 00000000000..722949ce115 --- /dev/null +++ b/src/setting/Pair.pm @@ -0,0 +1,47 @@ +class Pair is also { + +=begin item key + +Gets the key of the pair. + +=end item + method key() { + return $!key; + } + +=begin item kv + +Return key and value as a 2-element List. + +=end item + method kv() { + return list(self.key, self.value); + } + + +=begin item pairs + +=end item + method pairs() { + return self.list(); + } + +=begin item value + +Gets the value of the pair. + +=end item + method value() { + return $!value; + } + +=begin item perl + +Returns a Perl code representation of the pair. + +=end item + method perl() { + return self.key.perl ~ ' => ' ~ self.value.perl; + } + +}