Merge branch 'master' of git@github.com:rakudo/rakudo

docs/ChangeLog

@@ -18,13 +18,14 @@ New in 2009-05 release
 + documented build dependencies
 + grep() accepts general matcher, things like @list.grep(Int) work
 + trigonometric functions (sin, cos, ...) now available via 'use Num :Trig'
-+ qx{} quotes now work
++ qx{} quotes now work (except on Windows)
 + hyper-operators on hashes now work (%a >>+<< %b)
 + initial implementation of $foo.@bar
 + refactored wrap and unwrap to work with candidate lists; fixes some bugs
 + refactored/improved callsame and callwith, and added nextsame and nextwith
   (only work for dispatches of the form $foo.@bar and with wrap so far)
 + partial implementation of .^parents and .^methods
++ can initialize attributes in terms of others
 + many other bug fixes
 
 New in 2009-04 release (#16, "Bratislava")

src/builtins/guts.pir

@@ -801,15 +801,21 @@ and C<type>.
     .param int has_itypename   :opt_flag
     .param pmc attr            :slurpy :named
 
-    # twigil handling
+    # twigil handling (for has &!foo, we just get name as !foo)
+    .local int offset
     .local string twigil
-    twigil = substr name, 1, 1
+    offset = 1
+    $S0 = substr name, 0, 1
+    if $S0 != '!' goto offset_done
+    offset = 0
+  offset_done:
+    twigil = substr name, offset, 1
     if twigil == '.' goto twigil_public
     if twigil == '!' goto twigil_done
-    substr name, 1, 0, '!'
+    substr name, offset, 0, '!'
     goto twigil_done
   twigil_public:
-    substr name, 1, 1, '!'
+    substr name, offset, 1, '!'
   twigil_done:
 
     $P0 = metaclass.'attributes'()

src/builtins/op.pir

@@ -528,6 +528,130 @@ attr_error:
     .return (var)
 .end
 
+
+=item !generate_meta_ops
+
+Generates meta-ops for user defined operators.
+
+=cut
+
+.sub '!generate_meta_ops'
+    .param string full_name
+    .param string equiv
+
+    # If op is already generated, defined, we're done.
+    .local string name
+    name = substr full_name, 6
+    $S0 = concat 'infix:R', name
+    $P0 = get_hll_global $S0
+    unless null $P0 goto done
+
+    # Generate all the names we'll need.
+    .local string assignment, reverse, cross, reduce, hyper1, hyper2, hyper3, hyper4
+    .local string hyper1_asc, hyper2_asc, hyper3_asc, hyper4_asc
+    assignment = concat 'infix:', name
+                 concat assignment, '='
+    reverse    = concat 'infix:R', name
+    cross      = concat 'infix:X', name
+    reduce     = concat 'prefix:[', name
+                 concat reduce, ']'
+    hyper1_asc = concat 'infix:<<', name
+                 concat hyper1_asc, '>>'
+    hyper2_asc = concat 'infix:>>', name
+                 concat hyper2_asc, '<<'
+    hyper3_asc = concat 'infix:<<', name
+                 concat hyper3_asc, '<<'
+    hyper4_asc = concat 'infix:>>', name
+                 concat hyper4_asc, '>>'
+    hyper1     = concat unicode:"infix:\u00ab", name
+                 concat hyper1, unicode:"\u00bb"
+    hyper2     = concat unicode:"infix:\u00bb", name
+                 concat hyper2, unicode:"\u00ab"
+    hyper3     = concat unicode:"infix:\u00ab", name
+                 concat hyper3, unicode:"\u00ab"
+    hyper4     = concat unicode:"infix:\u00bb", name
+                 concat hyper4, unicode:"\u00bb"
+
+    # Add all of the tokens.
+    .local pmc optable
+    optable = get_hll_global ['Perl6';'Grammar'], '$optable'
+    optable.'newtok'(assignment, 'equiv'=>'infix::=', 'lvalue'=>1)
+    optable.'newtok'(reduce, 'equiv'=>'infix:=')
+    optable.'newtok'(reverse, 'equiv'=>equiv)
+    optable.'newtok'(cross, 'equiv'=>'infix:X')
+    optable.'newtok'(hyper1, 'equiv'=>equiv)
+    optable.'newtok'(hyper1_asc, 'equiv'=>equiv, 'subname'=>hyper1)
+    optable.'newtok'(hyper2, 'equiv'=>equiv)
+    optable.'newtok'(hyper2_asc, 'equiv'=>equiv, 'subname'=>hyper2)
+    optable.'newtok'(hyper3, 'equiv'=>equiv)
+    optable.'newtok'(hyper3_asc, 'equiv'=>equiv, 'subname'=>hyper3)
+    optable.'newtok'(hyper4, 'equiv'=>equiv)
+    optable.'newtok'(hyper4_asc, 'equiv'=>equiv, 'subname'=>hyper4)
+
+    # Now generate the subs.
+    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_simple', '!ASSIGNMETAOP', name)
+    set_hll_global assignment, $P0
+    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_reduce', name)
+    set_hll_global reduce, $P0
+    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_reverse', full_name)
+    set_hll_global reverse, $P0
+    $P0 = '!FAIL'()
+    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_simple', '!CROSSMETAOP', name, $P0, 0)
+    set_hll_global cross, $P0
+    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_hyper', '!HYPEROP', name, 0, 0)
+    set_hll_global hyper1, $P0
+    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_hyper', '!HYPEROP', name, 1, 1)
+    set_hll_global hyper2, $P0
+    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_hyper', '!HYPEROP', name, 0, 1)
+    set_hll_global hyper3, $P0
+    $P0 = '!generate_meta_op_sub'('!generate_meta_op_helper_hyper', '!HYPEROP', name, 1, 0)
+    set_hll_global hyper4, $P0
+  done:
+.end
+.sub '!generate_meta_op_sub'
+    .param string which_helper
+    .param pmc delegate_to
+    .param pmc args :slurpy
+    .lex '$delegate_to', delegate_to
+    .lex '@args', args
+    $P0 = find_name which_helper
+    $P0 = newclosure $P0
+    .return ($P0)
+.end
+.sub '!generate_meta_op_helper_simple' :outer('!generate_meta_op_sub')
+    .param pmc a
+    .param pmc b
+    $P0 = find_lex '$delegate_to'
+    $S0 = $P0
+    $P0 = find_name $S0
+    $P1 = find_lex '@args'
+    .tailcall $P0($P1 :flat, a, b)
+.end
+.sub '!generate_meta_op_helper_reverse' :outer('!generate_meta_op_sub')
+    .param pmc a
+    .param pmc b
+    $P0 = find_lex '$delegate_to'
+    $S0 = $P0
+    $P0 = find_name $S0
+    .tailcall $P0(b, a)
+.end
+.sub '!generate_meta_op_helper_reduce' :outer('!generate_meta_op_sub')
+    .param pmc args :slurpy
+    $P0 = find_lex '$delegate_to'
+    .tailcall '!REDUCEMETAOP'($P0, 0, args :flat)
+.end
+.sub '!generate_meta_op_helper_hyper' :outer('!generate_meta_op_sub')
+    .param pmc a
+    .param pmc b
+    $P0 = find_lex '$delegate_to'
+    $S0 = $P0
+    $P0 = find_name $S0
+    $P1 = find_lex '@args'
+    $I1 = pop $P1
+    $I0 = pop $P1
+    .tailcall $P0($P1 :flat, a, b, $I0, $I1)
+.end
+
 =back
 
 =cut

src/parser/actions.pm

@@ -1654,7 +1654,11 @@ method scope_declarator($/) {
                 # accessor method for it in the block (class/grammar/role)
                 if $var<twigil> eq '.' {
                     my $method := PAST::Block.new( :blocktype('method') );
-                    $method.name( substr($var.name(), 2) );
+                    if $var<sigil> eq '&' {
+                        $method.name( substr($var.name(), 1) );
+                    } else {
+                        $method.name( substr($var.name(), 2) );
+                    }
                     my $value := PAST::Var.new( :name($var.name()) );
                     my $readtype := trait_readtype( $var<traitlist> ) || 'readonly';
                     if $readtype eq 'CONFLICT' {
@@ -1977,7 +1981,7 @@ method variable($/, $key) {
         }
 
         $var := PAST::Var.new( :name($varname), :node($/) );
-        $var<sigil> := $sigil;
+        $var<sigil> := ~$<sigil>;
         if $twigil { $var<twigil> := $twigil; }
 
         # If namespace qualified or has a '*' twigil, it's a package var.
@@ -3142,6 +3146,18 @@ sub add_optoken($block, $match) {
         );
         $sub();
         $block.loadinit().push($past);
+        if $category eq 'infix' {
+            # For infix operators, we generate the meta-operators too.
+            $past := PAST::Op.new(
+                :name('!generate_meta_ops'), :pasttype('call'),
+                $name, $equiv
+            );
+            $sub := PAST::Compiler.compile( 
+                PAST::Block.new( $past, :hll($?RAKUDO_HLL), :blocktype('declaration') )
+            );
+            $sub();
+            $block.loadinit().push($past);
+        }
     }
     $name;
 }

src/parser/grammar.pg

@@ -602,7 +602,7 @@ token dottyop {
 token methodop {
     [
     | <name>
-    | <?before '$' | '@' > <variable>
+    | <?before '$' | '@' | '&' > <variable>
     | <?before <[ ' " ]> > <quote>
 #       { $<quote> ~~ /\W/ or .panic("Useless use of quotes") }
     ] <.unsp>?

t/spectest.data

@@ -308,6 +308,7 @@ S12-methods/what.t
 S12-subset/multi-dispatch.t
 S12-subset/subtypes.t
 S13-type-casting/methods.t
+S13-overloading/metaoperators.t
 S13-overloading/operators.t
 S14-roles/attributes.t
 S14-roles/basic.t