From 5b1451fb2b8e77a0912f0d18a4a9f0462fe079ba Mon Sep 17 00:00:00 2001 From: Whiteknight Date: Sun, 29 Apr 2012 07:09:45 -0400 Subject: [PATCH] Update World.pmc to use Parrot's PackfileView PMC instead of the old Eval PMC. This fixes it for the eval_pmc branch from Parrot --- src/Perl6/World.pm | 328 +++++++++++++++++++++++---------------------- 1 file changed, 165 insertions(+), 163 deletions(-) diff --git a/src/Perl6/World.pm b/src/Perl6/World.pm index 050fb3e5c61..701e1d4a137 100644 --- a/src/Perl6/World.pm +++ b/src/Perl6/World.pm @@ -34,29 +34,29 @@ class Perl6::World is HLL::World { # The stack of lexical pads, actually as PAST::Block objects. The # outermost frame is at the bottom, the latest frame is on top. has @!BLOCKS; - + # The stack of code objects; phasers get attached to the top one. has @!CODES; - + # Mapping of sub IDs to their proto code objects; used for fixing # up in dynamic compilation. has %!sub_id_to_code_object; - + # Mapping of sub IDs to their static lexpad objects. has %!sub_id_to_static_lexpad; - + # Mapping of sub IDs to SC indexes of code stubs. has %!sub_id_to_sc_idx; - + # Array of stubs to check and the end of compilation. has @!stub_check; - + # Cached constants that we've built. has %!const_cache; - + # List of CHECK blocks to run. has @!CHECKs; - + # Creates a new lexical scope and puts it on top of the stack. method push_lexpad($/) { # Create pad, link to outer and add to stack. @@ -67,30 +67,30 @@ class Perl6::World is HLL::World { @!BLOCKS[+@!BLOCKS] := $pad; $pad } - + # Pops a lexical scope off the stack. method pop_lexpad() { @!BLOCKS.pop() } - + # Gets the top lexpad. method cur_lexpad() { @!BLOCKS[+@!BLOCKS - 1] } - + # Gets (and creates if needed) the static lexpad object for a PAST block. method get_static_lexpad($pad) { my $pad_id := $pad.subid(); if pir::exists(%!sub_id_to_static_lexpad, $pad_id) { return %!sub_id_to_static_lexpad{$pad_id}; } - + # Create it a static lexpad object. my $slp_type_obj := self.find_symbol(['StaticLexPad']); my $slp := nqp::create($slp_type_obj); nqp::bindattr($slp, $slp_type_obj, '%!static_values', nqp::hash()); nqp::bindattr($slp, $slp_type_obj, '%!flags', nqp::hash()); - + # Deserialization and fixup need to associate static lex pad with the # low-level LexInfo. self.add_object($slp); @@ -99,18 +99,18 @@ class Perl6::World is HLL::World { PAST::Val.new( :value($pad), :returns('LexInfo')), self.get_ref($slp)); self.add_fixup_task(:deserialize_past($fixup), :fixup_past($fixup)); - + # Stash it under the PAST block sub ID. %!sub_id_to_static_lexpad{$pad.subid()} := $slp; - + $slp } - + # Marks the current lexpad as being a signatured block. method mark_cur_lexpad_signatured() { @!BLOCKS[+@!BLOCKS - 1] := 1; } - + # Finds the nearest signatured block and checks if it declares # a certain symbol. method nearest_signatured_block_declares($symbol) { @@ -122,12 +122,12 @@ class Perl6::World is HLL::World { } } } - + # Pushes a stub on the "stubs to check" list. method add_stub_to_check($stub) { @!stub_check[+@!stub_check] := $stub; } - + # Checks for any stubs that weren't completed. method assert_stubs_defined($/) { my @incomplete; @@ -140,17 +140,17 @@ class Perl6::World is HLL::World { self.throw($/, 'X::Package::Stubbed', packages => @incomplete); } } - + # Loads a setting. method load_setting($/, $setting_name) { # Do nothing for the NULL setting. - if $setting_name ne 'NULL' { + if $setting_name ne 'NULL' { # Load it immediately, so the compile time info is available. # Once it's loaded, set it as the outer context of the code # being compiled. my $setting := %*COMPILING<%?OPTIONS> := Perl6::ModuleLoader.load_setting($setting_name); - + # Add a fixup and deserialization task also. my $fixup := PAST::Stmt.new( self.perl6_module_loader_code(), @@ -165,17 +165,17 @@ class Perl6::World is HLL::World { ) ); self.add_load_dependency_task(:deserialize_past($fixup), :fixup_past($fixup)); - + return pir::getattribute__PPs($setting, 'lex_pad'); } } - + # Loads a module immediately, and also makes sure we load it # during the deserialization. method load_module($/, $module_name, $cur_GLOBALish) { # Immediate loading. my $module := Perl6::ModuleLoader.load_module($module_name, $cur_GLOBALish); - + # During deserialization, ensure that we get this module loaded. if self.is_precompilation_mode() { self.add_load_dependency_task(:deserialize_past(PAST::Stmts.new( @@ -189,7 +189,7 @@ class Perl6::World is HLL::World { return pir::getattribute__PPs($module, 'lex_pad'); } - + # Uses the NQP module loader to load Perl6::ModuleLoader, which # is a normal NQP module. method perl6_module_loader_code() { @@ -209,7 +209,7 @@ class Perl6::World is HLL::World { 'Perl6::ModuleLoader' )) } - + # Imports symbols from the specified package into the current lexical scope. method import($package) { # We'll do this in two passes, since at the start of CORE.setting we import @@ -218,7 +218,7 @@ class Perl6::World is HLL::World { # .symbol(...) hash we get away with this for now. my %stash := $package.WHO; my $target := self.cur_lexpad(); - + # First pass: PAST::Block symbol table installation. Also detect any # outright conflicts, and handle any situations where we need to merge. my %to_install; @@ -233,7 +233,7 @@ class Perl6::World is HLL::World { %to_install{$_.key} := $_.value; } } - + # Second pass: stick everything we still need to install in the # actual static lexpad. my $slp := self.get_static_lexpad($target); @@ -243,7 +243,7 @@ class Perl6::World is HLL::World { 1; } - + # Installs something package-y in the right place, creating the nested # pacakges as needed. method install_package($/, @name_orig, $scope, $pkgdecl, $package, $outer, $symbol) { @@ -253,7 +253,7 @@ class Perl6::World is HLL::World { my $create_scope := $scope; my $cur_pkg := $package; my $cur_lex := $outer; - + # Can only install packages as our or my scope. unless $create_scope eq 'my' || $create_scope eq 'our' { self.throw($/, 'X::Declaration::Scope', @@ -261,7 +261,7 @@ class Perl6::World is HLL::World { declaration => $pkgdecl, ); } - + # If we have a multi-part name, see if we know the opening # chunk already. If so, use it for that part of the name. if +@parts { @@ -272,7 +272,7 @@ class Perl6::World is HLL::World { @parts.shift(); } } - + # Chase down the name, creating stub packages as needed. while +@parts { my $part := @parts.shift; @@ -293,7 +293,7 @@ class Perl6::World is HLL::World { $cur_lex := 0; } } - + # Install final part of the symbol. if $create_scope eq 'my' || $cur_lex { self.install_lexical_symbol($cur_lex, $name, $symbol); @@ -304,16 +304,16 @@ class Perl6::World is HLL::World { } self.install_package_symbol($cur_pkg, $name, $symbol); } - + 1; } - + # If we declare class A::B { }, then class A { }, then A.WHO must be the # .WHO we already created for the stub package A. method steal_WHO($thief, $victim) { pir::set_who__vP($thief, $victim.WHO); } - + # Installs a lexical symbol. Takes a PAST::Block object, name and # the object to install. Does an immediate installation in the # compile-time block symbol table, and ensures that the installation @@ -324,7 +324,7 @@ class Perl6::World is HLL::World { $block[0].push(PAST::Var.new( :scope('lexical_6model'), :name($name), :isdecl(1) )); } $block.symbol($name, :scope('lexical_6model'), :value($obj)); - + # Add a clone if needed. if $clone { $block[0].push(PAST::Op.new( @@ -335,14 +335,14 @@ class Perl6::World is HLL::World { PAST::Var.new( :name($name), :scope('lexical_6model') ) ))); } - + # Add to static lexpad. my $slp := self.get_static_lexpad($block); $slp.add_static_value(~$name, $obj, 0, 0); 1; } - + # Installs a lexical symbol. Takes a PAST::Block object, name and # the type of container to install. method install_lexical_container($block, $name, %cont_info, $descriptor, :$state) { @@ -355,7 +355,7 @@ class Perl6::World is HLL::World { $block[0].push($var); } $block.symbol($name, :scope('lexical_6model'), :type(%cont_info), :descriptor($descriptor)); - + # If it's a native type, we're done - no container # as we inline natives straight into registers. Do # need to take care of initial value though. @@ -369,7 +369,7 @@ class Perl6::World is HLL::World { } return 1; } - + # Build container. my $cont := nqp::create(%cont_info); nqp::bindattr($cont, %cont_info, '$!descriptor', $descriptor); @@ -378,14 +378,14 @@ class Perl6::World is HLL::World { %cont_info); } $block.symbol($name, :value($cont)); - + # Add container to static lexpad. my $slp := self.get_static_lexpad($block); $slp.add_static_value(~$name, $cont, 1, ($state ?? 1 !! 0)); 1; } - + # Builds PAST that constructs a container. method build_container_past(%cont_info, $descriptor) { # Create container. @@ -393,13 +393,13 @@ class Perl6::World is HLL::World { :pirop('repr_instance_of PP'), self.get_ref(%cont_info) ); - + # Set container descriptor. $cont_code := PAST::Op.new( :pirop('setattribute 0PPsP'), $cont_code, self.get_ref(%cont_info), '$!descriptor', self.get_ref($descriptor)); - + # Default contents, if applicable (note, slurpy param as we can't # use definedness here, as it's a type object we'd be checking). if pir::exists(%cont_info, 'default_value') { @@ -408,10 +408,10 @@ class Perl6::World is HLL::World { $cont_code, self.get_ref(%cont_info), '$!value', self.get_ref(%cont_info)); } - + $cont_code } - + # Hunts through scopes to find the type of a lexical. method find_lexical_container_type($name) { my $i := +@!BLOCKS; @@ -429,20 +429,20 @@ class Perl6::World is HLL::World { } pir::die("Could not find container descriptor for $name"); } - + # Installs a symbol into the package. method install_package_symbol($package, $name, $obj) { ($package.WHO){$name} := $obj; 1; } - + # Creates a parameter object. method create_parameter(%param_info) { # Create parameter object now. my $par_type := self.find_symbol(['Parameter']); my $parameter := nqp::create($par_type); self.add_object($parameter); - + # Calculate flags. my $flags := 0; if %param_info { @@ -512,7 +512,7 @@ class Perl6::World is HLL::World { elsif $primspec == 3 { $flags := $flags + $SIG_ELEM_NATIVE_STR_VALUE; } - + # Populate it. if pir::exists(%param_info, 'variable_name') { nqp::bindattr_s($parameter, $par_type, '$!variable_name', %param_info); @@ -547,21 +547,21 @@ class Perl6::World is HLL::World { # Return created parameter. $parameter } - + # Creates a signature object from a set of parameters. method create_signature(@parameters) { # Create signature object now. my $sig_type := self.find_symbol(['Signature']); my $signature := nqp::create($sig_type); self.add_object($signature); - + # Set parameters. nqp::bindattr($signature, $sig_type, '$!params', @parameters); - + # Return created signature. $signature } - + # Creates a code object of the specified type, attached the passed signature # object and sets up dynamic compilation thunk. method create_code_object($code_past, $type, $signature, $is_dispatcher = 0, :$yada) { @@ -570,7 +570,7 @@ class Perl6::World is HLL::World { self.finish_code_object($code, $code_past, $is_dispatcher, :yada($yada)); $code } - + # Stubs a code object of the specified type. method stub_code_object($type) { my $type_obj := self.find_symbol([$type]); @@ -579,35 +579,35 @@ class Perl6::World is HLL::World { self.add_object($code); $code } - + # Attaches a signature to a code object. method attach_signature($code, $signature) { my $code_type := self.find_symbol(['Code']); nqp::bindattr($code, $code_type, '$!signature', $signature); } - + # Takes a code object and the PAST::Block for its body. method finish_code_object($code, $code_past, $is_dispatcher = 0, :$yada) { my $fixups := PAST::Stmts.new(); my $des := PAST::Stmts.new(); - + # Remove it from the code objects stack. @!CODES.pop(); - + # Handle any phasers. self.add_phasers_handling_code($code, $code_past); - + # Locate various interesting symbols. my $code_type := self.find_symbol(['Code']); my $routine_type := self.find_symbol(['Routine']); my $slp_type := self.find_symbol(['StaticLexPad']); - + # Attach code object to PAST node. $code_past := $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; @@ -616,7 +616,7 @@ class Perl6::World is HLL::World { my $rns := pir::get_root_namespace__P(); my $p6_pns := $rns{'perl6'}; $p6_pns{'GLOBAL'} := $*GLOBALish; - + # Compile the block. $precomp := self.compile_in_context($code_past, $code_type, $slp_type); @@ -640,13 +640,13 @@ class Perl6::World is HLL::World { pir::setprop__vPsP($stub, 'COMPILER_THUNK', $compiler_thunk); pir::set__vPS($stub, $code_past.name); nqp::bindattr($code, $code_type, '$!do', $stub); - + # Tag it as a static code ref and add it to the root code refs set. pir::setprop__vPsP($stub, 'STATIC_CODE_REF', $stub); pir::setprop__vPsP($stub, 'COMPILER_STUB', $stub); my $code_ref_idx := self.add_root_code_ref($stub, $code_past); %!sub_id_to_sc_idx{$code_past.subid()} := $code_ref_idx; - + # If we clone the stub, need to mark it as a dynamic compilation # boundary. if self.is_precompilation_mode() { @@ -657,7 +657,7 @@ class Perl6::World is HLL::World { }; pir::setprop__vPsP($stub, 'CLONE_CALLBACK', $clone_handler); } - + # Fixup will install the real thing, unless we're in a role, in # which case pre-comp will have sorted it out. unless $*PKGDECL eq 'role' { @@ -669,7 +669,7 @@ class Perl6::World is HLL::World { PAST::Val.new( :value($code_past) ), self.get_ref($code) ))); - + # If we clone the stub, then we must remember to do a fixup # of it also. pir::setprop__vPsP($stub, 'CLONE_CALLBACK', sub ($orig, $clone) { @@ -692,13 +692,13 @@ class Perl6::World is HLL::World { # Attach the PAST block to the stub. pir::setprop__vPsP($stub, 'PAST_BLOCK', $code_past); } - + # If this is a dispatcher, install dispatchee list that we can # add the candidates too. if $is_dispatcher { nqp::bindattr($code, $routine_type, '$!dispatchees', []); } - + # Set yada flag if needed. if $yada { nqp::bindattr_i($code, $routine_type, '$!yada', 1); @@ -718,7 +718,7 @@ class Perl6::World is HLL::World { self.get_static_lexpad($code_past).set_fresh_magicals(); nqp::bindattr($code, $routine_type, '$!package', $*PACKAGE); } - + self.add_fixup_task(:deserialize_past($des), :fixup_past($fixups)); $code; } @@ -743,7 +743,7 @@ class Perl6::World is HLL::World { ); self.add_fixup_task(:fixup_past($fixups)); } - + # Adds any extra code needing for handling phasers. method add_phasers_handling_code($code, $code_past) { my $block_type := self.find_symbol(['Block']); @@ -789,12 +789,12 @@ class Perl6::World is HLL::World { } } } - + # Adds a multi candidate to a proto/dispatch. method add_dispatchee_to_proto($proto, $candidate) { $proto.add_dispatchee($candidate); } - + # Derives a proto to get a dispatch. method derive_dispatcher($proto) { # Immediately do so and add to SC. @@ -802,7 +802,7 @@ class Perl6::World is HLL::World { self.add_object($derived); return $derived; } - + # Creates a new container descriptor and adds it to the SC. method create_container_descriptor($of, $rw, $name) { my $cd_type := self.find_symbol(['ContainerDescriptor']); @@ -810,7 +810,7 @@ class Perl6::World is HLL::World { self.add_object($cd); $cd } - + # Helper to make PAST for setting an attribute to a value. Value should # be a PAST tree. method set_attribute($obj, $class, $name, $value_past) { @@ -818,7 +818,7 @@ class Perl6::World is HLL::World { :pasttype('bind_6model'), PAST::Var.new( :name($name), :scope('attribute_6model'), - self.get_ref($obj), + self.get_ref($obj), self.get_ref($class) ), $value_past @@ -833,7 +833,7 @@ class Perl6::World is HLL::World { nqp::bindattr($scalar, $scalar_type, '$!value', $obj); $scalar; } - + # Takes a PAST::Block and compiles it for running during "compile time". # We need to do this for BEGIN but also for things that get called in # the compilation process, like user defined traits. @@ -844,8 +844,8 @@ class Perl6::World is HLL::World { self.add_libs($wrapper); $wrapper.hll('perl6'); $wrapper.namespace(''); - - # Create outer lexical contexts with all symbols visible. Maybe + + # Create outer lexical contexts with all symbols visible. Maybe # we can be a bit smarter here some day. But for now we just make a # single frame and copy all the visible things into it. my %seen; @@ -860,7 +860,7 @@ class Perl6::World is HLL::World { $wrapper[0].push(PAST::Var.new( :name($_.key), :scope('lexical_6model'), :isdecl(1) )); $wrapper.symbol($_.key, :scope('lexical_6model')); - + # Make static lexpad entry. my %sym := $_.value; $slp.add_static_value($_.key, @@ -871,48 +871,50 @@ class Perl6::World is HLL::World { } $cur_block := $cur_block; } - + # Compile it, set wrapper's static lexpad, then invoke the wrapper, # which fixes up the lexicals. my $p6comp := pir::compreg__Ps('perl6'); my $post := $p6comp.post($wrapper); my $pir := $p6comp.pir($post); my $precomp := $p6comp.evalpmc($pir); - $precomp[0].get_lexinfo.set_static_lexpad($slp); - $precomp(); - + my $main_sub := $precomp.main_sub(); + $main_sub.get_lexinfo.set_static_lexpad($slp); + $main_sub(); + # Fix up Code object associations (including nested blocks). # We un-stub any code objects for already-compiled inner blocks # to avoid wasting re-compiling them, and also to help make # parametric role outer chain work out. Also set up their static # lexpads, if they have any. - my $num_subs := nqp::elems($precomp); + my @all_subs := $precomp.all_subs(); + my $num_subs := nqp::elems(@all_subs); my $i := 0; while $i < $num_subs { - my $subid := $precomp[$i].get_subid(); + my $subid := @all_subs[$i].get_subid(); if pir::exists(%!sub_id_to_code_object, $subid) { - pir::perl6_associate_sub_code_object__vPP($precomp[$i], + pir::perl6_associate_sub_code_object__vPP(@all_subs[$i], %!sub_id_to_code_object{$subid}); - nqp::bindattr(%!sub_id_to_code_object{$subid}, $code_type, '$!do', $precomp[$i]); + nqp::bindattr(%!sub_id_to_code_object{$subid}, $code_type, '$!do', @all_subs[$i]); } if pir::exists(%!sub_id_to_static_lexpad, $subid) { - $precomp[$i].get_lexinfo.set_static_lexpad(%!sub_id_to_static_lexpad{$subid}); + @all_subs[$i].get_lexinfo.set_static_lexpad(%!sub_id_to_static_lexpad{$subid}); } if pir::exists(%!sub_id_to_sc_idx, $subid) { - pir::setprop__vPsP($precomp[$i], 'STATIC_CODE_REF', $precomp[$i]); - self.update_root_code_ref(%!sub_id_to_sc_idx{$subid}, $precomp[$i]); + pir::setprop__vPsP(@all_subs[$i], 'STATIC_CODE_REF', @all_subs[$i]); + self.update_root_code_ref(%!sub_id_to_sc_idx{$subid}, @all_subs[$i]); } $i := $i + 1; } - + # Flag block as dynamically compiled. $past := 1; - + # Return the Parrot Sub that maps to the thing we were originally # asked to compile. - $precomp[1] + @all_subs[1] } - + # Adds a constant value to the constants table. Returns PAST to do # the lookup of the constant. method add_constant($type, $primitive, :$nocache, *@value, *%named) { @@ -939,10 +941,10 @@ class Perl6::World is HLL::World { return $past; } } - + # Find type object for the box typed we'll create. my $type_obj := self.find_symbol(pir::split('::', $type)); - + # Go by the primitive type we're boxing. Need to create # the boxed value and also code to produce it. my $constant; @@ -964,10 +966,10 @@ class Perl6::World is HLL::World { else { pir::die("Don't know how to build a $primitive constant"); } - + # Add to SC. self.add_object($constant); - + # Build PAST for getting the boxed constant from the constants # table, but also annotate it with the constant itself in case # we need it. Add to cache. @@ -979,7 +981,7 @@ class Perl6::World is HLL::World { } return $past; } - + # Adds a numeric constant value (int or num) to the constants table. # Returns PAST to do the lookup of the constant. method add_numeric_constant($type, $value) { @@ -1011,7 +1013,7 @@ class Perl6::World is HLL::World { } $past; } - + # Adds a string constant value to the constants table. # Returns PAST to do the lookup of the constant. method add_string_constant($value) { @@ -1022,7 +1024,7 @@ class Perl6::World is HLL::World { $past := 3; $past; } - + # Adds the result of a constant folding operation to the SC and # returns a reference to it. method add_constant_folded_result($r) { @@ -1052,7 +1054,7 @@ class Perl6::World is HLL::World { # Result is just the object. return $mo; } - + # Constructs a meta-attribute and adds it to a meta-object. Expects to # be passed the meta-attribute type object, a set of literal named # arguments to pass and a set of name to object mappings to pass also @@ -1067,22 +1069,22 @@ class Perl6::World is HLL::World { nqp::bindattr($cont, %cont_info, '$!value', %cont_info); } - + # Create meta-attribute instance and add right away. Also add # it to the SC. my $attr := $meta_attr.new(:auto_viv_container($cont), |%lit_args, |%obj_args); $obj.HOW.add_attribute($obj, $attr); self.add_object($attr); - + # Return attribute that was built. $attr } - + # Adds a method to the meta-object. method pkg_add_method($/, $obj, $meta_method_name, $name, $code_object) { $obj.HOW."$meta_method_name"($obj, $name, $code_object); } - + # Handles setting the body block code for a role. method pkg_set_role_body_block($/, $obj, $code_object, $past) { # Add it to the compile time meta-object. @@ -1094,17 +1096,17 @@ class Perl6::World is HLL::World { self.compile_in_context($past, self.find_symbol(['Code']), self.find_symbol(['StaticLexPad'])); } - + # Adds a possible role to a role group. method pkg_add_role_group_possibility($/, $group, $role) { $group.HOW.add_possibility($group, $role); } - + # Composes the package, and stores an event for this action. method pkg_compose($obj) { $obj.HOW.compose($obj); } - + # Builds a curried role based on a parsed argument list. method parameterize_type($role, $arglist, $/) { # Build a list of compile time arguments to the role; whine if @@ -1124,10 +1126,10 @@ class Perl6::World is HLL::World { @pos_args.push($_); } } - + self.parameterize_type_with_args($role, @pos_args, %named_args); } - + # Curries a role with the specified arguments. method parameterize_type_with_args($role, @pos_args, %named_args) { # Make the curry right away and add it to the SC. @@ -1135,7 +1137,7 @@ class Perl6::World is HLL::World { self.add_object($curried); return $curried; } - + # Creates a subset type meta-object/type object pair. method create_subset($how, $refinee, $refinement, :$name) { # Create the meta-object and add to root objects. @@ -1145,7 +1147,7 @@ class Perl6::World is HLL::World { self.add_object($mo); return $mo; } - + # Adds a value to an enumeration. method create_enum_value($enum_type_obj, $key, $value) { # Create directly. @@ -1155,20 +1157,20 @@ class Perl6::World is HLL::World { nqp::bindattr($val, $enum_type_obj, '$!value', pir::repr_box_int__PiP($value, $base_type)); self.add_object($val); - + # Add to meta-object. $enum_type_obj.HOW.add_enum_value($enum_type_obj, $val); # Result is the value. $val } - + # Applies a trait. method apply_trait($trait_sub_name, *@pos_args, *%named_args) { my $trait_sub := $*W.find_symbol([$trait_sub_name]); $trait_sub(|@pos_args, |%named_args); } - + # Some things get cloned many times with a lexical scope that # we never enter. This makes sure we capture them as needed. method create_lexical_capture_fixup() { @@ -1186,7 +1188,7 @@ class Perl6::World is HLL::World { :name('$!list'), :scope('attribute_6model'), self.get_ref($fixup_list), self.get_ref(FixupList) ))); - + # Return a PAST node that we can push the dummy closure return PAST::Op.new( :pirop('push vPP'), @@ -1195,7 +1197,7 @@ class Perl6::World is HLL::World { self.get_ref($fixup_list), self.get_ref(FixupList) )); } - + # Handles addition of a phaser. method add_phaser($/, $phaser, $block, $phaser_past?) { if $phaser eq 'BEGIN' { @@ -1235,7 +1237,7 @@ class Perl6::World is HLL::World { %info := %info := self.find_symbol(['Scalar']); %info := %info := %info := $mu; self.install_lexical_container($pad, $sym, %info, $descriptor, :state(1)); - + # Generate code that runs the phaser the first time we init # the state block, or just evaluates to the existing value # in other cases. @@ -1268,7 +1270,7 @@ class Perl6::World is HLL::World { ) ), ); - + if $phaser eq 'POST' { # Needs $_ that can be set to the return value. $phaser_past[0].unshift(PAST::Op.new( :pirop('bind_signature v') )); @@ -1282,7 +1284,7 @@ class Perl6::World is HLL::World { nominal_type => self.find_symbol(['Mu']) ))); } - + @!CODES[+@!CODES - 1].add_phaser($phaser, $block); return PAST::Var.new(:name('Nil'), :scope('lexical_6model')); } @@ -1291,7 +1293,7 @@ class Perl6::World is HLL::World { return PAST::Var.new(:name('Nil'), :scope('lexical_6model')); } } - + # Runs the CHECK phasers and twiddles the PAST to look them up. method CHECK() { for @!CHECKs { @@ -1299,7 +1301,7 @@ class Perl6::World is HLL::World { $_[1][0] := self.add_constant_folded_result($result); } } - + # Adds required libraries to a compilation unit. method add_libs($comp_unit) { $comp_unit.loadlibs('nqp_group', 'nqp_ops', 'perl6_group', 'perl6_ops', @@ -1307,41 +1309,41 @@ class Perl6::World is HLL::World { 'obscure_ops', 'os', 'file', 'sys_ops', 'nqp_bigint_ops', 'nqp_dyncall_ops'); } - + # Represents a longname after having parsed it. my class LongName { # The original text of the name. has str $!text; - + # Set of name components. Each one will be either a string # or a PAST node that represents an expresison to produce it. has @!components; - + # The colonpairs, if any. has @!colonpairs; - + # Flag for if the name ends in ::, meaning we need to emit a # .WHO on the end. has int $!get_who; - + # Gets the textual name of the value. method text() { $!text } - + # Gets the name, without any adverbs. method name() { my @parts := nqp::clone(@!components); @parts.shift() while self.is_pseudo_package(@parts[0]); pir::join('::', @parts) } - + # Gets the individual components, which may be PAST nodes for # unknown pieces. method components() { @!components } - + # Gets the individual components (which should be strings) but # taking a sigil and twigil and adding them to the last component. method variable_components($sigil, $twigil) { @@ -1352,7 +1354,7 @@ class Perl6::World is HLL::World { @result[+@result - 1] := $sigil ~ $twigil ~ @result[+@result - 1]; @result } - + # Checks if there is an indirect lookup required. method contains_indirect_lookup() { for @!components { @@ -1362,7 +1364,7 @@ class Perl6::World is HLL::World { } return 0; } - + # Fetches an array of components provided they are all known # or resolvable at compile time. method type_name_parts($dba, :$decl) { @@ -1402,7 +1404,7 @@ class Perl6::World is HLL::World { } @name } - + method get_who() { $!get_who } @@ -1415,7 +1417,7 @@ class Perl6::World is HLL::World { $comp eq 'DYNAMIC' || $comp eq 'COMPILING' || $comp eq 'PARENT' } } - + # Takes a longname and turns it into an object representing the # name. method disect_longname($longname) { @@ -1446,7 +1448,7 @@ class Perl6::World is HLL::World { } } nqp::bindattr($result, LongName, '@!components', @components); - + # Stash colon pairs with names; incorporate non-named one into # the last part of the name (e.g. for infix:<+>). Need to be a # little cheaty when compiling the setting due to bootstrapping. @@ -1469,15 +1471,15 @@ class Perl6::World is HLL::World { } } nqp::bindattr($result, LongName, '@!colonpairs', @pairs); - + $result } - + # Checks if a name starts with a pseudo-package. method is_pseudo_package($comp) { LongName.is_pseudo_package($comp) } - + # Checks if a given symbol is declared. method is_name(@name) { my $is_name := 0; @@ -1493,7 +1495,7 @@ class Perl6::World is HLL::World { } $is_name } - + # Checks if a given symbol is declared and a type object. method is_type(@name) { my $is_name := 0; @@ -1503,7 +1505,7 @@ class Perl6::World is HLL::World { } $is_name } - + # Checks if a symbol has already been declared in the current # scope, and thus may not be redeclared. method already_declared($scope, $curpackage, $curpad, @name) { @@ -1527,7 +1529,7 @@ class Perl6::World is HLL::World { else { return 0; } - + # If we've more name, recursively check the next level # in the package. Otherwise, just go on if it's a # package or not. @@ -1541,7 +1543,7 @@ class Perl6::World is HLL::World { } } } - + # Checks if there is a regex in scope. method regex_in_scope($name) { my $result := 0; @@ -1551,7 +1553,7 @@ class Perl6::World is HLL::World { } $result } - + # Finds a symbol that has a known value at compile time from the # perspective of the current scope. Checks for lexicals, then if # that fails tries package lookup. @@ -1582,7 +1584,7 @@ class Perl6::World is HLL::World { } } } - + # If it's a multi-part name, see if the containing package # is a lexical somewhere. Otherwise we fall back to looking # in GLOBALish. @@ -1602,11 +1604,11 @@ class Perl6::World is HLL::World { } else { pir::die("No compile-time value for $first"); - } + } } } } - + # Try to chase down the parts of the name. for @name { if pir::exists($result.WHO, ~$_) { @@ -1617,21 +1619,21 @@ class Perl6::World is HLL::World { pir::join('::', @name)); } } - + $result; } - + # Takes a name and compiles it to a lookup for the symbol. method symbol_lookup(@name, $/, :$package_only = 0, :$lvalue = 0) { # Catch empty names and die helpfully. if +@name == 0 { $/.CURSOR.panic("Cannot compile empty name"); } my $orig_name := pir::join('::', @name); - + # Handle fetching GLOBAL. if +@name == 1 && @name[0] eq 'GLOBAL' { return PAST::Var.new( :name('GLOBAL'), :namespace([]), :scope('package') ); } - + # Handle things starting with pseudo-package. if self.is_pseudo_package(@name[0]) && @name[0] ne 'GLOBAL' && @name[0] ne 'PROCESS' { my $lookup; @@ -1653,7 +1655,7 @@ class Perl6::World is HLL::World { } return $lookup; } - + # If it's a single item, then go hunting for it through the # block stack. if +@name == 1 && !$package_only { @@ -1666,7 +1668,7 @@ class Perl6::World is HLL::World { } } } - + # The final lookup will always be just a keyed index (cheap) # for non-lvalue case, or at_key call on a Stash. my $final_name := @name.pop(); @@ -1675,7 +1677,7 @@ class Perl6::World is HLL::World { :pasttype('callmethod'), :name('at_key'), self.add_constant('Str', 'str', $final_name)) !! PAST::Var.new( :scope('keyed'), ~$final_name); - + # If there's no explicit qualification, then look it up in the # current package, and fall back to looking in GLOBAL. if +@name == 0 { @@ -1693,7 +1695,7 @@ class Perl6::World is HLL::World { ~$final_name )); } - + # Otherwise, see if the first part of the name is lexically # known. If not, it's in GLOBAL. Also, if first part is GLOBAL # then strip it off. @@ -1712,15 +1714,15 @@ class Perl6::World is HLL::World { } $lookup.unshift(PAST::Op.new(:pirop('get_who PP'), $path)); } - + # Failure object if we can't find the name. if $lookup.isa(PAST::Var) && !$lookup.viviself { $lookup.viviself(self.lookup_failure($orig_name)); } - + return $lookup; } - + method lookup_failure($orig_name) { my $msg := "Could not find symbol '$orig_name'"; return PAST::Op.new( @@ -1743,7 +1745,7 @@ class Perl6::World is HLL::World { } 0; } - + # Checks if the symbol is really an alias to an attribute. method is_attr_alias($name) { my $i := +@!BLOCKS;