Merge branch 'master' into range

build/PARROT_REVISION

@@ -1 +1 @@
-48225
+48341

docs/ChangeLog

@@ -1,4 +1,7 @@
-+ syntactic adverbs on substitutions, e.g. '$x ~~ s:2nd/a/b/' works
+New in 2010.08 release
++ syntactic adverbs on substitutions, rx quotes and m//, e.g. '$x ~~ s:2nd/a/b/'
++ updated ROADMAP
++ speedups for integer operations
 
 New in 2010.07 release
 + support for delegation via 'handles'

docs/ROADMAP

@@ -1,7 +1,7 @@
 Rakudo Roadmap
 --------------
 
-Last updated: 2010-08-04
+Last updated: 2010-08-09
 
 This document identifies the major tasks planned for Rakudo
 development as of August 2010.
@@ -27,6 +27,7 @@ Really important items
 Ought to have items
 2 ****  ports to other virtual machines
 2 ?     'constant' declarator
+2 ?     operator precedence traits (pmichaud)
 2 **    basic Buf implementation (A, masak)
 2 **    regex modifiers (B, moritz, pmichaud)
 2 ***   installation standards (A)

docs/S11-Modules-proposal.pod

@@ -109,7 +109,7 @@ Consider the example "use Foo::Bar:ver<1.2.3>:auth<baz>"
 Rakudo * will look for files matching Foo/Bar.pm and Foo/Bar.*.pm from
 every starting point listed in @*INC.  Rakudo will then open each file
 in turn and partially (how?) parse the content to extract the first :ver
-and :auth values, building a list of the results.  Cacheing will
+and :auth values, building a list of the results.  Caching will
 probably be added soon after the initial implementation works, in order to
 reduce the obvious overheads.
 

docs/compiler_overview.pod

@@ -65,12 +65,12 @@ includes a powerful Perl 6 regex engine.  This gives a streamlined
 compiler framework on which to build a very functional Perl 6
 implementation.
 
-NQP itself is also written in PIR.  It is an important part of the
-Parrot Compiler Toolkit (PCT) and is installed with Parrot.  PCT is a
-standard framework to create and use Parrot based languages.  The source
-code of NQP is in F<../parrot/ext/nqp-rx/> and the resulting compiler is
-F<../parrot_install/bin/parrot-nqp>.  Note, NQP only I<builds> the
-Rakudo compiler, and does not compile or run user programs.
+NQP-rx is a bootstrapped compiler, it is mostly written in NQP-rx.
+The source code of NQP-rx is in a separate repository at
+L<http://github.com/perl6/nqp-rx/>. A compiled version of NQP-rx is shipped
+with parrot in the F<../parrot/ext/nqp-rx/> directory, and the resulting
+compiler is F<../parrot_install/bin/parrot-nqp>.  Note, NQP-rx only
+I<builds> the Rakudo compiler, and does not compile or run user programs.
 
 =head3 Stages
 

docs/guide_to_setting.pod

@@ -40,7 +40,7 @@ especially if they follow these guidelines:
 
 =over
 
-=item Think of lazyness
+=item Think of laziness
 
 At some point in the hopefully not-so-distant future Lists will become
 lazy by default. So you should try to avoid anything that forces eager
@@ -50,7 +50,7 @@ This is bad:
 
     while $i < self.elems { ... }
 
-Better use a C<for> loop, which will respect lazyness
+Better use a C<for> loop, which will respect laziness
 
     for self.list { ...  }
 
@@ -85,7 +85,7 @@ All built-in methods or subroutines should be declared as C<multi>.
 
 If a method doesn't take any arguments, give it an explicit empty
 signature C<()>. That's very different from omitting the signature
-alltogether (which would be an implicit caatch-all signature).
+altogether (which would be an implicit catch-all signature).
 
 =item Use implicit return at the end of routines
 

docs/release_guide.pod

@@ -37,7 +37,7 @@ Dates are based on Parrot's expected release schedule.
 
   2010-08-19   Rakudo #32                      (mathw)
   2010-09-23   Rakudo #33                      -vacant-
-  2010-10-21   Rakudo #34                      -vacant-
+  2010-10-21   Rakudo #34                      (duff)
   2010-11-18   Rakudo #35                      -vacant-
   2010-12-23   Rakudo #36                      -vacant-
 
@@ -221,9 +221,12 @@ L<http://github.com/rakudo/rakudo/downloads>.
 
 =item 13.
 
-Publish the release announcement (from #5) to appropriate
-locations, including rakudo.org, use.perl, perl6-language,
-perl6-announce, perl6-users, perl6-compiler, and others.
+To avoid public confusion with Rakudo Star releases that will 
+follow a few days after each compiler release, we now publish 
+compiler release announcements ONLY to perl6-compiler@perl.org.  
+(We may restart widespread announcements of compiler releases 
+once they are known, or we may begin publishing a single
+announcement for both.)
 
 =item 14.
 

src/Perl6/Actions.pm

@@ -2218,7 +2218,11 @@ method EXPR($/, $key?) {
         return 1;
     }
     elsif $sym eq '~~' {
-        make make_smartmatch($/);
+        make make_smartmatch($/, 0);
+        return 1;
+    }
+    elsif $sym eq '!~~' {
+        make make_smartmatch($/, 1);
         return 1;
     }
     unless $past {
@@ -2311,12 +2315,12 @@ sub make_feed($/) {
     return $result;
 }
 
-sub make_smartmatch($/) {
+sub make_smartmatch($/, $negated) {
     my $lhs := $/[0].ast;
     my $rhs := $/[1].ast;
     my $old_topic_var := $lhs.unique('old_topic');
     my $result_var := $lhs.unique('sm_result');
-    PAST::Op.new(
+    my $past := PAST::Op.new(
         :pasttype('stmts'),
 
         # Stash original $_.
@@ -2350,6 +2354,14 @@ sub make_smartmatch($/) {
         # And finally evaluate to the smart-match result.
         PAST::Var.new( :name($result_var), :scope('lexical') )
     );
+    if $negated {
+        $past := PAST::Op.new(
+            :pasttype('call'),
+            :name('&prefix:<!>'),
+            $past
+        );
+    }
+    $past;
 }
 
 method prefixish($/) {
@@ -2651,23 +2663,43 @@ method typename($/) {
 
 our %SUBST_ALLOWED_ADVERBS;
 our %SHARED_ALLOWED_ADVERBS;
+our %MATCH_ALLOWED_ADVERBS;
 INIT {
     my $mods := 'i ignorecase s sigspace';
     for pir::split__PSS(' ', $mods) {
         %SHARED_ALLOWED_ADVERBS{$_} := 1;
-        %SUBST_ALLOWED_ADVERBS{$_}  := 1;
     }
 
     $mods := 'g global ii samecase x c continue p pos nth th st nd rd';
     for pir::split__PSS(' ', $mods) {
         %SUBST_ALLOWED_ADVERBS{$_} := 1;
     }
+
+    # TODO: add g global ov overlap  once they actually work
+    $mods := 'x c continue p pos nth th st nd rd';
+    for pir::split__PSS(' ', $mods) {
+        %MATCH_ALLOWED_ADVERBS{$_} := 1;
+    }
 }
 
 
 method quotepair($/) {
     unless $*value ~~ PAST::Node {
-        $*value := PAST::Val.new( :value($*value) );
+        if ($*key eq 'c' || $*key eq 'continue'
+        || $*key eq 'p' || $*key eq 'pos') && $*value == 1 {
+            $*value := PAST::Op.new(
+                :node($/),
+                :pasttype<if>,
+                PAST::Var.new(:name('$/'), :scope('lexical')),
+                PAST::Op.new(:pasttype('callmethod'),
+                    PAST::Var.new(:name('$/'), :scope<lexical>),
+                    :name<to>
+                ),
+                PAST::Val.new(:value(0)),
+            );
+        } else {
+            $*value := PAST::Val.new( :value($*value) );
+        }
     }
     $*value.named(~$*key);
     make $*value;
@@ -2739,13 +2771,29 @@ method quote:sym<rx>($/) {
     make block_closure($past, 'Regex', 0);
 }
 method quote:sym<m>($/) {
-    my $past := Regex::P6Regex::Actions::buildsub($<p6regex>.ast);
-    make block_closure($past, 'Regex', 0);
+    $regex := Regex::P6Regex::Actions::buildsub($<p6regex>.ast);
+    my $regex := block_closure($regex, 'Regex', 0);
+
+    my $past := PAST::Op.new(
+        :node($/),
+        :pasttype('callmethod'), :name('match'),
+        PAST::Var.new( :name('$_'), :scope('lexical') ),
+        $regex
+    );
+    self.handle_and_check_adverbs($/, %MATCH_ALLOWED_ADVERBS, 'm', $past);
+    $past := PAST::Op.new(
+        :node($/),
+        :pasttype('call'), :name('&infix:<:=>'),
+        PAST::Var.new(:name('$/'), :scope('lexical')),
+        $past
+    );
+
+    make $past;
 }
 
 method handle_and_check_adverbs($/, %adverbs, $what, $past?) {
     for $<quotepair> {
-        unless %adverbs{$_.ast.named} {
+        unless %SHARED_ALLOWED_ADVERBS{$_.ast.named} || %adverbs{$_.ast.named} {
             $/.CURSOR.panic("Adverb '" ~ $_.ast.named ~ "' not allowed on " ~ $what);
         }
         if $past {

src/Perl6/Grammar.pm

@@ -1428,10 +1428,15 @@ token quote:sym<rx>   {
 }
 token quote:sym<m> {
     <sym> >>
+    [ <quotepair> <.ws> ]*
+    :my @*REGEX_ADVERBS;
+    { @*REGEX_ADVERBS := $<quotepair>; }
+    <.setup_quotepairs>
     [
     | '/'<p6regex=.LANG('Regex','nibbler')>'/' <.old_rx_mods>?
     | '{'<p6regex=.LANG('Regex','nibbler')>'}'
     ]
+    <.cleanup_modifiers>
 }
 
 token setup_quotepairs { '' }
@@ -1837,6 +1842,7 @@ token infix:sym<eqv>  { <sym>  <O('%chaining')> }
 token infix:sym<before>  { <sym>  <O('%chaining')> }
 token infix:sym<after>  { <sym>  <O('%chaining')> }
 token infix:sym<~~>   { <sym>  <O('%chaining')> <!dumbsmart> }
+token infix:sym<!~~>  { <sym>  <O('%chaining')> <!dumbsmart> }
 
 token dumbsmart {
     | <?before \h* 'Bool::'? 'True' »>  <.panic("Smartmatch against True always matches; if you mean to test the topic for truthiness, use :so or *.so or ?* instead")>

src/binder/bind.c

@@ -17,6 +17,8 @@ static INTVAL lls_id            = 0;
 static INTVAL p6s_id            = 0;
 static STRING *ACCEPTS          = NULL;
 static STRING *HOW              = NULL;
+static STRING *LIST_str         = NULL;
+static STRING *ARRAY_str        = NULL;
 static STRING *HASH_str         = NULL;
 static STRING *SELECT_str       = NULL;
 static STRING *PUN_str          = NULL;
@@ -38,6 +40,8 @@ static void setup_binder_statics(PARROT_INTERP) {
 
     ACCEPTS          = Parrot_str_new_constant(interp, "ACCEPTS");
     HOW              = Parrot_str_new_constant(interp, "HOW");
+    LIST_str         = Parrot_str_new_constant(interp, "List");
+    ARRAY_str        = Parrot_str_new_constant(interp, "Array");
     HASH_str         = Parrot_str_new_constant(interp, "Hash");
     SELECT_str       = Parrot_str_new_constant(interp, "!select");
     PUN_str          = Parrot_str_new_constant(interp, "!pun");
@@ -61,10 +65,10 @@ descalarref(PARROT_INTERP, PMC *ref) {
 
 /* Creates a Perl 6 Array. */
 static PMC *
-Rakudo_binding_create_array(PARROT_INTERP, PMC *rest) {
+Rakudo_binding_create_positional(PARROT_INTERP, PMC *rest, STRING *type_str) {
     static PMC *truepmc = NULL;
     PMC *hll_ns    = Parrot_get_ctx_HLL_namespace(interp);
-    PMC *arr_ns    = Parrot_ns_get_namespace_keyed_str(interp, hll_ns, string_from_literal(interp, "Array"));
+    PMC *arr_ns    = Parrot_ns_get_namespace_keyed_str(interp, hll_ns, type_str);
     PMC *arr_class = VTABLE_get_class(interp, arr_ns);
     PMC *result    = VTABLE_instantiate(interp, arr_class, PMCNULL);
     INTVAL type_id = pmc_type(interp, string_from_literal(interp, "P6opaque"));
@@ -306,7 +310,7 @@ Rakudo_binding_bind_one_param(PARROT_INTERP, PMC *lexpad, llsig_element *sig_inf
                 PMC *copy, *ref, *store_meth;
                 if (sig_info->flags & SIG_ELEM_ARRAY_SIGIL) {
                     STRING *STORE = string_from_literal(interp, "!STORE");
-                    copy          = Rakudo_binding_create_array(interp, PMCNULL);
+                    copy          = Rakudo_binding_create_positional(interp, PMCNULL, ARRAY_str);
                     store_meth    = VTABLE_find_method(interp, copy, STORE);
                     Parrot_ext_call(interp, store_meth, "PiP", copy, value);
                 }
@@ -448,7 +452,7 @@ Rakudo_binding_handle_optional(PARROT_INTERP, llsig_element *sig_info, PMC *lexp
     /* Otherwise, go by sigil to pick the correct default type of value. */
     else {
         if (sig_info->flags & SIG_ELEM_ARRAY_SIGIL) {
-            return Rakudo_binding_create_array(interp, PMCNULL);
+            return Rakudo_binding_create_positional(interp, PMCNULL, ARRAY_str);
         }
         else if (sig_info->flags & SIG_ELEM_HASH_SIGIL) {
             return Rakudo_binding_create_hash(interp, pmc_new(interp, enum_class_Hash));
@@ -662,7 +666,7 @@ Rakudo_binding_bind_llsig(PARROT_INTERP, PMC *lexpad, PMC *llsig,
                     cur_pos_arg++;
                 }
                 bind_fail = Rakudo_binding_bind_one_param(interp, lexpad, elements[i],
-                        Rakudo_binding_create_array(interp, temp), no_nom_type_check, error);
+                        Rakudo_binding_create_positional(interp, temp, ARRAY_str), no_nom_type_check, error);
                 if (bind_fail) {
                     if (pos_from_named)
                         mem_sys_free(pos_from_named);
@@ -767,7 +771,7 @@ Rakudo_binding_bind_llsig(PARROT_INTERP, PMC *lexpad, PMC *llsig,
     if (cur_pos_arg < num_pos_args && !suppress_arity_fail) {
         /* Oh noes, too many positionals passed. */
         if (error)
-            *error = *error = Rakudo_binding_arity_fail(interp, elements, num_elements, num_pos_args, 1);
+            *error = Rakudo_binding_arity_fail(interp, elements, num_elements, num_pos_args, 1);
         return BIND_RESULT_FAIL;
     }
     if (!PMC_IS_NULL(named_args_copy) && VTABLE_elements(interp, named_args_copy)) {

src/builtins/Cursor.pir

@@ -25,7 +25,9 @@ Cursor - Perl 6 cursor objects
 .end
 
 .sub 'new_array' :method
-    $P0 = new ['Array']
+    $P0 = get_hll_global 'Array'
+    $P0 = $P0.'new'()
+    $P0 = $P0.'item'()
     .return ($P0)
 .end
 

src/core/Cool-str.pm

@@ -58,7 +58,7 @@ augment class Cool {
         }
     }
 
-    multi method samecase($pattern) is export {
+    multi method samecase(Cool $pattern) is export {
         my $result = '';
         my $p = '';
         my @pattern = $pattern.comb;
@@ -303,8 +303,13 @@ augment class Cool {
                 } else {
                     if $m.to == $m.from {
                         %opts<c> = $m.to + 1;
+                        if $p.defined {
+                            warn "multiple matches with :p terminated by zero-width match\n";
+                            last;
+                        }
                     } else {
                         %opts<c> = $m.to;
+                        %opts<p> = $m.to if $p.defined;
                     }
                 }