Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

1487 lines (1323 sloc) 53.988 kb
class NQP::Actions is HLL::Actions {
sub xblock_immediate($xblock) {
$xblock[1] := block_immediate($xblock[1]);
$xblock;
}
sub block_immediate($block) {
$block.blocktype('immediate');
unless $block.symtable() || $block.handlers() {
my $stmts := PAST::Stmts.new( :node($block) );
for $block.list { $stmts.push($_); }
$block := $stmts;
}
$block;
}
sub vivitype($sigil) {
$sigil eq '%'
?? PAST::Op.new(:inline(" %r = root_new ['parrot';'Hash']"))
!! ($sigil eq '@'
?? PAST::Op.new(:inline(" %r = root_new ['parrot';'ResizablePMCArray']"))
!! 'Undef');
}
method TOP($/) { make $<comp_unit>.ast; }
method deflongname($/) {
make $<colonpair>
?? ~$<identifier> ~ ':' ~ $<colonpair>[0].ast.named
~ '<' ~ colonpair_str($<colonpair>[0].ast) ~ '>'
!! ~$/;
# make $<sym> ?? ~$<identifier> ~ ':sym<' ~ ~$<sym>[0] ~ '>' !! ~$/;
}
sub colonpair_str($ast) {
PAST::Op.ACCEPTS($ast)
?? nqp::join(' ', $ast.list)
!! $ast.value;
}
method comp_unit($/) {
my $mainline := $<statementlist>.ast;
my $unit := $*W.pop_lexpad();
# Unit needs to have a load-init holding the deserialization or
# fixup code for this compilation unit.
$unit.loadinit().push($*W.to_past());
# We'll install our view of GLOBAL as the main one; any other
# compilation unit that is using this one will then replace it
# with its view later (or be in a position to restore it).
$unit.loadinit().push(PAST::Op.new(
:pasttype('bind_6model'),
PAST::Var.new( :name('GLOBAL'), :namespace([]), :scope('package') ),
$*W.get_slot_past_for_object($*PACKAGE)
));
# If our caller wants to know the mainline ctx, provide it here.
# (CTXSAVE is inherited from HLL::Actions.) Don't do this when
# there was an explicit {YOU_ARE_HERE}.
unless $*HAS_YOU_ARE_HERE {
$unit.push( self.CTXSAVE() );
}
# Detect if we're the main unit by if we were given any args. If so,
# register the mainline as a module (so trying to use ourself in the
# program will not explode). If we have a MAIN sub, call it at end of
# mainline.
$unit.unshift(PAST::Var.new( :scope('parameter'), :name('@ARGS'), :slurpy(1),
:directaccess(1) ));
my $main_tasks := PAST::Stmts.new(
PAST::Op.new( :pirop('load_bytecode vs'), 'ModuleLoader.pbc' ),
PAST::Op.new(
:pasttype('callmethod'), :name('set_mainline_module'),
PAST::Var.new( :name('ModuleLoader'), :namespace([]), :scope('package') ),
PAST::Var.new( :scope('keyed'), PAST::Op.new( :pirop('getinterp P') ), 'context' )
)
);
if $*MAIN_SUB {
$main_tasks.push(PAST::Op.new(
:pasttype('call'), PAST::Val.new( :value($*MAIN_SUB) ),
PAST::Var.new( :scope('lexical'), :name('@ARGS'), :flat(1) )
));
}
$mainline.push(PAST::Op.new(
:pasttype('if'),
PAST::Var.new( :scope('lexical'), :name('@ARGS') ),
$main_tasks
));
# We force a return here, because we have other
# :load/:init blocks to execute that we don't want
# to include as part of the mainline.
$unit.push(
PAST::Op.new( :pirop<return>, $mainline )
);
# If this code is loaded via load_bytecode, we want the unit mainline
# to be executed after all other loadinits have taken place.
$unit.push(
PAST::Block.new(
:pirflags(':load'), :lexical(0), :namespace(''),
PAST::Op.new( :pasttype<call>, PAST::Val.new( :value($unit) ) )
)
);
$unit.node($/);
# Set NQP defaults.
$*W.set_nqp_language_defaults($unit);
make $unit;
}
method statementlist($/) {
my $past := PAST::Stmts.new( :node($/) );
if $<statement> {
for $<statement> {
my $ast := $_.ast;
$ast := $ast<sink> if nqp::defined($ast<sink>);
if $ast<bareblock> { $ast := block_immediate($ast); }
$ast := PAST::Stmt.new($ast) if $ast ~~ PAST::Node;
$past.push( $ast );
}
}
make $past;
}
method statement($/, $key?) {
my $past;
if $<EXPR> {
my $mc := $<statement_mod_cond>[0];
my $ml := $<statement_mod_loop>[0];
$past := $<EXPR>.ast;
if $mc {
$past := PAST::Op.new($mc<cond>.ast, $past, :pasttype(~$mc<sym>), :node($/) );
}
if $ml {
if ~$ml<sym> eq 'for' {
$past := PAST::Block.new( :blocktype('immediate'),
PAST::Var.new( :name('$_'), :scope('parameter'), :isdecl(1) ),
$past);
$past.symbol('$_', :scope('lexical') );
$past.arity(1);
$past := PAST::Op.new($ml<cond>.ast, $past, :pasttype(~$ml<sym>), :node($/) );
}
else {
$past := PAST::Op.new($ml<cond>.ast, $past, :pasttype(~$ml<sym>), :node($/) );
}
}
}
elsif $<statement_control> { $past := $<statement_control>.ast; }
else { $past := 0; }
make $past;
}
method xblock($/) {
make PAST::Op.new( $<EXPR>.ast, $<pblock>.ast, :pasttype('if'), :node($/) );
}
method pblock($/) {
make $<blockoid>.ast;
}
method block($/) {
make $<blockoid>.ast;
}
method blockoid($/) {
my $BLOCK := $*W.pop_lexpad();
if $<statementlist> {
my $past := $<statementlist>.ast;
$BLOCK.push($past);
$BLOCK.node($/);
$BLOCK.closure(1);
make $BLOCK;
}
else {
if $*HAS_YOU_ARE_HERE {
$/.CURSOR.panic('{YOU_ARE_HERE} may only appear once in a setting');
}
$*HAS_YOU_ARE_HERE := 1;
make $<you_are_here>.ast;
}
}
method newpad($/) {
$*W.push_lexpad($/)
}
method outerctx($/) {
unless nqp::defined(%*COMPILING<%?OPTIONS><outer_ctx>) {
# We haven't got a specified outer context already, so load a
# setting.
my $SETTING := $*W.load_setting(%*COMPILING<%?OPTIONS><setting> // 'NQPCORE');
# If it exports HOWs, grab them. Also, if we're loading the
# setting, also by default load Regex library (we can't load
# this in the setting as Regex depends on the setting).
unless %*COMPILING<%?OPTIONS><setting> eq 'NULL' {
import_HOW_exports($SETTING);
if %*COMPILING<%?OPTIONS><old-regex-lib> {
$*W.load_module('NQPRegex', $*GLOBALish);
}
unless %*COMPILING<%?OPTIONS><no-regex-lib> {
$*W.load_module('QRegex', $*GLOBALish);
unless %*COMPILING<%?OPTIONS><old-regex-lib> {
$*W.load_module('NQPP6QRegex', $*GLOBALish);
}
}
}
}
self.SET_BLOCK_OUTER_CTX($*W.cur_lexpad());
}
sub import_HOW_exports($UNIT) {
# See if we've exported any HOWs.
if nqp::existskey($UNIT, 'EXPORTHOW') {
for $UNIT<EXPORTHOW>.WHO {
%*HOW{$_.key} := $_.value;
}
}
}
method GLOBALish($/) {
# Create GLOBALish - the current GLOBAL view, created cleanly
# for each compilation unit so we get separate compilation.
# XXX Uses KnowHOW for now; want something lighter really.
$*GLOBALish := $*W.pkg_create_mo(%*HOW<knowhow>, :name('GLOBALish'));
$*GLOBALish.HOW.compose($*GLOBALish);
$*W.install_lexical_symbol($*W.cur_lexpad(), 'GLOBALish', $*GLOBALish);
# This is also the starting package.
$*PACKAGE := $*GLOBALish;
$*W.install_lexical_symbol($*W.cur_lexpad(), '$?PACKAGE', $*PACKAGE);
}
method you_are_here($/) {
make self.CTXSAVE();
}
## Statement control
method statement_control:sym<use>($/) {
my $module := $*W.load_module(~$<name>, $*GLOBALish);
if nqp::defined($module) {
import_HOW_exports($module);
}
make PAST::Stmts.new();
}
method statement_control:sym<if>($/) {
my $count := +$<xblock> - 1;
my $past := xblock_immediate( $<xblock>[$count].ast );
if $<else> {
$past.push( block_immediate( $<else>[0].ast ) );
}
# build if/then/elsif structure
while $count > 0 {
$count--;
my $else := $past;
$past := xblock_immediate( $<xblock>[$count].ast );
$past.push($else);
}
make $past;
}
method statement_control:sym<unless>($/) {
my $past := xblock_immediate( $<xblock>.ast );
$past.pasttype('unless');
make $past;
}
method statement_control:sym<while>($/) {
my $past := xblock_immediate( $<xblock>.ast );
$past.pasttype(~$<sym>);
make $past;
}
method statement_control:sym<repeat>($/) {
my $pasttype := 'repeat_' ~ ~$<wu>;
my $past;
if $<xblock> {
$past := xblock_immediate( $<xblock>.ast );
$past.pasttype($pasttype);
}
else {
$past := PAST::Op.new( $<EXPR>.ast, block_immediate( $<pblock>.ast ),
:pasttype($pasttype), :node($/) );
}
make $past;
}
method statement_control:sym<for>($/) {
my $past := $<xblock>.ast;
$past.pasttype('for');
my $block := $past[1];
unless $block.arity {
$block[0].push( PAST::Var.new( :name('$_'), :scope('parameter') ) );
$block.symbol('$_', :scope('lexical') );
$block.arity(1);
}
$block.blocktype('immediate');
make $past;
}
method statement_control:sym<CATCH>($/) {
my $block := $<block>.ast;
push_block_handler($/, $block);
$*W.cur_lexpad().handlers()[0].handle_types_except('CONTROL');
make PAST::Stmts.new(:node($/));
}
method statement_control:sym<CONTROL>($/) {
my $block := $<block>.ast;
push_block_handler($/, $block);
$*W.cur_lexpad().handlers()[0].handle_types('CONTROL');
make PAST::Stmts.new(:node($/));
}
sub push_block_handler($/, $block) {
my $BLOCK := $*W.cur_lexpad();
unless $BLOCK.handlers() {
$BLOCK.handlers([]);
}
unless $block.arity {
$block.unshift(
PAST::Op.new( :pasttype('bind_6model'),
PAST::Var.new( :scope('lexical'), :name('$!'), :isdecl(1) ),
PAST::Var.new( :scope('lexical'), :name('$_')),
),
);
$block.unshift( PAST::Var.new( :name('$_'), :scope('parameter') ) );
$block.symbol('$_', :scope('lexical') );
$block.symbol('$!', :scope('lexical') );
$block.arity(1);
}
$block.blocktype('declaration');
$BLOCK.handlers.unshift(
PAST::Control.new(
:node($/),
PAST::Stmts.new(
PAST::Op.new( :pasttype('call'),
$block,
PAST::Var.new( :scope('register'), :name('exception')),
),
PAST::Op.new( :pasttype('bind_6model'),
PAST::Var.new( :scope('keyed'),
PAST::Var.new( :scope('register'), :name('exception')),
'handled'
),
1
)
),
)
);
}
method statement_prefix:sym<BEGIN>($/) {
make $*W.run_begin_block($<blorst>.ast);
}
method statement_prefix:sym<INIT>($/) {
$*W.cur_lexpad().push($<blorst>.ast);
make PAST::Stmts.new();
}
method statement_prefix:sym<try>($/) {
my $past := $<blorst>.ast;
unless $past ~~ PAST::Block {
$past := PAST::Block.new($past, :blocktype('immediate'), :node($/));
}
unless $past.handlers() {
$past.handlers([PAST::Control.new(
:handle_types_except('CONTROL'),
PAST::Stmts.new(
PAST::Op.new( :pasttype('bind_6model'),
PAST::Var.new( :scope('keyed'),
PAST::Var.new( :scope('register'), :name('exception')),
'handled'
),
1
)
)
)]
);
}
make $past;
}
method blorst($/) {
make $<block>
?? block_immediate($<block>.ast)
!! $<statement>.ast;
}
# Statement modifiers
method statement_mod_cond:sym<if>($/) { make $<cond>.ast; }
method statement_mod_cond:sym<unless>($/) { make $<cond>.ast; }
method statement_mod_loop:sym<while>($/) { make $<cond>.ast; }
method statement_mod_loop:sym<until>($/) { make $<cond>.ast; }
## Terms
method term:sym<fatarrow>($/) { make $<fatarrow>.ast; }
method term:sym<colonpair>($/) { make $<colonpair>.ast; }
method term:sym<variable>($/) { make $<variable>.ast; }
method term:sym<package_declarator>($/) { make $<package_declarator>.ast; }
method term:sym<scope_declarator>($/) { make $<scope_declarator>.ast; }
method term:sym<routine_declarator>($/) { make $<routine_declarator>.ast; }
method term:sym<regex_declarator>($/) { make $<regex_declarator>.ast; }
method term:sym<statement_prefix>($/) { make $<statement_prefix>.ast; }
method term:sym<lambda>($/) { make $<pblock>.ast; }
method fatarrow($/) {
my $past := $<val>.ast;
$past.named( $<key>.Str );
make $past;
}
method colonpair($/) {
if $<variable> {
$<variable>.ast.named(~$<variable><desigilname>);
make $<variable>.ast;
} else {
my $past := $<circumfix>
?? $<circumfix>[0].ast
!! PAST::Val.new( :value( !$<not> ) );
$past.named( ~$<identifier> );
make $past;
}
}
method variable($/) {
my $past;
if $<postcircumfix> {
$past := $<postcircumfix>.ast;
$past.unshift( PAST::Var.new( :name('$/') ) );
}
else {
my @name := NQP::Compiler.parse_name(~$/);
if +@name > 1 {
if $<twigil> {
$/.CURSOR.panic("Twigil not allowed on multi-part name");
}
$past := lexical_package_lookup(@name, $/);
$past.viviself( vivitype( $<sigil> ) );
}
elsif $<twigil>[0] eq '*' {
my $global_fallback := lexical_package_lookup(['GLOBAL', ~$<sigil> ~ $<desigilname>], $/);
$global_fallback.viviself(PAST::Op.new(
'Contextual ' ~ ~$/ ~ ' not found',
:pirop('die')
));
$past := PAST::Var.new(
:name(~@name.pop), :scope('contextual'),
:viviself($global_fallback)
);
}
elsif $<twigil>[0] eq '!' {
# Construct PAST.
my $name := ~@name.pop;
my $ch := $*PKGDECL eq 'role' ?? PAST::Var.new( :name('$?CLASS') ) !! $*W.get_ref($*PACKAGE);
$ch<has_compile_time_value> := 1;
$ch<compile_time_value> := $*PACKAGE;
$past := PAST::Var.new(
:name($name), :scope('attribute_6model'),
:viviself( vivitype( $<sigil> ) ),
PAST::Op.new( :pirop('nqp_decontainerize PP'), PAST::Var.new( :name('self') ) ),
$ch
);
# Make sure the attribute exists and add type info.
unless $*IN_DECL {
my $attr;
for $*PACKAGE.HOW.attributes($*PACKAGE, :local(1)) {
if $_.name eq $name {
$attr := $_;
last;
}
}
if nqp::defined($attr) {
if nqp::can($attr, 'type') {
$past.type($attr.type);
}
}
else {
$/.CURSOR.panic("Attribute '$name' not declared");
}
}
}
elsif $*W.is_package(~@name[0]) {
$past := lexical_package_lookup(@name, $/);
$past.viviself( vivitype( $<sigil> ) );
}
else {
$past := PAST::Var.new(
:name(~@name.pop), :viviself( vivitype( $<sigil> ) )
);
}
}
make $past;
}
method package_declarator:sym<module>($/) { make $<package_def>.ast }
method package_declarator:sym<knowhow>($/) { make $<package_def>.ast }
method package_declarator:sym<class>($/) { make $<package_def>.ast }
method package_declarator:sym<grammar>($/) { make $<package_def>.ast }
method package_declarator:sym<role>($/) { make $<package_def>.ast }
method package_declarator:sym<native>($/) { make $<package_def>.ast }
method package_declarator:sym<stub>($/) {
# Construct meta-object with specified metaclass, adding it to the
# serialization context for this compilation unit.
my $HOW := $*W.find_sym($<metaclass><identifier>);
my $PACKAGE := $*W.pkg_create_mo($HOW, :name(~$<name>));
# Install it in the current package or current lexpad as needed.
if $*SCOPE eq 'our' || $*SCOPE eq '' {
$*W.install_package_symbol($*OUTERPACKAGE, $<name><identifier>, $PACKAGE);
if +$<name><identifier> == 1 {
$*W.install_lexical_symbol($*W.cur_lexpad(), $<name><identifier>[0], $PACKAGE);
}
}
elsif $*SCOPE eq 'my' {
if +$<name><identifier> != 1 {
$<name>.CURSOR.panic("A my scoped package cannot have a multi-part name yet");
}
$*W.install_lexical_symbol($*W.cur_lexpad(), $<name><identifier>[0], $PACKAGE);
}
else {
$/.CURSOR.panic("$*SCOPE scoped packages are not supported");
}
make PAST::Stmts.new();
}
method package_def($/) {
# Get name and meta-object.
my @ns := nqp::clone($<name><identifier>);
my $name := ~@ns.pop;
my $how := %*HOW{$*PKGDECL};
# Get the body code.
my $past := $<block> ?? $<block>.ast !! $<comp_unit>.ast;
if $*SCOPE eq 'our' || $*SCOPE eq '' {
$past.namespace( $<name><identifier> );
}
# Evaluate everything in the package in-line unless this is a generic
# type in which case it needs delayed evaluation. Normally, $?CLASS is
# a fixed lexical, but for generic types it becomes a parameter. Also
# for parametric types, pass along the role body block.
if nqp::can($how, 'parametric') && $how.parametric($how) {
$past.blocktype('declaration');
$past.unshift(PAST::Var.new( :name('$?CLASS'), :scope('parameter'),
:directaccess(1) ));
$past.symbol('$?CLASS', :scope('lexical'));
$*W.pkg_set_body_block($*PACKAGE, $past);
$*W.install_lexical_symbol($past, '$?PACKAGE', $*PACKAGE);
$*W.install_lexical_symbol($past, '$?ROLE', $*PACKAGE);
}
else {
$past.blocktype('immediate');
$*W.install_lexical_symbol($past, '$?PACKAGE', $*PACKAGE);
$*W.install_lexical_symbol($past, '$?CLASS', $*PACKAGE);
}
# Add parent, if we have one; otherwise set default.
if $<parent> {
my $parent;
my $parent_found;
try {
$parent := $*W.find_sym(nqp::clone($<parent>[0]<identifier>));
$parent_found := 1;
}
if $parent_found {
$*W.pkg_add_parent_or_role($*PACKAGE, "add_parent", $parent);
}
else {
$/.CURSOR.panic("Could not find parent class '" ~ ~$<parent>[0] ~ "'");
}
}
elsif nqp::can($how, 'set_default_parent') {
my $default := $*PKGDECL eq 'grammar' ?? ['NQPCursor'] !! ['NQPMu'];
$*W.pkg_add_parent_or_role($*PACKAGE, "set_default_parent",
$*W.find_sym($default));
}
# Add any done roles.
if $<role> {
for $<role> {
my $role;
my $role_found;
try {
$role := $*W.find_sym(nqp::clone($_<identifier>));
$role_found := 1;
}
if $role_found {
$*W.pkg_add_parent_or_role($*PACKAGE, "add_role", $role);
}
else {
$/.CURSOR.panic("Could not find role '" ~ ~$_ ~ "'");
}
}
}
# Finally, compose.
$*W.pkg_compose($*PACKAGE);
make $past;
}
method scope_declarator:sym<my>($/) { make $<scoped>.ast; }
method scope_declarator:sym<our>($/) { make $<scoped>.ast; }
method scope_declarator:sym<has>($/) { make $<scoped>.ast; }
method scoped($/) {
make $<declarator> ?? $<declarator>.ast !!
$<multi_declarator> ?? $<multi_declarator>.ast !!
$<package_declarator>.ast;
}
method declarator($/) {
make $<routine_declarator>
?? $<routine_declarator>.ast
!! $<variable_declarator>.ast;
}
method multi_declarator:sym<multi>($/) { make $<declarator> ?? $<declarator>.ast !! $<routine_def>.ast }
method multi_declarator:sym<proto>($/) { make $<declarator> ?? $<declarator>.ast !! $<routine_def>.ast }
method multi_declarator:sym<null>($/) { make $<declarator>.ast }
method variable_declarator($/) {
my $past := $<variable>.ast;
my $sigil := $<variable><sigil>;
my $name := $past.name;
my $BLOCK := $*W.cur_lexpad();
if $name && $BLOCK.symbol($name) {
$/.CURSOR.panic("Redeclaration of symbol ", $name);
}
if $*SCOPE eq 'has' {
# Locate the type of meta-attribute we need.
unless nqp::existskey(%*HOW, $*PKGDECL ~ '-attr') {
$/.CURSOR.panic("$*PKGDECL packages do not support attributes");
}
# Set up arguments for meta-attribute instantiation.
my %lit_args;
my %obj_args;
%lit_args<name> := $name;
if $<typename> {
%obj_args<type> := $*W.find_sym([~$<typename>[0]]);
}
# Add it.
$*W.pkg_add_attribute($*PACKAGE, %*HOW{$*PKGDECL ~ '-attr'},
%lit_args, %obj_args);
$past := PAST::Stmts.new();
}
elsif $*SCOPE eq 'our' {
# Depending on if this was already considered our scoped,
# we may or may not have got a node in $var that's set up
# right already. We build it here just to be sure.
$name := ~$<variable>;
$past := lexical_package_lookup([$name], $/);
$past.viviself( vivitype($sigil) );
$BLOCK.symbol($name, :scope('package') );
}
else {
$BLOCK[0].push(PAST::Var.new(
:name($name), :scope('lexical'), :isdecl(1), :directaccess(1),
:lvalue(1), :viviself( vivitype($sigil) ),
:node($/)
));
$BLOCK.symbol($name, :scope('lexical') );
}
# Apply traits.
make $past;
if $<trait> {
for $<trait> { $_.ast()($/); }
}
}
method routine_declarator:sym<sub>($/) { make $<routine_def>.ast; }
method routine_declarator:sym<method>($/) { make $<method_def>.ast; }
method routine_def($/) {
# If it's just got * as a body, make a multi-dispatch enterer.
# Otherwise, need to build a sub.
my $past;
if $<onlystar> {
$past := only_star_block();
}
else {
$past := $<blockoid>.ast;
$past.blocktype('declaration');
if $*RETURN_USED {
$past.control('return_pir');
}
}
my $block := $past;
if $<deflongname> {
my $name := ~$<sigil>[0] ~ $<deflongname>[0].ast;
$past.name($name);
if $*SCOPE eq '' || $*SCOPE eq 'my' || $*SCOPE eq 'our' {
if $*MULTINESS eq 'multi' {
# Does the current block have a candidate holder in place?
if $*SCOPE eq 'our' { nqp::die('our-scoped multis not yet implemented') }
my $cholder;
my %sym := $*W.cur_lexpad().symbol($name);
if %sym<cholder> {
$cholder := %sym<cholder>;
}
# Otherwise, no candidate holder, so add one.
else {
# Check we have a proto in scope.
if %sym<proto> {
# WTF, a proto is in this scope, but didn't set up a
# candidate holder?!
$/.CURSOR.panic('Internal Error: Current scope has a proto, but no candidate list holder was set up. (This should never happen.)');
}
my $found_proto;
for $*W.get_legacy_block_list() {
my %sym := $_.symbol($name);
if %sym<proto> || %sym<cholder> {
$found_proto := 1;
}
elsif %sym {
$/.CURSOR.panic("Cannot declare a multi when an only is already in scope.");
}
}
# If we didn't find a proto, error for now.
unless $found_proto {
$/.CURSOR.panic("Sorry, no proto sub in scope, and auto-generation of protos is not yet implemented.");
}
# Set up dispatch routine in this scope.
my $BLOCK := $*W.cur_lexpad();
$cholder := PAST::Op.new( :pasttype('list') );
my $dispatch_setup := PAST::Op.new(
:pirop('create_dispatch_and_add_candidates PPP'),
PAST::Var.new( :name($name), :scope('outer') ),
$cholder
);
$BLOCK[0].push(PAST::Var.new( :name($name), :isdecl(1), :directaccess(1),
:viviself($dispatch_setup), :scope('lexical') ) );
$BLOCK.symbol($name, :scope('lexical'), :cholder($cholder) );
}
# Add this candidate to the holder.
$cholder.push($past);
# Build a type signature object for the multi-dispatcher to use.
attach_multi_signature_to_parrot_sub($past);
}
elsif $*MULTINESS eq 'proto' {
# Create a candidate list holder for the dispatchees
# this proto will work over, and install them along
# with the proto.
if $*SCOPE eq 'our' { nqp::die('our-scoped protos not yet implemented') }
my $cholder := PAST::Op.new( :pasttype('list') );
my $BLOCK := $*W.cur_lexpad();
$BLOCK[0].push(PAST::Var.new( :name($name), :isdecl(1), :directaccess(1),
:viviself($past), :scope('lexical') ) );
$BLOCK[0].push(PAST::Op.new(
:pirop('set_dispatchees 0PP'),
PAST::Var.new( :name($name) ),
$cholder
));
$BLOCK.symbol($name, :scope('lexical'), :proto(1), :cholder($cholder) );
# Need it to be a DispatcherSub.
$past.pirflags(':instanceof("DispatcherSub")');
}
else {
my $BLOCK := $*W.cur_lexpad();
$BLOCK[0].push(PAST::Var.new( :name($name), :isdecl(1), :directaccess(1),
:viviself($past), :scope('lexical') ) );
$BLOCK.symbol($name, :scope('lexical') );
if $*SCOPE eq 'our' {
# Need to install it at loadinit time but also re-bind
# it per invocation.
$*W.install_package_routine($*PACKAGE, $name, $past);
$BLOCK[0].push(PAST::Op.new(
:pasttype('bind_6model'),
lexical_package_lookup([$name], $/),
PAST::Var.new( :name($name), :scope('lexical') )
));
}
}
$past := PAST::Var.new( :name($name) );
}
else {
$/.CURSOR.panic("$*SCOPE scoped routines are not supported yet");
}
# Is it the MAIN sub?
if $name eq 'MAIN' && $*MULTINESS ne 'multi' {
$*MAIN_SUB := $block;
}
}
else {
if $*W.is_precompilation_mode() {
$*W.create_code($past, '<anon>', 0)
}
}
# Apply traits.
$past<block_past> := $block;
if $<trait> {
for $<trait> { $_.ast()($/); }
}
make $past;
}
method method_def($/) {
# If it's just got * as a body, make a multi-dispatch enterer.
# Otherwise, build method block PAST.
my $past;
if $<onlystar> {
$past := only_star_block();
}
else {
$past := $<blockoid>.ast;
$past.blocktype('declaration');
if $*RETURN_USED {
$past.control('return_pir');
}
}
# Always need an invocant.
unless $past<signature_has_invocant> {
$past[0].unshift(PAST::Var.new(
:name('self'), :scope('parameter'), :directaccess(1),
:multitype($*W.get_ref($*PACKAGE))
));
}
$past.symbol('self', :scope('lexical') );
# Install it where it should go (methods table / namespace).
if $<deflongname> {
# Set name.
my $name := ~$<private> ~ ~$<deflongname>[0].ast;
$past.name($name);
# Insert it into the method table.
my $meta_meth := $*MULTINESS eq 'multi' ?? 'add_multi_method' !! 'add_method';
my $is_dispatcher := $*MULTINESS eq 'proto';
my $code := $*W.create_code($past, $name, $is_dispatcher);
if $*MULTINESS eq 'multi' { attach_multi_signature($code, $past); }
$*W.pkg_add_method($*PACKAGE, $meta_meth, $name, $code);
# Install it in the package also if needed.
if $*SCOPE eq 'our' {
$*W.install_package_routine($*PACKAGE, $name, $past);
} else {
if $past.pirflags() {
$past.pirflags(~$past.pirflags() ~ ":anon");
} else {
$past.pirflags(":anon");
}
}
}
# Install AST node in match object, then apply traits.
make $past;
$past<block_past> := $past;
if $<trait> {
for $<trait> { $_.ast()($/); }
}
}
sub only_star_block() {
my $past := $*W.pop_lexpad();
$past.closure(1);
$past.push(PAST::Op.new(
:pirop('multi_dispatch_over_lexical_candidates P')
));
$past
}
sub attach_multi_signature($code_obj, $routine) {
my $types := nqp::list();
my $definednesses := nqp::list();
for @($routine[0]) {
if $_ ~~ PAST::Var && $_.scope eq 'parameter' {
$types.push($_.multitype ?? ($_.multitype())<compile_time_value> !! nqp::null() );
$definednesses.push($_<definedness> eq 'D' ?? 1 !!
$_<definedness> eq 'U' ?? 2 !! 0);
}
}
$*W.set_routine_signature($code_obj, $types, $definednesses);
}
sub attach_multi_signature_to_parrot_sub($routine) {
# Use set_sub_multisig op to set up a multi sig. Note that we stick
# it in the same slot Parrot multis use for their multi signature,
# this is just a bit more complex than what Parrot needs.
my $types := nqp::list();
my $definednesses := nqp::list();
for @($routine[0]) {
if $_ ~~ PAST::Var && $_.scope eq 'parameter' {
$types.push($_.multitype ?? ($_.multitype())<compile_time_value> !! nqp::null() );
$definednesses.push($_<definedness> eq 'D' ?? 1 !!
$_<definedness> eq 'U' ?? 2 !! 0);
}
}
$*W.set_routine_signature_on_parrot_sub($routine, $types, $definednesses);
}
method signature($/) {
my $BLOCK := $*W.cur_lexpad();
my $BLOCKINIT := $BLOCK[0];
if $<invocant> {
my $inv := $<invocant>[0].ast;
$BLOCKINIT.push($inv);
$BLOCKINIT.push(PAST::Var.new(
:name('self'), :scope('lexical'), :isdecl(1), :directaccess(1),
:viviself(PAST::Var.new( :scope('lexical'), :name($inv.name) ))
));
$BLOCK<signature_has_invocant> := 1
}
for $<parameter> { $BLOCKINIT.push($_.ast); }
}
method parameter($/) {
my $quant := $<quant>;
my $past;
if $<named_param> {
$past := $<named_param>.ast;
if $quant ne '!' {
$past.viviself( vivitype($<named_param><param_var><sigil>) );
}
}
else {
$past := $<param_var>.ast;
if $quant eq '*' {
$past.slurpy(1);
$past.named( $<param_var><sigil> eq '%' );
}
elsif $quant eq '?' {
$past.viviself( vivitype($<param_var><sigil>) );
}
}
if $<default_value> {
if $quant eq '*' {
$/.CURSOR.panic("Can't put default on slurpy parameter");
}
if $quant eq '!' {
$/.CURSOR.panic("Can't put default on required parameter");
}
$past.viviself( $<default_value>[0]<EXPR>.ast );
}
unless $past.viviself { $*W.cur_lexpad().arity( +$*W.cur_lexpad().arity + 1 ); }
# Note: this is hijacking multitype a bit here comapred to what it was
# originally used for (a textual name). But it's ignored
if $<typename> {
$past.multitype($<typename>[0].ast);
}
# Set definedness flag (XXX want a better way to do this).
if $<definedness> {
$past<definedness> := ~$<definedness>[0];
}
make $past;
}
method param_var($/) {
my $name := ~$/;
my $past := PAST::Var.new( :name($name), :scope('parameter'),
:isdecl(1), :directaccess(1), :node($/) );
$*W.cur_lexpad().symbol($name, :scope('lexical') );
make $past;
}
method named_param($/) {
my $past := $<param_var>.ast;
$past.named( ~$<param_var><name> );
make $past;
}
method typename($/) {
# Try to locate the symbol. We'll emit a lookup via the SC so
# the scope we emit code to do the symbol lookup in won't matter,
# and so we can complain about non-existent type names.
my @name := HLL::Compiler.parse_name(~$/);
my $found := 0;
try {
my $sym := $*W.find_sym(@name);
make $*W.get_ref($sym);
$found := 1;
}
unless $found {
$/.CURSOR.panic("Use of undeclared type '" ~ ~$/ ~ "'");
}
}
method trait($/) {
make $<trait_mod>.ast;
}
method trait_mod:sym<is>($/) {
if $<longname> eq 'parrot_vtable' {
# XXX This should be in Parrot-specific module and need a pragma.
my $cpast := $<circumfix>[0].ast;
$/.CURSOR.panic("Trait 'parrot_vtable' requires constant scalar argument")
unless $cpast ~~ PAST::Val;
my $name := $cpast.value;
my $package := $*PACKAGE;
my $is_dispatcher := $*SCOPE eq 'proto';
make -> $match {
$*W.pkg_add_method($package, 'add_parrot_vtable_mapping', $name,
$*W.create_code($match.ast<block_past>, $name, $is_dispatcher));
};
}
elsif $<longname> eq 'parrot_vtable_handler' {
# XXX This should be in Parrot-specific module and need a pragma.
my $cpast := $<circumfix>[0].ast;
$/.CURSOR.panic("Trait 'parrot_vtable_handler' requires constant scalar argument")
unless $cpast ~~ PAST::Val;
my $name := $cpast.value;
my $package := $*PACKAGE;
make -> $match {
$*W.pkg_add_parrot_vtable_handler_mapping($package, $name, ~$match<variable>);
};
}
elsif $<longname> eq 'pirflags' {
$/.CURSOR.panic("Trait 'pirflags' no longer supported; use 'is vtable'");
}
else {
$/.CURSOR.panic("Trait '$<longname>' not implemented");
}
}
method regex_declarator($/, $key?) {
my $name := ~$<deflongname>.ast;
my $past;
if $<proto> {
$past :=
PAST::Stmts.new(
PAST::Block.new( :name($name),
PAST::Op.new(
PAST::Var.new( :name('self'), :scope('parameter') ),
$name,
:name('!protoregex'),
:pasttype('callmethod')
),
:blocktype('declaration'),
:lexical(0),
:node($/)
),
);
for @($past) {
$*W.pkg_add_method($*PACKAGE, 'add_method', $_.name(), $*W.create_code($_, $_.name(), 0));
}
}
else {
my $block := $*W.pop_lexpad();
$block[0].unshift(PAST::Var.new(:name<self>, :scope<parameter>));
$block[0].push(
PAST::Var.new(:name<self>, :scope<register>, :isdecl(1),
:viviself(PAST::Var.new( :name<self>, :scope('lexical_6model') ))));
$block[0].push(PAST::Var.new(:name<$¢>, :scope<lexical>, :isdecl(1)));
$block[0].push(PAST::Var.new(:name<$/>, :scope<lexical>, :isdecl(1)));
$block.symbol('', :scope<lexical>);
$block.symbol('$/', :scope<lexical>);
my $regex := QRegex::P6Regex::Actions::buildsub($<p6regex>.ast, $block);
$regex.name($name);
if $*PKGDECL && nqp::can($*PACKAGE.HOW, 'add_method') {
# Add the actual method.
$*W.pkg_add_method($*PACKAGE, 'add_method', $name, $*W.create_code($regex, $name, 0));
}
# In sink context, we don't need the Regex::Regex object.
$past := PAST::Op.new(
:pasttype<callmethod>, :name<new>,
lexical_package_lookup(['NQPRegexMethod'], $/),
$regex);
$past<sink> := $regex;
}
make $past;
}
method dotty($/) {
my $past := $<args> ?? $<args>[0].ast !! PAST::Op.new( :node($/) );
if $<quote> {
$past.name($<quote>.ast);
$past.pasttype('callmethod');
}
elsif $<longname> eq 'HOW' {
$past.pirop('get_how PP');
}
elsif $<longname> eq 'WHAT' {
$past.pirop('get_what PP');
}
elsif $<longname> eq 'WHO' {
$past.pirop('get_who PP');
}
elsif $<longname> eq 'REPR' {
$past.pirop('repr_name SP');
}
else {
$past.name(~$<longname>);
$past.pasttype('callmethod');
}
make $past;
}
## Terms
method term:sym<self>($/) {
make PAST::Op.new( :pirop('nqp_decontainerize PP'),
PAST::Var.new( :name('self') ) );
}
method term:sym<identifier>($/) {
my $past := $<args>.ast;
$past.name(~$<deflongname>);
make $past;
}
method term:sym<name>($/) {
# See if it's a lexical symbol (known in any outer scope).
my $var;
if $*W.is_lexical(~$<name>) {
$var := PAST::Var.new( :name(~$<name>), :scope('lexical') );
}
else {
my @ns := nqp::clone($<name><identifier>);
$var := lexical_package_lookup(@ns, $/);
}
# If it's a call, add the arguments.
my $past := $var;
if $<args> {
$past := $<args>[0].ast;
$past.unshift($var);
}
make $past;
}
method term:sym<pir::op>($/) {
my $past := $<args> ?? $<args>[0].ast !! PAST::Op.new( :node($/) );
my $pirop := ~$<op>;
$pirop := nqp::join(' ', nqp::split('__', $pirop));
$past.pirop($pirop);
$past.pasttype('pirop');
make $past;
}
method term:sym<pir::const>($/) {
make PAST::Val.new( :value(~$<const>), :returns<!macro_const>, :node($/) );
}
method term:sym<nqp::op>($/) {
my $op := ~$<op>;
my $args := $<args> ?? $<args>[0].ast.list !! [];
my $past := PAST::Node.'map_node'(|$args, :map<nqp>, :op($op),
:node($/));
nqp::defined($past) ||
$/.CURSOR.panic("Unrecognized nqp:: opcode 'nqp::$op'");
make $past;
}
method term:sym<onlystar>($/) {
make PAST::Op.new(
:pirop('multi_dispatch_over_lexical_candidates P')
);
}
method args($/) { make $<arglist>.ast; }
method arglist($/) {
my $past := PAST::Op.new( :pasttype('call'), :node($/) );
if $<EXPR> {
my $expr := $<EXPR>.ast;
if $expr.name eq '&infix:<,>' && !$expr.named {
for $expr.list { $past.push($_); }
}
else { $past.push($expr); }
}
my $i := 0;
my $n := +$past.list;
while $i < $n {
if $past[$i].name eq '&prefix:<|>' {
$past[$i] := $past[$i][0];
$past[$i].flat(1);
if $past[$i].isa(PAST::Val)
&& nqp::substr($past[$i].name, 0, 1) eq '%' {
$past[$i].named(1);
}
}
$i++;
}
make $past;
}
method term:sym<multi_declarator>($/) { make $<multi_declarator>.ast; }
method term:sym<value>($/) { make $<value>.ast; }
method circumfix:sym<( )>($/) {
make $<EXPR>
?? $<EXPR>[0].ast
!! PAST::Op.new( :pasttype('list'), :node($/) );
}
method circumfix:sym<[ ]>($/) {
my $past;
if $<EXPR> {
$past := $<EXPR>[0].ast;
if $past.name ne '&infix:<,>' {
$past := PAST::Op.new( $past, :pasttype('list') );
}
}
else {
$past := PAST::Op.new( :pasttype('list') );
}
$past.name('&circumfix:<[ ]>');
make $past;
}
method circumfix:sym<ang>($/) { make $<quote_EXPR>.ast; }
method circumfix:sym<« »>($/) { make $<quote_EXPR>.ast; }
method circumfix:sym<{ }>($/) {
if +$<pblock><blockoid><statementlist><statement> > 0 {
my $past := $<pblock>.ast;
$past<bareblock> := 1;
make $past;
}
elsif $<pblock><blockoid><you_are_here> {
make $<pblock>.ast;
}
else {
make vivitype('%');
}
}
method circumfix:sym<sigil>($/) {
my $name := ~$<sigil> eq '@' ?? 'list' !!
~$<sigil> eq '%' ?? 'hash' !!
'item';
make PAST::Op.new( :pasttype('callmethod'), :name($name), $<semilist>.ast );
}
method semilist($/) { make $<statement>.ast }
method postcircumfix:sym<[ ]>($/) {
make PAST::Var.new( $<EXPR>.ast , :scope('keyed_int'),
:viviself('Undef'),
:vivibase(vivitype('@')) );
}
method postcircumfix:sym<{ }>($/) {
make PAST::Var.new( $<EXPR>.ast , :scope('keyed'),
:viviself('Undef'),
:vivibase(vivitype('%')) );
}
method postcircumfix:sym<ang>($/) {
make PAST::Var.new( $<quote_EXPR>.ast, :scope('keyed'),
:viviself('Undef'),
:vivibase(vivitype('%')) );
}
method postcircumfix:sym<( )>($/) {
make $<arglist>.ast;
}
method value($/) {
make $<quote> ?? $<quote>.ast !! $<number>.ast;
}
method number($/) {
my $value := $<dec_number> ?? $<dec_number>.ast !! $<integer>.ast;
if ~$<sign> eq '-' { $value := -$value; }
make $<dec_number> ??
PAST::Val.new( :value($value) ) !!
PAST::Want.new( PAST::Val.new( :value($value) ), 'Ii', $value );
}
method quote:sym<apos>($/) { make $<quote_EXPR>.ast; }
method quote:sym<dblq>($/) { make $<quote_EXPR>.ast; }
method quote:sym<qq>($/) { make $<quote_EXPR>.ast; }
method quote:sym<q>($/) { make $<quote_EXPR>.ast; }
method quote:sym<Q>($/) { make $<quote_EXPR>.ast; }
method quote:sym<Q:PIR>($/) {
make PAST::Op.new( :inline( $<quote_EXPR>.ast.value ),
:pasttype('inline'),
:node($/) );
}
method quote:sym</ />($/) {
my $block := $*W.pop_lexpad();
$block[0].push(PAST::Var.new(:name<self>, :scope<parameter>));
$block[0].push(
PAST::Var.new(:name<self>, :scope<register>, :isdecl(1),
:viviself(PAST::Var.new( :name<self>, :scope('lexical_6model') ))));
$block[0].push(PAST::Var.new(:name<$¢>, :scope<lexical>, :isdecl(1)));
$block[0].push(PAST::Var.new(:name<$/>, :scope<lexical>, :isdecl(1)));
$block.symbol('', :scope<lexical>);
$block.symbol('$/', :scope<lexical>);
my $regex := QRegex::P6Regex::Actions::buildsub($<p6regex>.ast, $block);
my $past := PAST::Op.new(
:pasttype<callmethod>, :name<new>,
lexical_package_lookup(['NQPRegex'], $/),
$regex);
# In sink context, we don't need the Regex::Regex object.
$past<sink> := $regex;
make $past;
}
method quote_escape:sym<$>($/) { make $<variable>.ast; }
method quote_escape:sym<{ }>($/) {
make PAST::Op.new(
:pirop('set S*'), block_immediate($<block>.ast), :node($/)
);
}
method quote_escape:sym<esc>($/) { make "\c[27]"; }
## Operators
method postfix:sym<.>($/) { make $<dotty>.ast; }
method postfix:sym<++>($/) {
make PAST::Op.new( :name('postfix:<++>'),
:inline(' clone %r, %0', ' inc %0'),
:pasttype('inline') );
}
method postfix:sym<-->($/) {
make PAST::Op.new( :name('postfix:<-->'),
:inline(' clone %r, %0', ' dec %0'),
:pasttype('inline') );
}
method prefix:sym<make>($/) {
make PAST::Op.new(
PAST::Var.new( :name('$/'), :scope('contextual') ),
:pasttype('callmethod'),
:name('!make'),
:node($/)
);
}
sub control($/, $type) {
make PAST::Op.new(
:node($/),
:pirop('die__vii'),
0,
PAST::Val.new( :value($type), :returns<!macro_const> )
);
}
method term:sym<next>($/) { control($/, 'CONTROL_LOOP_NEXT') }
method term:sym<last>($/) { control($/, 'CONTROL_LOOP_LAST') }
method term:sym<redo>($/) { control($/, 'CONTROL_LOOP_REDO') }
method infix:sym<~~>($/) {
make PAST::Op.new( :pasttype<callmethod>, :name<ACCEPTS>, :node($/) );
}
# Takes a multi-part name that we know is in a package and generates
# PAST to look it up using NQP package semantics.
sub lexical_package_lookup(@name, $/) {
# Catch empty names and die helpfully.
if +@name == 0 { $/.CURSOR.panic("Cannot compile empty name"); }
# The final lookup will always be just a keyed access to a
# symbol table.
my $final_name := @name.pop();
my $lookup := 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 {
$lookup.unshift(PAST::Op.new(
:pirop('get_who PP'),
PAST::Var.new( :name('$?PACKAGE'), :scope('lexical') )
));
$lookup.viviself(PAST::Var.new(
:scope('keyed'),
PAST::Op.new(
:pirop('get_who PP'),
PAST::Var.new( :name('GLOBAL'), :namespace([]), :scope('package') )
),
~$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.
else {
my $path := $*W.is_lexical(@name[0]) ??
PAST::Var.new( :name(@name.shift()), :scope('lexical') ) !!
PAST::Var.new( :name('GLOBAL'), :namespace([]), :scope('package') );
if @name[0] eq 'GLOBAL' {
@name.shift();
}
for @name {
$path := PAST::Op.new(
:pirop('nqp_get_package_through_who PPs'),
$path, ~$_);
}
$lookup.unshift(PAST::Op.new(:pirop('get_who PP'), $path));
}
return $lookup;
}
}
class NQP::RegexActions is QRegex::P6Regex::Actions {
method metachar:sym<:my>($/) {
my $past := $<statement>.ast;
make QAST::Regex.new( $past,
:rxtype('pastnode'), :subtype('declarative'), :node($/) );
}
method metachar:sym<{ }>($/) {
make QAST::Regex.new( $<codeblock>.ast,
:rxtype<pastnode>, :node($/) );
}
method metachar:sym<nqpvar>($/) {
make QAST::Regex.new( PAST::Node.new('!INTERPOLATE', $<var>.ast),
:rxtype<subrule>, :subtype<method>, :node($/));
}
method assertion:sym<{ }>($/) {
make QAST::Regex.new( PAST::Node.new('!INTERPOLATE_REGEX', $<codeblock>.ast),
:rxtype<subrule>, :subtype<method>, :node($/));
}
method assertion:sym<?{ }>($/) {
make QAST::Regex.new( $<codeblock>.ast,
:subtype<zerowidth>, :negate( $<zw> eq '!' ),
:rxtype<pastnode>, :node($/) );
}
method assertion:sym<var>($/) {
make QAST::Regex.new( PAST::Node.new('!INTERPOLATE_REGEX', $<var>.ast),
:rxtype<subrule>, :subtype<method>, :node($/));
}
method codeblock($/) {
my $block := $<block>.ast;
$block.blocktype('immediate');
my $past :=
PAST::Stmts.new(
PAST::Op.new(
PAST::Var.new( :name('$/') ),
PAST::Op.new(
PAST::Var.new( :name('') ),
:name('MATCH'),
:pasttype('callmethod')
),
:pasttype('bind_6model')
),
$block
);
make $past;
}
}
Jump to Line
Something went wrong with that request. Please try again.