[svn:mod_parrot] r468 - mod_parrot/trunk/patches
[email protected] Wed, 22 Oct 2008 11:41:03 -0700 (PDT)
| Newsgroups | perl.cvs.mod_parrot |
|---|---|
| Message-ID | <[email protected]> |
Author: jhorwitz
Date: Wed Oct 22 11:41:01 2008
New Revision: 468
Added:
mod_parrot/trunk/patches/parrot-r32075-modperl6.patch
Removed:
mod_parrot/trunk/patches/parrot-r29231-modperl6.patch
Log:
new patch for parrot
Added: mod_parrot/trunk/patches/parrot-r32075-modperl6.patch
==============================================================================
--- (empty file)
+++ mod_parrot/trunk/patches/parrot-r32075-modperl6.patch Wed Oct 22 11:41:01 2008
@@ -0,0 +1,327 @@
+Index: languages/perl6/src/builtins/misc.pir
+===================================================================
+--- languages/perl6/src/builtins/misc.pir (revision 32075)
++++ languages/perl6/src/builtins/misc.pir (working copy)
+@@ -18,7 +18,19 @@
+ .return($P0)
+ .end
+
++.sub 'resolve_sym'
++ .param string ns
++ .param string name
++ .param pmc args :slurpy
++ .local pmc sym
++ .local pmc nskey
+
++ nskey = split '::', ns
++ sym = get_hll_global nskey, name
++
++ .return(sym)
++.end
++
+ =item term:=<>
+
+ =cut
+Index: languages/perl6/src/parser/actions.pm
+===================================================================
+--- languages/perl6/src/parser/actions.pm (revision 32075)
++++ languages/perl6/src/parser/actions.pm (working copy)
+@@ -829,7 +829,6 @@
+
+ method routine_def($/) {
+ my $past := $( $<block> );
+-
+ if $<identifier> {
+ $past.name( ~$<identifier>[0] );
+ our $?BLOCK;
+@@ -914,7 +913,6 @@
+ }
+ }
+ }
+-
+ make $past;
+ }
+
+@@ -997,6 +995,29 @@
+ PAST::Var.new( :name('self'), :scope('register') )
+ ));
+ }
++
++ # Are we going to take the type of the thing we were passed and bind
++ # it to an abstraction parameter?
++ if $_<parameter><generic_binder> {
++ my $tv_var := $( $_<parameter><generic_binder>[0]<variable> );
++ $params.push(PAST::Op.new(
++ :pasttype('bind'),
++ PAST::Var.new(
++ :name($tv_var.name()),
++ :scope('lexical'),
++ :isdecl(1)
++ ),
++ PAST::Op.new(
++ :pasttype('callmethod'),
++ :name('WHAT'),
++ PAST::Var.new(
++ :name($parameter.name()),
++ :scope('lexical')
++ )
++ )
++ ));
++ $block_past.symbol($tv_var.name(), :scope('lexical'));
++ }
+ }
+
+ # Now start making a descriptor for the signature.
+@@ -1055,9 +1076,11 @@
+ my $cur_param_types := PAST::Stmts.new();
+ if $_<parameter><type_constraint> {
+ for $_<parameter><type_constraint> {
++ my $type_obj;
++
+ # Just a type name?
+- if $_<typename><name><identifier> {
+- my $type_obj := PAST::Op.new(
++ if $_<typename> {
++ $type_obj := PAST::Op.new(
+ :pasttype('call'),
+ :name('!TYPECHECKPARAM'),
+ $( $_<typename> ),
+@@ -1066,29 +1089,13 @@
+ :scope('lexical')
+ )
+ );
+- $cur_param_types.push($type_obj);
+ }
+- # is it a ::Foo type binding?
+- elsif $_<typename> {
+- my $tvname := ~$_<typename><name><morename>[0]<identifier>;
+- $params.push(PAST::Op.new(
+- :pasttype('bind'),
+- PAST::Var.new( :name($tvname), :scope('lexical'), :isdecl(1)),
+- PAST::Op.new(
+- :pasttype('callmethod'),
+- :name('WHAT'),
+- PAST::Var.new(
+- :name($parameter.name()),
+- :scope('lexical')
+- )
+- )
+- ));
+- $block_past.symbol($tvname, :scope('lexical'));
+- }
+ else {
+- my $type_obj := make_anon_subset($( $_<EXPR> ), $parameter);
+- $cur_param_types.push($type_obj);
++ $type_obj := make_anon_subset($( $_<EXPR> ), $parameter);
+ }
++
++ # Add it to the types list.
++ $cur_param_types.push($type_obj);
+ }
+ }
+
+@@ -2599,44 +2606,69 @@
+ my $ns := Perl6::Compiler.parse_name($<name>);
+ my $shortname := $ns.pop();
+
+- # determine type's scope
+- my $scope := '';
+- our @?BLOCK;
+- if +$ns == 0 && @?BLOCK {
+- for @?BLOCK {
+- if defined($_) && !$scope {
+- my $sym := $_.symbol($shortname);
+- if defined($sym) && $sym<scope> { $scope := $sym<scope>; }
+- }
+- }
+- }
+-
+ # Create default PAST node for package lookup of type.
+ my $past := PAST::Var.new(
+ :name($shortname),
+ :namespace($ns),
++ :scope('package'),
+ :node($/),
+- :scope($scope ?? $scope !! 'package'),
+ :viviself('Failure')
+ );
+
++ # If there's no namespace, could be lexical abstraction type.
++ if +@($ns) == 0 {
++ # See if we got lexical with the right name.
++ our @?BLOCK;
++ my $name := '::' ~ $shortname;
++ for @?BLOCK {
++ if defined($_) {
++ my $sym_table := $_.symbol($name);
++ if defined($sym_table) && defined($sym_table<scope>) {
++ $past.name( $name );
++ $past.scope( $sym_table<scope> );
++ }
++ }
++ }
++ }
++
+ make $past;
+ }
+
+
+ method term($/, $key) {
+ my $past;
+- if $key eq 'noarg' {
+- $past := PAST::Op.new( :name( ~$<name> ), :pasttype('call') );
++ if $key eq 'func args' {
++ $past := build_call( $( $<semilist> ) );
++ $past.name( ~$<identifier> );
+ }
+- elsif $key eq 'args' {
+- $past := $($<args>);
+- $past.name( ~$<name> );
+- }
+- elsif $key eq 'func args' {
++ # call sub with an interpolated namespace
++ # right now we only support this exact form: ::($ns)::name()
++ elsif $key eq 'interpolated func args' {
++ my $resolve_past := PAST::Op.new(
++ :name('resolve_sym'),
++ :pasttype('call'),
++ :node($/)
++ );
++ $resolve_past.unshift(PAST::Val.new(
++ :value( ~$<interpolated_name><name><identifier>[0] )
++ ));
++ $resolve_past.unshift(
++ $( $<interpolated_name><interpolated_ident>[0]<EXPR> )
++ );
+ $past := build_call( $( $<semilist> ) );
+- $past.name( ~$<name> );
++ $past.unshift($resolve_past);
++
++ # build_call will set 'name' for us. we reset that to 0 so the
++ # sub call invokes the first PAST argument ($resolve_past) instead
++ $past.name(0);
+ }
++ elsif $key eq 'listop args' {
++ $past := build_call( $( $<arglist> ) );
++ $past.name( ~$<identifier> );
++ }
++ elsif $key eq 'listop noarg' {
++ $past := PAST::Op.new( :name( ~$<identifier> ), :pasttype('call') );
++ }
+ elsif $key eq 'VAR' {
+ $past := PAST::Op.new(
+ :name('!VAR'),
+@@ -2668,7 +2700,6 @@
+ make $past;
+ }
+
+-
+ method semilist($/) {
+ my $past := $<EXPR>
+ ?? $( $<EXPR>[0] )
+Index: languages/perl6/src/parser/grammar.pg
+===================================================================
+--- languages/perl6/src/parser/grammar.pg (revision 32075)
++++ languages/perl6/src/parser/grammar.pg (working copy)
+@@ -555,27 +555,25 @@
+ [
+ | 'VAR(' <variable> ')' {*} #= VAR
+ | <typename> {*} #= typename
+- | <name=named_0ary>
++ | <interpolated_name> <.unsp>? '.'?
++ '(' <semilist> ')' {*} #= interpolated func args
++
++ | <identifier=named_0ary>
+ [
+ | <.unsp>? '.'? '(' <semilist> ')' {*} #= func args
+- | :: {*} #= noarg
++ | :: {*} #= listop noarg
+ ]
+- | <name>
++ | <identifier>
+ [
+- | <args> {*} #= args
+- | :: {*} #= noarg
++ | \s <arglist> {*} #= listop args
++ | <.unsp>? '.'? '(' <semilist> ')' {*} #= func args
++ | :: {*} #= listop noarg
+ ]
+ | <sigil> \s <arglist> {*} #= sigil
+ | '...' {*} #= ...
+ ]
+ }
+
+-
+-token args {
+- | \s <arglist> {*} #= listop args
+- | <.unsp>? '.'? '(' <semilist> ')' {*} #= func args
+-}
+-
+ ## XXX: cheat until we get term:pi, term:rand, term:undef, etc.
+ token named_0ary {
+ | [pi|rand|undef|nothing|time] >>
+@@ -671,10 +669,10 @@
+ }
+
+ token circumfix {
+- | '(' <statementlist> ')' {*} #= ( )
+- | '[' <statementlist> ']' {*} #= [ ]
+- | <?before '{' | <lambda> > <pblock> {*} #= { }
+- | <sigil> '(' <semilist> ')' {*} #= $( )
++ | '(' <statementlist> ')' {*} #= ( )
++ | '[' <statementlist> ']' {*} #= [ ]
++ | <?before '{' | <lambda> > <pblock> {*} #= { }
++ | <sigil=variable_sigil> '(' <semilist> ')' {*} #= $( )
+ }
+
+ token variable {
+@@ -686,21 +684,14 @@
+
+ token sigil { '$' | '@' | '%' | '&' | '@@' }
+
++token variable_sigil { '$' | '@' | '%' }
++
+ token twigil { <[.!^:*+?=]> }
+
+ token name {
+- | <identifier> <morename>*
+- | <morename>+
++ | <identifier> [ '::' <morename=identifier> ]*
+ }
+
+-token morename {
+- '::'
+- [
+- | <identifier>
+- | '(' <EXPR> ')'
+- ]
+-}
+-
+ token value {
+ | <quote> {*} #= quote
+ | <number> {*} #= number
+@@ -796,10 +787,23 @@
+ }
+
+ token typename {
+- <?before <.upper> | '::' > <name>
++ <?before <.upper> > <name>
+ {*}
+ }
+
++token interpolated_name {
++ [ '::' <interpolated_ident> ]+ '::' <name>
++}
++
++token interpolated_ident {
++ <?after '::' > '(' <EXPR> ')'
++}
++
++token name {
++ <identifier> [ '::' <identifier> ]*
++ {*}
++}
++
+ # These regex rules are some way off STD.pm at the moment, but we'll work them
+ # closer to it over time.
+ rule regex_declarator {