Skip to content

Commit

Permalink
Merge remote-tracking branch 'rakudo/nom' into nom
Browse files Browse the repository at this point in the history
  • Loading branch information
Salve J. Nilsen committed Sep 2, 2012
2 parents 558f0de + 957a680 commit 103e95a
Show file tree
Hide file tree
Showing 32 changed files with 196 additions and 158 deletions.
5 changes: 1 addition & 4 deletions docs/ROADMAP
@@ -1,7 +1,7 @@
Rakudo Roadmap
--------------

Last updated: 2012-08-19
Last updated: 2012-09-01

This document serves as a guide to the major goals for Rakudo
development, as things stood in December 2011. They have been
Expand All @@ -28,7 +28,6 @@ remove completed ones, re-prioritize, volunteer for a goal,
rescue yourself from a goal, etc.

Compiler Performance/Portability Improvements (jnthn)
2 ***** design, implement and switch to QAST
2 ** finish up any remaining s/pir::/nqp::/
2 ? re-organize Rakudo, build process, etc. for multi-backend
3 ** Optimizing multis for `[+] 1..10` and `[<=] 1..10` etc.
Expand Down Expand Up @@ -105,5 +104,3 @@ STD Convergence (needs more exploration)

Other things (to be organized into above groups)
3 ? AUTOLOAD, including possibly AUTOLOADING setting components


24 changes: 13 additions & 11 deletions src/Perl6/Actions.pm
Expand Up @@ -33,7 +33,7 @@ class Perl6::Actions is HLL::Actions {
}

method ints_to_string($ints) {
if pir::does($ints, 'array') {
if nqp::islist($ints) {
my $result := '';
for $ints {
$result := $result ~ nqp::chr(nqp::unbox_i($_.ast));
Expand Down Expand Up @@ -1262,7 +1262,7 @@ class Perl6::Actions is HLL::Actions {
HLL::Compiler.lineof($/.orig, $/.from ));
}
else {
$past := $*W.add_string_constant(pir::find_caller_lex__ps('$?FILES') // '<unknown file>');
$past := $*W.add_string_constant(pir::find_caller_lex__Ps('$?FILES') // '<unknown file>');
}
}
elsif +@name > 1 {
Expand Down Expand Up @@ -3098,8 +3098,10 @@ class Perl6::Actions is HLL::Actions {

# Create parameter object and apply any traits.
my $param_obj := $*W.create_parameter($_);
for $_<traits> {
($_.ast)($param_obj) if $_.ast;
if $_<traits> {
for $_<traits> {
($_.ast)($param_obj) if $_.ast;
}
}

# Add it to the signature.
Expand Down Expand Up @@ -4573,7 +4575,7 @@ class Perl6::Actions is HLL::Actions {
my $int := $<int> ?? filter_number(~$<int>) !! "0";
my $frac := $<frac> ?? filter_number(~$<frac>) !! "0";
if $<escale> {
my $e := pir::isa($<escale>, 'ResizablePMCArray') ?? $<escale>[0] !! $<escale>;
my $e := nqp::islist($<escale>) ?? $<escale>[0] !! $<escale>;
# pir::say('dec_number exponent: ' ~ ~$e.ast);
make radcalc($/, 10, $<coeff>, 10, nqp::unbox_i($e.ast), :num);
} else {
Expand Down Expand Up @@ -4635,10 +4637,10 @@ class Perl6::Actions is HLL::Actions {
}
}

our %SUBST_ALLOWED_ADVERBS ;
our %SHARED_ALLOWED_ADVERBS;
our %MATCH_ALLOWED_ADVERBS;
our %MATCH_ADVERBS_MULTIPLE := hash(
my %SUBST_ALLOWED_ADVERBS;
my %SHARED_ALLOWED_ADVERBS;
my %MATCH_ALLOWED_ADVERBS;
my %MATCH_ADVERBS_MULTIPLE := hash(
x => 1,
g => 1,
global => 1,
Expand All @@ -4647,7 +4649,7 @@ class Perl6::Actions is HLL::Actions {
ex => 1,
exhaustive => 1,
);
our %REGEX_ADVERBS_CANONICAL := hash(
my %REGEX_ADVERBS_CANONICAL := hash(
ignorecase => 'i',
ratchet => 'r',
sigspace => 's',
Expand Down Expand Up @@ -5300,7 +5302,7 @@ class Perl6::Actions is HLL::Actions {
# %curried == 1 means curry WhateverCode only
# %curried == 2 means curry both WhateverCode and Whatever (default)

our %curried;
my %curried;
INIT {
%curried{'&infix:<...>'} := 0;
%curried{'&infix:<...^>'} := 0;
Expand Down
8 changes: 4 additions & 4 deletions src/Perl6/Compiler.nqp
Expand Up @@ -10,9 +10,9 @@ class Perl6::Compiler is HLL::Compiler {

my $hll_ns := pir::get_root_global__Ps('perl6');
my $argiter := nqp::iterator(@args);
nqp::shift($argiter) if $argiter && !pir::defined(%options<e>);
nqp::shift($argiter) if $argiter && !nqp::defined(%options<e>);
$hll_ns<$!ARGITER> := $argiter;
my $super := pir::find_method__PPs(HLL::Compiler, 'command_eval');
my $super := nqp::findmethod(HLL::Compiler, 'command_eval');
my %*COMPILING;
%*COMPILING<%?OPTIONS> := %options;
$super(self, |@args, |%options);
Expand All @@ -28,7 +28,7 @@ class Perl6::Compiler is HLL::Compiler {
method syntaxcheck($past, *%adverbs) {
if %adverbs<c> {
say("Syntax OK");
pir::exit__vi(0);
pir::exit__0i(0);
}
$past;
}
Expand Down Expand Up @@ -78,6 +78,6 @@ class Perl6::Compiler is HLL::Compiler {
PERL6LIB=\"lib\" perl6 example.pl
For more information, see the perl6(1) man page.\n");
pir::exit__vi(0);
pir::exit__0i(0);
}
}
30 changes: 20 additions & 10 deletions src/Perl6/Grammar.pm
Expand Up @@ -27,15 +27,15 @@ grammar Perl6::Grammar is HLL::Grammar {
# Symbol table and serialization context builder - keeps track of
# objects that cross the compile-time/run-time boundary that are
# associated with this compilation unit.
my $file := pir::find_caller_lex__ps('$?FILES');
my $file := pir::find_caller_lex__Ps('$?FILES');
my $source_id := nqp::sha1(nqp::getattr_s(self, NQPCursor, '$!target'));
my $*W := nqp::isnull($file) ??
Perl6::World.new(:handle($source_id)) !!
Perl6::World.new(:handle($source_id), :description($file));
$*W.add_initializations();

# XXX Hack: clear any marks.
pir::set_hll_global__vPsP(['HLL', 'Grammar'], '%!MARKHASH', nqp::null());
pir::set_hll_global__vsP('%!MARKHASH', nqp::null());

my $cursor := self.comp_unit;
$*W.pop_lexpad(); # UNIT
Expand Down Expand Up @@ -304,7 +304,9 @@ grammar Perl6::Grammar is HLL::Grammar {


token pod_block:sym<delimited_table> {
^^ \h* '=begin' \h+ 'table'
^^
$<spaces> = [ \h* ]
'=begin' \h+ 'table'
<pod_configuration($<spaces>)> <pod_newline>+
[
<table_row>*
Expand Down Expand Up @@ -344,13 +346,17 @@ grammar Perl6::Grammar is HLL::Grammar {
}

token pod_block:sym<paragraph_raw> {
^^ \h* '=for' \h+ $<type>=[ 'code' | 'comment' ]
^^
$<spaces> = [ \h* ]
'=for' \h+ $<type>=[ 'code' | 'comment' ]
<pod_configuration($<spaces>)> <pod_newline>
$<pod_content> = [ \h* <!before '=' \w> \N+ \n ]+
}

token pod_block:sym<paragraph_table> {
^^ \h* '=for' \h+ 'table'
^^
$<spaces> = [ \h* ]
'=for' \h+ 'table'
<pod_configuration($<spaces>)> <pod_newline>
[ <!before \h* \n> <table_row>]*
}
Expand All @@ -373,13 +379,17 @@ grammar Perl6::Grammar is HLL::Grammar {
}

token pod_block:sym<abbreviated_raw> {
^^ \h* '=' $<type>=[ 'code' | 'comment' ]
^^
$<spaces> = [ \h* ]
'=' $<type>=[ 'code' | 'comment' ]
<pod_configuration($<spaces>)> \s
$<pod_content> = [ \h* <!before '=' \w> \N+ \n ]*
}

token pod_block:sym<abbreviated_table> {
^^ \h* '=table' <pod_configuration($<spaces>)> <pod_newline>
^^
$<spaces> = [ \h* ]
'=table' <pod_configuration($<spaces>)> <pod_newline>
[ <!before \h* \n> <table_row>]*
}

Expand Down Expand Up @@ -499,7 +509,7 @@ grammar Perl6::Grammar is HLL::Grammar {
}
my $M := %*COMPILING<%?OPTIONS><M>;
if nqp::defined($M) {
for pir::does($M, 'array') ?? $M !! [$M] -> $longname {
for nqp::islist($M) ?? $M !! [$M] -> $longname {
my $module := $*W.load_module($/,
$longname,
$*GLOBALish);
Expand Down Expand Up @@ -1159,7 +1169,7 @@ grammar Perl6::Grammar is HLL::Grammar {
}

token special_variable:sym['$<'] {
<sym> <!before \s* \w+ \s* '>' >
<sym> <?before \h* <[ = , ; ? : ! ) \] } ]> <!before \S* '>'> >
<.obs('$< variable', '$*UID')>
}

Expand Down Expand Up @@ -1896,7 +1906,7 @@ grammar Perl6::Grammar is HLL::Grammar {
[ [ ':'?'(' <signature> ')'] | <trait> ]*
'{'[
| ['*'|'<...>'|'<*>'] <?{ $*MULTINESS eq 'proto' }> $<onlystar>={1}
| <p6regex=.LANG(%*RX<P5> ?? 'P5Regex' !! 'Regex','nibbler')>]'}'<?ENDSTMT>
|<p6regex=.LANG(%*RX<P5> ?? 'P5Regex' !! 'Regex','nibbler')>]'}'<?ENDSTMT>
{ $*CURPAD := $*W.pop_lexpad() }
] || <.malformed('regex')>
] }
Expand Down
6 changes: 5 additions & 1 deletion src/Perl6/Metamodel/AttributeContainer.pm
Expand Up @@ -21,12 +21,16 @@ role Perl6::Metamodel::AttributeContainer {
method compose_attributes($obj) {
my %seen_with_accessor;
my %meths := self.method_table($obj);
my %orig_meths;
for %meths {
%orig_meths{$_.key} := 1;
}
for @!attributes {
if $!attr_rw_by_default { $_.default_to_rw() }
if $_.has_accessor() {
my $acc_name := nqp::substr($_.name, 2);
nqp::die("Two or more attributes declared that both want an accessor method '$acc_name'")
if %seen_with_accessor{$acc_name} && !nqp::existskey(%meths, $acc_name);
if %seen_with_accessor{$acc_name} && !nqp::existskey(%orig_meths, $acc_name);
%seen_with_accessor{$acc_name} := 1;
}
$_.compose($obj);
Expand Down
16 changes: 8 additions & 8 deletions src/Perl6/Metamodel/BOOTSTRAP.pm
Expand Up @@ -420,7 +420,7 @@ BEGIN {
my $type := nqp::getattr($self, Parameter, '$!nominal_type');
my $cd := nqp::getattr($self, Parameter, '$!container_descriptor');
my $ins_type := $type.HOW.instantiate_generic($type, $type_environment);
my $ins_cd := $cd ?? $cd.instantiate_generic($type_environment) !! $cd;
my $ins_cd := nqp::isnull($cd) ?? $cd !! $cd.instantiate_generic($type_environment);
unless $ins_type.HOW.archetypes.generic {
my $flags := nqp::getattr_i($ins, Parameter, '$!flags');
if $flags +& $SIG_ELEM_NOMINAL_GENERIC {
Expand Down Expand Up @@ -527,7 +527,7 @@ BEGIN {
Code, '$!do')
}));
Code.HOW.add_method(Code, 'set_name', static(sub ($self, $name) {
pir::assign__vPS(
pir::assign__1PS(
nqp::getattr(pir::perl6_decontainerize__PP($self), Code, '$!do'),
$name)
}));
Expand Down Expand Up @@ -827,14 +827,14 @@ BEGIN {
# If we don't already have a PROCESS, set it up.
my $PROCESS;
my $hll_ns := pir::get_root_global__PS('perl6');
if $hll_ns && nqp::existskey($hll_ns, 'PROCESS') {
if !nqp::isnull($hll_ns) && nqp::existskey($hll_ns, 'PROCESS') {
$PROCESS := $hll_ns<PROCESS>;
}
else {
PROCESS.HOW.compose(PROCESS);
Perl6::Metamodel::ModuleHOW.add_stash(PROCESS);
$hll_ns<PROCESS> := $PROCESS := PROCESS;
pir::set_root_global__vPsP(['perl6'], 'PROCESS', $PROCESS);
$PROCESS := PROCESS;
pir::set_root_global__2PsP(['perl6'], 'PROCESS', $PROCESS);
}

# Bool::False and Bool::True.
Expand Down Expand Up @@ -896,9 +896,9 @@ BEGIN {
EXPORT::DEFAULT.WHO<MultiDispatcher> := Perl6::Metamodel::MultiDispatcher;
EXPORT::DEFAULT.WHO<WrapDispatcher> := Perl6::Metamodel::WrapDispatcher;
EXPORT::DEFAULT.WHO<StaticLexPad> := Perl6::Metamodel::StaticLexPad;
EXPORT::DEFAULT.WHO<NQPCursorRole> := NQPCursorRole;
EXPORT::DEFAULT.WHO<Metamodel> := Metamodel;
}
EXPORT::DEFAULT.WHO<NQPCursorRole> := NQPCursorRole;

# Publish Parrot v-table handler mappings.
Mu.HOW.publish_parrot_vtable_mapping(Mu);
Expand All @@ -922,10 +922,10 @@ Str.HOW.publish_parrot_vtable_handler_mapping(Str);

# Set up various type mappings.
pir::perl6_set_type_packagehow__vP(Perl6::Metamodel::PackageHOW);
pir::perl6_set_types_mu_any__vP(Mu, Any);
pir::perl6_set_types_mu_any__vPP(Mu, Any);
pir::perl6_set_type_code__vP(Code);
pir::perl6_set_types_ins__vPPP(Int, Num, Str);
pir::perl6_set_types_list_array_lol__vPP(List, ListIter, Array, LoL, Parcel);
pir::perl6_set_types_list_array_lol__vPPPPP(List, ListIter, Array, LoL, Parcel);
pir::perl6_set_types_enummap_hash__vPP(EnumMap, Hash);
pir::perl6_set_type_capture__vP(Capture);
pir::perl6_set_bools__vPP(Bool.WHO<False>, Bool.WHO<True>);
Expand Down
85 changes: 40 additions & 45 deletions src/Perl6/Metamodel/BUILDPLAN.pm
Expand Up @@ -11,59 +11,54 @@ role Perl6::Metamodel::BUILDPLAN {
# 1 class name attr_name = try to find initialization value
# 2 class attr_name code = call default value closure if needed
method create_BUILDPLAN($obj) {
# Get MRO, then work from least derived to most derived.
my @all_plan;
# First, we'll create the build plan for just this class.
my @plan;
my @attrs := $obj.HOW.attributes($obj, :local(1));

# Does it have its own BUILD?
my $build := $obj.HOW.find_method($obj, 'BUILD', :no_fallback(1));
if !nqp::isnull($build) && $build {
# We'll call the custom one.
@plan[+@plan] := [0, $build];
}
else {
# No custom BUILD. Rather than having an actual BUILD
# in Mu, we produce ops here per attribute that may
# need initializing.
for @attrs {
if $_.has_accessor {
my $attr_name := $_.name;
my $name := nqp::substr($attr_name, 2);
@plan[+@plan] := [1, $obj, $name, $attr_name];
}
}
}

# Check if there's any default values to put in place.
for @attrs {
if nqp::can($_, 'build') {
my $default := $_.build;
if !nqp::isnull($default) && $default {
@plan[+@plan] := [4, $obj, $_.name, $default];
}
}
}

# Install plan for this class.
@!BUILDPLAN := @plan;

# Now create the full plan by getting the MRO, and working from
# least derived to most derived, copying the plans.
my @all_plan;
my @mro := self.mro($obj);
my $i := +@mro;
while $i > 0 {
# Get current class to consider and its attrs.
$i := $i - 1;
my $class := @mro[$i];
my @attrs := $class.HOW.attributes($class, :local(1));

# Does it have its own BUILD?
my $build := $class.HOW.find_method($class, 'BUILD', :no_fallback(1));
if $build {
# We'll call the custom one.
my $entry := [0, $build];
@all_plan[+@all_plan] := $entry;
if $i == 0 {
@plan[+@plan] := $entry;
}
}
else {
# No custom BUILD. Rather than having an actual BUILD
# in Mu, we produce ops here per attribute that may
# need initializing.
for @attrs {
if $_.has_accessor {
my $attr_name := $_.name;
my $name := nqp::substr($attr_name, 2);
my $entry := [1, $class, $name, $attr_name];
@all_plan[+@all_plan] := $entry;
if $i == 0 {
@plan[+@plan] := $entry;
}
}
}
}

# Check if there's any default values to put in place.
for @attrs {
if nqp::can($_, 'build') {
my $default := $_.build;
if $default {
my $entry := [2, $class, $_.name, $default];
@all_plan[+@all_plan] := $entry;
if $i == 0 {
@plan[+@plan] := $entry;
}
}
}
for $class.HOW.BUILDPLAN($class) {
nqp::push(@all_plan, $_);
}
}
@!BUILDPLAN := @plan;
@!BUILDALLPLAN := @all_plan;
}

Expand Down

0 comments on commit 103e95a

Please sign in to comment.