Merge branch 'nom' of github.com:rakudo/rakudo into nom

Conflicts:
	src/Perl6/Actions.pm

LHF.markdown

@@ -7,6 +7,3 @@ you commit; maybe announce on #perl6 that you're working on it too.
 Note - do not just copy stuff from the master setting! Often things
 need to be done differently in the "nom" branch, to take advantage of
 new possible performance.
-
-## Complex
-Add the Complex class and associated operators, very much like in master

src/Perl6/Actions.pm

@@ -1583,6 +1583,9 @@ class Perl6::Actions is HLL::Actions {
         %*PARAM_INFO<is_parcel>    := $quant eq '\\';
         %*PARAM_INFO<is_capture>   := $quant eq '|';
 
+        # Stash any traits.
+        %*PARAM_INFO<traits> := $<trait>;
+
         # Result is the parameter info hash.
         make %*PARAM_INFO;
     }
@@ -1737,6 +1740,7 @@ class Perl6::Actions is HLL::Actions {
     sub create_signature_object(@parameter_infos, $lexpad) {
         my @parameters;
         for @parameter_infos {
+            # Add variable as needed.
             if $_<variable_name> {
                 my %sym := $lexpad.symbol($_<variable_name>);
                 if +%sym {
@@ -1745,7 +1749,15 @@ class Perl6::Actions is HLL::Actions {
                     $lexpad.symbol($_<variable_name>, :descriptor($_<container_descriptor>));
                 }
             }
-            @parameters.push($*ST.create_parameter($_));
+
+            # Create parameter object and apply any traits.
+            my $param_obj := $*ST.create_parameter($_);
+            for $_<traits> {
+                ($_.ast)($param_obj) if $_.ast;
+            }
+
+            # Add it to the signature.
+            @parameters.push($param_obj);
         }
         $*ST.create_signature(@parameters)
     }
@@ -2090,7 +2102,7 @@ class Perl6::Actions is HLL::Actions {
             $is_hash := 1;
         }
         elsif $stmts == 1 {
-            my $elem := $past[1][0][0];
+            my $elem := $past<past_block>[1][0][0];
             if $elem ~~ PAST::Op && $elem.name eq '&infix:<,>' {
                 # block contains a list, so test the first element
                 $elem := $elem[0];
@@ -2925,10 +2937,7 @@ class Perl6::Actions is HLL::Actions {
         # We tell Parrot that we'll have all args in the call_sig so it won't
         # do its own arg processing. We also add a call to bind the signature.
         $block[0].push(PAST::Var.new( :name('call_sig'), :scope('parameter'), :call_sig(1) ));
-        $block[0].push(PAST::Op.new(
-            :pirop('bind_signature vP'),
-            $*ST.get_object_sc_ref_past($sig_obj)
-        ));
+        $block[0].push(PAST::Op.new( :pirop('bind_signature vP') ));
 
         $block;
     }

src/Perl6/Metamodel/BOOTSTRAP.pm

@@ -250,10 +250,26 @@ Parameter.HOW.add_method(Parameter, 'instantiate_generic', sub ($self, $type_env
         # Clone with the type instantiated.
         my $ins  := pir::repr_clone__PP($self);
         my $type := pir::getattribute__PPPs($self, Parameter, '$!nominal_type');
-        pir::setattribute__0PPsP($self, Parameter, '$!nominal_type',
+        pir::setattribute__0PPsP($ins, Parameter, '$!nominal_type',
             $type.HOW.instantiate_generic($type, $type_environment))
     });
-
+my $SIG_ELEM_IS_RW   := 256;
+my $SIG_ELEM_IS_COPY := 512;
+Parameter.HOW.add_method(Parameter, 'set_rw', sub ($self) {
+        my $dcself := pir::perl6_decontainerize__PP($self);
+        my $cd     := pir::getattribute__PPPs($dcself, Parameter, '$!container_descriptor');
+        if $cd { $cd.set_rw(1) }
+        pir::repr_bind_attr_int__0PPsI($dcself, Parameter, '$!flags',
+            pir::repr_get_attr_int__IPPs($dcself, Parameter, '$!flags') + $SIG_ELEM_IS_RW);
+    });
+Parameter.HOW.add_method(Parameter, 'set_copy', sub ($self) {
+        my $dcself := pir::perl6_decontainerize__PP($self);
+        my $cd     := pir::getattribute__PPPs($dcself, Parameter, '$!container_descriptor');
+        if $cd { $cd.set_rw(1) }
+        pir::repr_bind_attr_int__0PPsI($dcself, Parameter, '$!flags',
+            pir::repr_get_attr_int__IPPs($dcself, Parameter, '$!flags') + $SIG_ELEM_IS_COPY);
+    });
+
 # class Code is Cool {
 #     has $!do;                # Low level code object
 #     has $!signature;         # Signature object
@@ -285,23 +301,23 @@ Code.HOW.add_method(Code, 'add_dispatchee', sub ($self, $dispatchee) {
     });
 Code.HOW.add_method(Code, 'clone', sub ($self) {
         my $cloned := pir::repr_clone__PP($self);
-        pir::setattribute__0PPSP($cloned, Code, '$!do',
-            pir::perl6_associate_sub_code_object__0PP(
-                pir::clone__PP(pir::getattribute__PPPS($self, Code, '$!do')),
-                $cloned))
-    });
-Code.HOW.add_method(Code, 'derive_dispatcher', sub ($self) {
-        my $clone := $self.clone();
         Q:PIR {
             $P0 = find_lex '$self'
             $P1 = find_lex 'Code'
             $P0 = getattribute $P0, $P1, '$!do'
             $P1 = getprop 'CLONE_CALLBACK', $P0
             if null $P1 goto no_callback
-            $P2 = find_lex '$clone'
+            $P2 = find_lex '$cloned'
             $P1($P0, $P2)
           no_callback:
         };
+        pir::setattribute__0PPSP($cloned, Code, '$!do',
+            pir::perl6_associate_sub_code_object__0PP(
+                pir::clone__PP(pir::getattribute__PPPS($self, Code, '$!do')),
+                $cloned))
+    });
+Code.HOW.add_method(Code, 'derive_dispatcher', sub ($self) {
+        my $clone := $self.clone();
         pir::setattribute__0PPSP($clone, Code, '$!dispatchees',
             pir::clone__PP(pir::getattribute__PPPS($self, Code, '$!dispatchees')))
     });
@@ -313,7 +329,7 @@ Code.HOW.add_method(Code, 'instantiate_generic', sub ($self, $type_environment)
         # Clone the code object, then instantiate the generic signature.
         my $ins := $self.clone();
         my $sig := pir::getattribute__PPPs($self, Code, '$!signature');
-        pir::setattribute__0PPsP($self, Code, '$!signature',
+        pir::setattribute__0PPsP($ins, Code, '$!signature',
             $sig.instantiate_generic($type_environment))
     });
 Code.HOW.add_method(Code, 'name', sub ($self) {

src/Perl6/Metamodel/MultiMethodContainer.pm

@@ -1,4 +1,12 @@
 role Perl6::Metamodel::MultiMethodContainer {
+    # Represents a multi candidate to incorporate.
+    my class MultiToIncorporate {
+        has $!name;
+        has $!code;
+        method name() { $!name }
+        method code() { $!code }
+    }
+
     # Set of multi-methods to incorporate. Not just the method handles;
     # each is a hash containing keys name and body.
     has @!multi_methods_to_incorporate;
@@ -8,22 +16,25 @@ role Perl6::Metamodel::MultiMethodContainer {
     # generate a proto and so forth. So just queue them up in a todo list and
     # we handle it at class composition time.
     method add_multi_method($obj, $name, $code_obj) {
-        my %todo;
-        %todo<name> := $name;
-        %todo<code> := $code_obj;
-        @!multi_methods_to_incorporate[+@!multi_methods_to_incorporate] := %todo;
+        my $todo := MultiToIncorporate.new( :name($name), :code($code_obj) );
+        @!multi_methods_to_incorporate[+@!multi_methods_to_incorporate] := $todo;
         $code_obj;
     }
 
+    # Gets the multi methods that are to be incorporated.
+    method multi_methods_to_incorporate($obj) {
+        @!multi_methods_to_incorporate
+    }
+
     # Incorporates the multi candidates into the appropriate proto. Need to
     # implement proto incorporation yet.
     method incorporate_multi_candidates($obj) {
         my $num_todo := +@!multi_methods_to_incorporate;
         my $i := 0;
         while $i != $num_todo {
             # Get method name and code.
-            my $name := @!multi_methods_to_incorporate[$i]<name>;
-            my $code := @!multi_methods_to_incorporate[$i]<code>;
+            my $name := @!multi_methods_to_incorporate[$i].name;
+            my $code := @!multi_methods_to_incorporate[$i].code;
 
             # Do we have anything in the methods table already in
             # this class?

src/Perl6/Metamodel/ParametricRoleHOW.pm

@@ -63,6 +63,9 @@ class Perl6::Metamodel::ParametricRoleHOW
         for self.methods($obj, :local(1)) {
             $conc.HOW.add_method($conc, $_.name, $_.instantiate_generic($type_env))
         }
+        for self.multi_methods_to_incorporate($obj) {
+            $conc.HOW.add_multi_method($conc, $_.name, $_.code.instantiate_generic($type_env))
+        }
 
         # Roles down by this role need fully specializing also; all
         # they'll be missing is the target class (e.g. our first arg).

src/Perl6/Metamodel/RoleToClassApplier.pm

@@ -52,6 +52,13 @@ my class RoleToClassApplier {
                 $target.HOW.add_method($target, $_.name, $_);
             }
         }
+
+        # Compose in any multi-methods; conflicts can be caught by
+        # the multi-dispatcher later.
+        my @multis := $to_compose_meta.multi_methods_to_incorporate($to_compose);
+        for @multis {
+            $target.HOW.add_multi_method($target, $_.name, $_.code);
+        }
 
         # Compose in any role attributes.
         my @attributes := $to_compose_meta.attributes($to_compose, :local(1));

src/Perl6/Metamodel/RoleToRoleApplier.pm

@@ -1 +1 @@
-my class RoleToRoleApplier {    method apply($target, @roles) {        # Aggregate all of the methods sharing names, eliminating        # any duplicates (a method can't collide with itself).        my %meth_info;        my %meth_providers;        for @roles {            my $role := $_;            my @methods := $_.HOW.methods($_, :local(1));            for @methods {                my $name := $_.name;                my $meth := $_;                my @meth_list;                my @meth_providers;                if pir::exists(%meth_info, $name) {                    @meth_list := %meth_info{$name};                    @meth_providers := %meth_providers{$name};                }                else {                    %meth_info{$name} := @meth_list;                    %meth_providers{$name} := @meth_providers;                }                my $found := 0;                for @meth_list {                    if $meth =:= $_ {                        $found := 1;                    }                }                unless $found {                    @meth_list.push($meth);                    @meth_providers.push($role.HOW.name($role));                }            }        }        # Also need methods of target.        my %target_meth_info;        my @target_meths := $target.HOW.methods($target, :local(1));        for @target_meths {            %target_meth_info{$_.name} := $_;        }        # Process method list.        for %meth_info {            my $name := $_.key;            my @add_meths := %meth_info{$name};            # Do we already have a method of this name? If so, ignore all of the            # methods we have from elsewhere.            unless pir::exists(%target_meth_info, $name) {                # No methods in the target role. If only one, it's easy...                if +@add_meths == 1 {                    $target.HOW.add_method($target, $name, @add_meths[0]);                }                else {                    # More than one - add to collisions list.                    $target.HOW.add_collision($target, $name, %meth_providers{$name});                }            }        }        # Now do the other bits.        my @all_roles;        for @roles {            my $how := $_.HOW;            # Compose is any attributes, unless there's a conflict.            my @attributes := $how.attributes($_, :local(1));            for @attributes {                my $add_attr := $_;                my $skip := 0;                my @cur_attrs := $target.HOW.attributes($target, :local(1));                for @cur_attrs {                    if $_ =:= $add_attr {                        $skip := 1;                    }                    else {                        if $_.name eq $add_attr.name {                            pir::die("Attribute '" ~ $_.name ~ "' conflicts in role composition");                        }                    }                }                unless $skip {                    $target.HOW.add_attribute($target, $add_attr);                }            }            # Build up full list of roles that this one does.            @all_roles.push($_);            for $how.does_list($_) {                @all_roles.push($_);            }        }        return @all_roles;    }}
+my class RoleToRoleApplier {    method apply($target, @roles) {        # Aggregate all of the methods sharing names, eliminating        # any duplicates (a method can't collide with itself).        my %meth_info;        my %meth_providers;        for @roles {            my $role := $_;            my @methods := $_.HOW.methods($_, :local(1));            for @methods {                my $name := $_.name;                my $meth := $_;                my @meth_list;                my @meth_providers;                if pir::exists(%meth_info, $name) {                    @meth_list := %meth_info{$name};                    @meth_providers := %meth_providers{$name};                }                else {                    %meth_info{$name} := @meth_list;                    %meth_providers{$name} := @meth_providers;                }                my $found := 0;                for @meth_list {                    if $meth =:= $_ {                        $found := 1;                    }                }                unless $found {                    @meth_list.push($meth);                    @meth_providers.push($role.HOW.name($role));                }            }        }        # Also need methods of target.        my %target_meth_info;        my @target_meths := $target.HOW.methods($target, :local(1));        for @target_meths {            %target_meth_info{$_.name} := $_;        }        # Process method list.        for %meth_info {            my $name := $_.key;            my @add_meths := %meth_info{$name};            # Do we already have a method of this name? If so, ignore all of the            # methods we have from elsewhere.            unless pir::exists(%target_meth_info, $name) {                # No methods in the target role. If only one, it's easy...                if +@add_meths == 1 {                    $target.HOW.add_method($target, $name, @add_meths[0]);                }                else {                    # More than one - add to collisions list.                    $target.HOW.add_collision($target, $name, %meth_providers{$name});                }            }        }        # Now do the other bits.        my @all_roles;        for @roles {            my $how := $_.HOW;            # Compose is any attributes, unless there's a conflict.            my @attributes := $how.attributes($_, :local(1));            for @attributes {                my $add_attr := $_;                my $skip := 0;                my @cur_attrs := $target.HOW.attributes($target, :local(1));                for @cur_attrs {                    if $_ =:= $add_attr {                        $skip := 1;                    }                    else {                        if $_.name eq $add_attr.name {                            pir::die("Attribute '" ~ $_.name ~ "' conflicts in role composition");                        }                    }                }                unless $skip {                    $target.HOW.add_attribute($target, $add_attr);                }            }                        # Any multi-methods go straight in; conflicts can be            # caught my the multi-dispatcher later.            my @multis := $how.multi_methods_to_incorporate($_);            for @multis {                $target.HOW.add_multi_method($target, $_.name, $_.code);            }            # Build up full list of roles that this one does.            @all_roles.push($_);            for $how.does_list($_) {                @all_roles.push($_);            }        }        return @all_roles;    }}

src/Perl6/SymbolTable.pm

@@ -28,6 +28,10 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
     # outermost frame is at the bottom, the latest frame is on top.
     has @!BLOCKS;
 
+    # Mapping of sub IDs to their proto code objects; used for fixing
+    # up in dynamic compilation.
+    has %!sub_id_to_code_object;
+
     # Array of stubs to check and the end of compilation.
     has @!stub_check;
 
@@ -414,13 +418,28 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
         my $code      := pir::repr_instance_of__PP($type_obj);
         my $slot      := self.add_object($code);
 
+        # Stash it under the PAST block sub ID.
+        %!sub_id_to_code_object{$code_past.subid()} := $code;
+
         # For now, install stub that will dynamically compile the code if
         # we ever try to run it during compilation.
         my $precomp;
         my $stub := sub (*@pos, *%named) {
             unless $precomp {
+                # Compile.
                 $precomp := self.compile_in_context($code_past);
-                pir::perl6_associate_sub_code_object__vPP($precomp[0], $code);
+
+                # Fix up Code object associations (including nested blocks).
+                my $num_subs := pir::elements__IP($precomp);
+                my $i := 0;
+                while $i < $num_subs {
+                    my $subid := $precomp[$i].get_subid();
+                    if pir::exists(%!sub_id_to_code_object, $subid) {
+                        pir::perl6_associate_sub_code_object__vPP($precomp[$i],
+                            %!sub_id_to_code_object{$subid});
+                    }
+                    $i := $i + 1;
+                }
             }
             $precomp(|@pos, |%named);
         };
@@ -442,10 +461,15 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
         pir::setprop__vPsP($stub, 'CLONE_CALLBACK', sub ($orig, $clone) {
             self.add_object($clone);
             $fixups.push(PAST::Stmts.new(
-                self.set_attribute($clone, $code_type, '$!do', PAST::Val.new( :value($code_past) )),
+                PAST::Op.new( :pasttype('bind'),
+                    PAST::Var.new( :name('$P0'), :scope('register') ),
+                    PAST::Op.new( :pirop('clone PP'), PAST::Val.new( :value($code_past) ) )
+                ),
+                self.set_attribute($clone, $code_type, '$!do',
+                    PAST::Var.new( :name('$P0'), :scope('register') )),
                 PAST::Op.new(
                     :pirop('perl6_associate_sub_code_object vPP'),
-                    PAST::Val.new( :value($code_past) ),
+                    PAST::Var.new( :name('$P0'), :scope('register') ),
                     self.get_object_sc_ref_past($clone)
                 )));
         });