Skip to content

Commit

Permalink
First cut at getting very basic lexical variable declaration support …
Browse files Browse the repository at this point in the history
…back in place.
  • Loading branch information
jnthn committed Jun 2, 2011
1 parent e3daad7 commit 80f907c
Show file tree
Hide file tree
Showing 2 changed files with 47 additions and 85 deletions.
98 changes: 15 additions & 83 deletions src/Perl6/Actions.pm
Original file line number Diff line number Diff line change
Expand Up @@ -42,9 +42,9 @@ class Perl6::Actions is HLL::Actions {
}

sub sigiltype($sigil) {
$sigil eq '%'
?? 'Hash'
!! ($sigil eq '@' ?? 'Array' !! 'Perl6Scalar');
$sigil eq '%' ?? 'Hash' !!
$sigil eq '@' ?? 'Array' !!
'Scalar'
}

method deflongname($/) {
Expand Down Expand Up @@ -988,89 +988,21 @@ class Perl6::Actions is HLL::Actions {
$BLOCK.symbol($name, :attr_alias($attrname));
}

# Nothing to emit here; just hand back an empty node.
# Nothing to emit here; just hand back an empty node.
$past := PAST::Op.new( :pasttype('null') );
}
elsif $*SCOPE eq 'my' {
# Create a container descriptor. Default to rw and set a
# type if we have one; a trait may twiddle with that later.
my $descriptor := $*ST.create_container_descriptor(
$*TYPENAME ?? $*TYPENAME.ast !! $*ST.find_symbol(['Mu']),
1, $name);

# Install the container.
$*ST.install_lexical_container($BLOCK, $name, sigiltype($sigil), $descriptor);
}
else {
# Not an attribute - need to emit delcaration here.
# Create the container
my $cont := $sigil eq '%' ??
PAST::Op.new( :name('&CREATE_HASH_FROM_LOW_LEVEL'), :pasttype('call') ) !!
PAST::Op.new( sigiltype($sigil), :pirop('new Ps') );

# Give it a 'rw' property unless it's explicitly readonly.
my $readtype := trait_readtype($trait_list);
if $readtype eq 'CONFLICT' {
$/.CURSOR.panic('Cannot apply more than one of: is copy, is rw, is readonly');
}
if $readtype eq 'copy' {
$/.CURSOR.panic("'is copy' trait not valid on variable declaration");
}
my $true := PAST::Var.new( :name('true'), :scope('register') );
my $vivipast := $readtype ne 'readonly' ??
PAST::Op.new( $cont, 'rw', $true, :pirop('setprop')) !!
$cont;

# If it's a scalar, mark it as scalar (non-flattening)
if $sigil eq '$' || $sigil eq '&' {
$vivipast := PAST::Op.new($vivipast,'scalar',$true,:pirop('setprop'));
}

# For 'our' variables, we first bind or lookup in the namespace
if $*SCOPE eq 'our' {
$vivipast := PAST::Var.new( :name($name), :scope('package'), :isdecl(1),
:lvalue(1), :viviself($vivipast), :node($/) );
}

# Now bind a lexical in the block
my $decl := PAST::Var.new( :name($name), :scope('lexical'), :isdecl(1),
:lvalue(1), :viviself($vivipast), :node($/) );
$BLOCK.symbol($name, :scope('lexical'), :decl_node($decl) );
$BLOCK[0].push($decl);

# If we have traits, set up us the node to emit handlers into, then
# emit them.
my $init_type := 0;
if $trait_list || $*TYPENAME {
my $trait_node := get_var_traits_node($BLOCK, $name);
for $trait_list {
my $trait := $_.ast;
unless $trait<trait_is_compiler_handled> {
$trait.unshift(PAST::Var.new( :name('declarand'), :scope('register') ));
if $trait.name() eq '&trait_mod:<of>' && $*TYPENAME {
$init_type := $trait[1] := PAST::Op.new(
:pasttype('callmethod'), :name('postcircumfix:<[ ]>'),
$*TYPENAME, $trait[1]
);
$*TYPENAME := '';
}
$trait_node.push($trait);
}
}
if $*TYPENAME {
$trait_node.push(PAST::Op.new(
:pasttype('call'), :name('&trait_mod:<of>'),
PAST::Var.new( :name('declarand'), :scope('register') ),
$*TYPENAME
));
$init_type := $*TYPENAME;
}
}

# For arrays, need to transform_to_p6opaque. XXX Find a neater way
# to do this.
if $sigil eq '@' {
get_var_traits_node($BLOCK, $name).push(PAST::Op.new(
:pirop('transform_to_p6opaque vP'),
PAST::Var.new( :name('$P0'), :scope('register') )
));
}

# If we've a type to init with and it's a scalar, do so.
if $init_type && $sigil eq '$' {
$cont.pirop('new PsP');
$cont.push($init_type);
}
$/.CURSOR.panic("$*SCOPE scoped variables not yet implemented");
}

return $past;
Expand Down
34 changes: 32 additions & 2 deletions src/Perl6/SymbolTable.pm
Original file line number Diff line number Diff line change
Expand Up @@ -155,7 +155,7 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
# the object to install. Does an immediate installation in the
# compile-time block symbol table, and ensures that the installation
# gets fixed up at runtime too.
method install_lexical_symbol($block, $name, $obj, $clone_per_pad = 0) {
method install_lexical_symbol($block, $name, $obj) {
# Install the object directly as a block symbol.
$block.symbol($name, :scope('lexical'), :value($obj));
$block[0].push(PAST::Var.new( :scope('lexical'), :name($name), :isdecl(1) ));
Expand All @@ -168,7 +168,37 @@ class Perl6::SymbolTable is HLL::Compiler::SerializationContextBuilder {
PAST::Val.new( :value($block) )
),
~$name, self.get_object_sc_ref_past($obj),
PAST::Val.new( :value($clone_per_pad) )
0
);
self.add_event(:deserialize_past($fixup), :fixup_past($fixup));
}

# Installs a lexical symbol. Takes a PAST::Block object, name and
# the type of container to install.
method install_lexical_container($block, $name, $type_name, $descriptor) {
# Add to block. Note that it doesn't really have a compile time
# value.
$block.symbol($name, :scope('lexical'), :descriptor($descriptor));
$block[0].push(PAST::Var.new( :scope('lexical'), :name($name), :isdecl(1) ));

# Look up container type and create code to instantiate it.
# XXX Set default value and container descriptor.
my $type_obj := self.find_symbol([$type_name]);
my $cont_code := PAST::Op.new(
:pirop('repr_instance_of PP'),
self.get_object_sc_ref_past($type_obj)
);

# Fixup and deserialization task is the same - creating the
# container type and put it in the static lexpad with a clone
# flag set.
my $fixup := PAST::Op.new(
:pasttype('callmethod'), :name('set_static_lexpad_value'),
PAST::Op.new(
:pasttype('callmethod'), :name('get_lexinfo'),
PAST::Val.new( :value($block) )
),
~$name, $cont_code, 1
);
self.add_event(:deserialize_past($fixup), :fixup_past($fixup));
}
Expand Down

0 comments on commit 80f907c

Please sign in to comment.