Skip to content
Browse files

Merge remote branch 'origin/use-arglist' into nom

Conflicts:
	docs/ChangeLog
  • Loading branch information...
2 parents d9fd173 + c2634bd commit 83aea7d2df57e290444fb7479fdb1c7d66cefd84 @moritz moritz committed
Showing with 100 additions and 54 deletions.
  1. +2 −0 docs/ChangeLog
  2. +17 −31 src/Perl6/Actions.pm
  3. +38 −6 src/Perl6/Grammar.pm
  4. +1 −2 src/Perl6/Pod.pm
  5. +21 −0 src/Perl6/World.pm
  6. +0 −1 src/core/Temporal.pm
  7. +21 −14 src/core/traits.pm
View
2 docs/ChangeLog
@@ -13,6 +13,8 @@ New in 2012.05
+ ms// fixed
+ <$x> in regexes caches the compiled regex, which can be a big performance win
+ implemented temp and let
++ 'use' can now import by tag name
++ updated calling conventions for traits
New in 2012.04.1
+ autvivification for arrays and hashes
View
48 src/Perl6/Actions.pm
@@ -344,7 +344,7 @@ class Perl6::Actions is HLL::Actions {
$*W.pop_lexpad();
$*W.add_phaser(
- $/, 'INIT', make_simple_code_object($block, 'Block')
+ $/, 'INIT', $*W.create_simple_code_object($block, 'Block')
);
}
}
@@ -1866,8 +1866,7 @@ class Perl6::Actions is HLL::Actions {
# Attach inlining information.
$*W.apply_trait('&trait_mod:<is>', $code,
- ($*W.add_string_constant($inline_info))<compile_time_value>,
- inlinable => ($*W.add_numeric_constant('Int', 1))<compile_time_value>)
+ inlinable => ($*W.add_string_constant($inline_info))<compile_time_value>)
}
method method_def($/) {
@@ -2395,7 +2394,7 @@ class Perl6::Actions is HLL::Actions {
}
else {
$con_block.push($value_ast);
- my $value_thunk := make_simple_code_object($con_block, 'Block');
+ my $value_thunk := $*W.create_simple_code_object($con_block, 'Block');
$value := $value_thunk();
$*W.add_constant_folded_result($value);
}
@@ -2510,7 +2509,8 @@ class Perl6::Actions is HLL::Actions {
%*PARAM_INFO<default_is_literal> := 1;
}
else {
- %*PARAM_INFO<default_value> := make_thunk($val, $<default_value>[0]);
+ %*PARAM_INFO<default_value> :=
+ $*W.create_thunk($<default_value>[0], $val);
}
}
@@ -2816,16 +2816,14 @@ class Perl6::Actions is HLL::Actions {
}
else
{
- # If we have an argument, get its compile time value.
+ # If we have an argument, get its compile time value or
+ # evaluate it to get that.
my @trait_arg;
if $<circumfix> {
my $arg := $<circumfix>[0].ast[0];
- if $arg<has_compile_time_value> {
- @trait_arg[0] := $arg<compile_time_value>;
- }
- else {
- # XXX Should complain, or go compile it.
- }
+ @trait_arg[0] := $arg<has_compile_time_value> ??
+ $arg<compile_time_value> !!
+ $*W.create_thunk($/, $<circumfix>[0].ast)();
}
# If we have a type name then we need to dispatch with that type; otherwise
@@ -2839,9 +2837,10 @@ class Perl6::Actions is HLL::Actions {
}
else {
my %arg;
- %arg{~$<longname>} := ($*W.add_constant('Int', 'int', 1))<compile_time_value>;
+ %arg{~$<longname>} := @trait_arg ?? @trait_arg[0] !!
+ $*W.find_symbol(['Bool', 'True']);
make -> $declarand {
- $*W.apply_trait('&trait_mod:<is>', $declarand, |@trait_arg, |%arg);
+ $*W.apply_trait('&trait_mod:<is>', $declarand, |%arg);
};
}
}
@@ -2890,7 +2889,7 @@ class Perl6::Actions is HLL::Actions {
# The term may be fairly complex. Thus we make it into a thunk
# which the trait handler can use to get the term and work with
# it.
- my $thunk := make_thunk($<term>.ast, $/);
+ my $thunk := $*W.create_thunk($/, $<term>.ast);
make -> $declarand {
$*W.apply_trait('&trait_mod:<handles>', $declarand, $thunk);
};
@@ -4368,7 +4367,7 @@ class Perl6::Actions is HLL::Actions {
my $throwaway_block := PAST::Block.new();
my $quasi_context := block_closure(
reference_to_code_object(
- make_simple_code_object($throwaway_block, 'Block'),
+ $*W.create_simple_code_object($throwaway_block, 'Block'),
$throwaway_block
));
make PAST::Op.new(:pasttype<callmethod>, :name<incarnate>,
@@ -4574,28 +4573,15 @@ class Perl6::Actions is HLL::Actions {
return $closure;
}
- sub make_thunk($to_thunk, $/) {
- my $block := $*W.push_lexpad($/);
- $block.push($to_thunk);
- $*W.pop_lexpad();
- make_simple_code_object($block, 'Code');
- }
-
sub make_thunk_ref($to_thunk, $/) {
my $block := $*W.push_lexpad($/);
$block.push($to_thunk);
$*W.pop_lexpad();
reference_to_code_object(
- make_simple_code_object($block, 'Code'),
+ $*W.create_simple_code_object($block, 'Code'),
$block);
}
- sub make_simple_code_object($block, $type) {
- ($*W.cur_lexpad())[0].push($block);
- my $sig := $*W.create_signature([]);
- return $*W.create_code_object($block, $type, $sig);
- }
-
sub make_topic_block_ref($past, :$copy) {
my $block := PAST::Block.new(
PAST::Stmts.new(
@@ -4823,7 +4809,7 @@ class Perl6::Actions is HLL::Actions {
# Dispatch trait. XXX Should really be Bool::True, not Int here...
my $true := ($*W.add_constant('Int', 'int', 1))<compile_time_value>;
- $*W.apply_trait('&trait_mod:<will>', $attr, $code, :build($true));
+ $*W.apply_trait('&trait_mod:<will>', $attr, :build($code));
}
# This is the hook where, in the future, we'll use this as the hook to check
View
44 src/Perl6/Grammar.pm
@@ -715,7 +715,12 @@ grammar Perl6::Grammar is HLL::Grammar {
my $found := 0;
try { $module := $*W.find_symbol($longname.components()); $found := 1; }
if $found {
- do_import($module.WHO, $<arglist>, ~$<module_name><longname>);
+ # todo: fix arglist
+ my $arglist;
+ if $<arglist> {
+ $arglist := $*W.compile_time_evaluate($/, $<arglist>[0]<EXPR>);
+ }
+ do_import($module.WHO, ~$<module_name><longname>, $arglist);
}
else {
$/.CURSOR.panic("Could not find module " ~ ~$<module_name> ~
@@ -751,14 +756,25 @@ grammar Perl6::Grammar is HLL::Grammar {
}
[
|| <.spacey> <arglist>
- <.NYI('arglist case of use')>
+ {
+ my $arglist := $*W.compile_time_evaluate($/,
+ $<arglist><EXPR>.ast);
+ $arglist := nqp::getattr($arglist.list.eager,
+ $*W.find_symbol(['List']), '$!items');
+ my $module := $*W.load_module($/,
+ ~$longname,
+ $*GLOBALish);
+ do_import($module, ~$longname, $arglist);
+ $/.CURSOR.import_EXPORTHOW($module);
+
+ }
|| {
unless ~$<doc> && !%*COMPILING<%?OPTIONS><doc> {
if $longname {
my $module := $*W.load_module($/,
~$longname,
$*GLOBALish);
- do_import($module, $<arglist>, ~$longname);
+ do_import($module, ~$longname);
$/.CURSOR.import_EXPORTHOW($module);
}
}
@@ -768,11 +784,27 @@ grammar Perl6::Grammar is HLL::Grammar {
<.ws>
}
- sub do_import($module, $arglist, $package_source_name) {
+ sub do_import($module, $package_source_name, $arglist?) {
if pir::exists($module, 'EXPORT') {
my $EXPORT := $module<EXPORT>.WHO;
- if pir::exists($EXPORT, 'DEFAULT') {
- $*W.import($EXPORT<DEFAULT>, $package_source_name);
+ if pir::defined($arglist) {
+ my $Pair := $*W.find_symbol(['Pair']);
+ for $arglist -> $tag {
+ if nqp::istype($tag, $Pair) {
+ $tag := nqp::unbox_s($tag.key);
+ if pir::exists($EXPORT, $tag) {
+ $*W.import($EXPORT{$tag}, $package_source_name);
+ }
+ }
+ else {
+ nqp::die('Can only import named tags for now');
+ }
+ }
+ }
+ else {
+ if pir::exists($EXPORT, 'DEFAULT') {
+ $*W.import($EXPORT<DEFAULT>, $package_source_name);
+ }
}
}
}
View
3 src/Perl6/Pod.pm
@@ -2,8 +2,7 @@
class Perl6::Pod {
our sub document($what, $with) {
if ~$with ne '' {
- my $true := $*W.add_constant('Int', 'int', 1)<compile_time_value>;
- $*W.apply_trait('&trait_mod:<is>', $what, $*DOCEE, :docs($true));
+ $*W.apply_trait('&trait_mod:<is>', $what, :docs($*DOCEE));
# don't reset it if it already holds docs for another element
if $*DECLARATOR_DOCS && $*DOC.to == $*DECLARATOR_DOCS.to {
$*DECLARATOR_DOCS := '';
View
21 src/Perl6/World.pm
@@ -560,6 +560,27 @@ class Perl6::World is HLL::World {
# Return created signature.
$signature
}
+
+ method compile_time_evaluate($/, $ast) {
+ return $ast<compile_time_value> if $ast<has_compile_time_value>;
+ my $thunk := self.create_thunk($/, $ast);
+ $thunk();
+ }
+
+ # turn a PAST into a code object, to be called immediately.
+ method create_thunk($/, $to_thunk) {
+ my $block := self.push_lexpad($/);
+ $block.push($to_thunk);
+ self.pop_lexpad();
+ self.create_simple_code_object($block, 'Code');
+ }
+
+ # Creates a simple code object with an empty signature
+ method create_simple_code_object($block, $type) {
+ self.cur_lexpad()[0].push($block);
+ my $sig := self.create_signature([]);
+ return self.create_code_object($block, $type, $sig);
+ }
# Creates a code object of the specified type, attached the passed signature
# object and sets up dynamic compilation thunk.
View
1 src/core/Temporal.pm
@@ -1,4 +1,3 @@
-use v6;
my class DateTime { ...}
my class Date { ...}
View
35 src/core/traits.pm
@@ -5,6 +5,9 @@ my role Positional { ... }
my role Associative { ... }
my role Callable { ... }
+# This is needed for the export trait.
+my class Pair { ... }
+
proto trait_mod:<is>(|$) { * }
multi trait_mod:<is>(Mu:U $child, Mu:U $parent) {
if $parent.HOW.archetypes.inheritable() {
@@ -21,8 +24,8 @@ multi trait_mod:<is>(Mu:U $child, Mu:U $parent) {
multi trait_mod:<is>(Mu:U $type, :$rw!) {
$type.HOW.set_rw($type);
}
-multi trait_mod:<is>(Mu:U $type, $size, :$nativesize!) {
- $type.HOW.set_nativesize($type, $size);
+multi trait_mod:<is>(Mu:U $type, :$nativesize!) {
+ $type.HOW.set_nativesize($type, $nativesize);
}
multi trait_mod:<is>(Attribute:D $attr, :$rw!) {
@@ -41,8 +44,8 @@ multi trait_mod:<is>(Routine:D $r, :$rw!) {
multi trait_mod:<is>(Routine:D $r, :$default!) {
$r does role { method default() { True } }
}
-multi trait_mod:<is>(Routine:D $r, $info, :$inlinable!) {
- $r.set_inline_info($info);
+multi trait_mod:<is>(Routine:D $r, :$inlinable!) {
+ $r.set_inline_info($inlinable);
}
multi trait_mod:<is>(Parameter:D $param, :$readonly!) {
@@ -85,28 +88,32 @@ sub EXPORT_SYMBOL(\$exp_name, @tags, Mu \$sym) {
multi trait_mod:<is>(Routine:D \$r, :$export!) {
my $to_export := $r.multi ?? $r.dispatcher !! $r;
my $exp_name := '&' ~ $r.name;
- my @tags = 'ALL', 'DEFAULT';
+ my @tags = 'ALL', ($export ~~ Pair ?? $export.key() !!
+ $export ~~ Positional ?? @($export)>>.key !!
+ 'DEFAULT');
EXPORT_SYMBOL($exp_name, @tags, $to_export);
}
multi trait_mod:<is>(Mu:U \$type, :$export!) {
my $exp_name := $type.HOW.name($type);
- my @tags = 'ALL', 'DEFAULT';
+ my @tags = 'ALL', ($export ~~ Pair ?? $export.key !!
+ $export ~~ Positional ?? @($export)>>.key !!
+ 'DEFAULT');
EXPORT_SYMBOL($exp_name, @tags, $type);
}
-multi trait_mod:<is>(Mu:D $docee, $doc, :$docs!) {
+multi trait_mod:<is>(Mu:D $docee, :$docs!) {
$docee does role {
has $!WHY;
method WHY { $!WHY }
method set_docs($d) { $!WHY = $d }
}
- $docee.set_docs($doc);
- $doc.set_docee($docee);
+ $docee.set_docs($docs);
+ $docs.set_docee($docee);
}
-multi trait_mod:<is>(Mu:U $docee, $doc, :$docs!) {
- $docee.HOW.set_docs($doc);
- $doc.set_docee($docee);
+multi trait_mod:<is>(Mu:U $docee, :$docs!) {
+ $docee.HOW.set_docs($docs);
+ $docs.set_docee($docee);
}
@@ -213,8 +220,8 @@ multi trait_mod:<handles>(Attribute:D $target, $thunk) {
}
proto trait_mod:<will>(|$) { * }
-multi trait_mod:<will>(Attribute $attr, Block $closure, :$build!) {
- $attr.set_build($closure)
+multi trait_mod:<will>(Attribute $attr, Block :$build!) {
+ $attr.set_build($build)
}
proto trait_mod:<trusts>(|$) { * }

0 comments on commit 83aea7d

Please sign in to comment.
Something went wrong with that request. Please try again.