Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
First cut of Int and Str constants. Rather than making them every sin… 
…gle time, we instead stash them away in the SC, which amongst other things serves as a constants table. Then the code is just looking up that boxed constant. Also refactor the way we handle the case where we need a string value to hand at compile time; should give better errors.
  • Loading branch information
@jnthn
jnthn committed May 30, 2011
1 parent 6c4de02 commit 8511092
Show file tree
Hide file tree
Showing 2 changed files with 83 additions and 25 deletions.
65 changes: 40 additions & 25 deletions src/Perl6/Actions.pm
View file
Expand Up @@ -1686,7 +1686,7 @@ class Perl6::Actions is HLL::Actions {
# Handle is repr specially.
if ~$<longname> eq 'repr' {
if $<circumfix> {
$*REPR := $<circumfix>[0].ast[0].value;
$*REPR := compile_time_value_str($<circumfix>[0].ast[0], "is repr(...) trait", $/);
}
else {
$/.cursor.panic("is repr(...) trait needs a parameter");
Expand Down Expand Up @@ -2442,6 +2442,8 @@ class Perl6::Actions is HLL::Actions {
}

method number:sym<complex>($/) {
# XXX Work out at compile time, then...
# make $*ST.add_constant('Complex', 'complex', [$re, $im]);
make PAST::Op.new(
:pasttype('callmethod'), :name('new'),
PAST::Var.new( :name('Complex'), :namespace(''), :scope('package') ),
Expand All @@ -2454,7 +2456,9 @@ class Perl6::Actions is HLL::Actions {
}

method numish($/) {
if $<integer> { make PAST::Val.new( :value($<integer>.ast), :returns('Int') ); }
if $<integer> {
make $*ST.add_constant('Int', 'int', $<integer>.ast);
}
elsif $<dec_number> { make $<dec_number>.ast; }
elsif $<rad_number> { make $<rad_number>.ast; }
else {
Expand All @@ -2466,13 +2470,17 @@ class Perl6::Actions is HLL::Actions {
my $int := $<int> ?? ~$<int> !! "0";
my $frac := $<frac> ?? ~$<frac> !! "0";
if $<escale> {
# XXX Work out at compile time, then...
# make $*ST.add_constant('Num', 'num', $calculated);
my $exp := ~$<escale>[0]<decint>;
make PAST::Op.new(
:pasttype('call'),
PAST::Var.new(:scope('package'), :name('&str2num-num'), :namespace('Str')),
0, $int, $frac, ($<escale>[0]<sign> eq '-'), $exp
);
} else {
# XXX Work out at compile time, then...
# make $*ST.add_constant('Rat', 'rational', [$nu, $de]);
make PAST::Op.new(
:pasttype('call'),
PAST::Var.new(:scope('package'), :name('&str2num-rat'), :namespace('Str')),
Expand Down Expand Up @@ -2595,9 +2603,8 @@ class Perl6::Actions is HLL::Actions {
if $FORBID_PIR {
pir::die("Q:PIR forbidden in safe mode\n");
}
make PAST::Op.new( :inline( $<quote_EXPR>.ast.value ),
:pasttype('inline'),
:node($/) );
my $pir := compile_time_value_str($<quote_EXPR>.ast, "Q:PIR", $/);
make PAST::Op.new( :inline( $pir ), :pasttype('inline'), :node($/) );
}
method quote:sym<qx>($/) {
make PAST::Op.new( :name('!qx'), :pasttype('call'),
Expand Down Expand Up @@ -2723,7 +2730,8 @@ class Perl6::Actions is HLL::Actions {

method quote_escape:sym<{ }>($/) {
make PAST::Op.new(
:pirop('set S*'), block_immediate($<block>.ast), :node($/)
:pasttype('callmethod'), :name('Stringy'),
block_immediate($<block>.ast), :node($/)
);
}

Expand All @@ -2732,19 +2740,15 @@ class Perl6::Actions is HLL::Actions {
method quote_EXPR($/) {
my $past := $<quote_delimited>.ast;
if $/.CURSOR.quotemod_check('w') {
if !$past.isa(PAST::Val) {
$/.CURSOR.panic("Cannot form :w list from non-constant strings (yet)");
my @words := HLL::Grammar::split_words($/,
compile_time_value_str($past, ":w list", $/));
if +@words != 1 {
$past := PAST::Op.new( :name('&infix:<,>'), :node($/) );
for @words { $past.push($*ST.add_constant('Str', 'str', ~$_)); }
$past := PAST::Stmts.new($past);
}
else {
my @words := HLL::Grammar::split_words($/, $past.value);
if +@words != 1 {
$past := PAST::Op.new( :name('&infix:<,>'), :node($/) );
for @words { $past.push($_); }
$past := PAST::Stmts.new($past);
}
else {
$past := PAST::Val.new( :value(~@words[0]), :returns('Str') );
}
$past := $*ST.add_constant('Str', 'str', ~@words[0]);
}
}
make $past;
Expand All @@ -2763,22 +2767,21 @@ class Perl6::Actions is HLL::Actions {
}
else {
if $lastlit gt '' {
@parts.push(
PAST::Val.new( :value($lastlit), :returns('Str') )
);
@parts.push($*ST.add_constant('Str', 'str', $lastlit));
}
@parts.push($ast);
$lastlit := '';
}
}
if $lastlit gt '' || !@parts {
@parts.push(
PAST::Val.new( :value($lastlit), :returns('Str') )
);
@parts.push($*ST.add_constant('Str', 'str', $lastlit));
}
my $past := @parts ?? @parts.shift !! '';
my $past := @parts ?? @parts.shift !! $*ST.add_constant('Str', 'str', '');
while @parts {
$past := PAST::Op.new( $past, @parts.shift, :pirop('concat') );
$past := PAST::Op.new(
:pasttype('call'), :name('&infix:<~>'),
$past, @parts.shift
);
}
make $past;
}
Expand Down Expand Up @@ -3178,6 +3181,18 @@ class Perl6::Actions is HLL::Actions {
add_signature($past, $sig);
create_code_object($past, $type, 0);
}

# Ensures that the given PAST node has a value known at compile
# time and if so obtains it. Otherwise reports an error, involving
# the $usage parameter to make it more helpful.
sub compile_time_value_str($past, $usage, $/) {
if $past<has_compile_time_value> {
pir::repr_unbox_str__SP($past<compile_time_value>);
}
else {
$/.CURSOR.panic("$usage must have a value known at compile time");
}
}
}

class Perl6::RegexActions is Regex::P6Regex::Actions {
Expand Down
43 changes: 43 additions & 0 deletions src/Perl6/SymbolTable.pm
View file
Expand Up @@ -363,6 +363,49 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
PAST::Compiler.compile($past)
}

# Adds a constant value to the constants table. Returns PAST to do
# the lookup of the constant.
method add_constant($type, $primitive, $value) {
# Find type object for the box typed we'll create.
# On deserialization, we'll need to look it up too.
my $type_obj := self.find_symbol([$type]);
my $type_obj_lookup := self.get_object_sc_ref_past($type_obj);

# Go by the primitive type we're boxing. Need to create
# the boxed value and also code to produce it.
my $constant;
my $des;
if $primitive eq 'int' {
$constant := pir::repr_box_int__PiP($value, $type_obj);
$des := PAST::Op.new( :pirop('repr_box_int PiP'), $value, $type_obj_lookup );
}
elsif $primitive eq 'str' {
$constant := pir::repr_box_str__PsP($value, $type_obj);
$des := PAST::Op.new( :pirop('repr_box_str PsP'), $value, $type_obj_lookup );
}
elsif $primitive eq 'num' {
$constant := pir::repr_box_num__PnP($value, $type_obj);
$des := PAST::Op.new( :pirop('repr_box_num PnP'), $value, $type_obj_lookup );
}
else {
pir::die("Don't know how to build a $primitive constant");
}

# Add to SC, finish up deserialization code.
my $slot := self.add_object($constant);
self.add_event(:deserialize_past(
self.set_slot_past($slot, self.set_cur_sc($des))
));

# Build PAST for getting the boxed constant from the constants
# table, but also annotate it with the constant itself in case
# we need it.
my $past := self.get_slot_past_for_object($constant);
$past<has_compile_time_value> := 1;
$past<compile_time_value> := $constant;
return $past;
}

# Creates a meta-object for a package, adds it to the root objects and
# stores an event for the action. Returns the created object.
method pkg_create_mo($how, :$name, :$repr) {
Expand Down

0 comments on commit 8511092

Please sign in to comment.