Skip to content

Commit

Permalink
Browse files Browse the repository at this point in the history
Merge remote branch 'origin/enum-nonint' into nom
  • Loading branch information
@moritz
moritz committed May 12, 2012
2 parents 85f636b + d2012e2 commit 777259d
Show file tree
Hide file tree
Showing 3 changed files with 62 additions and 26 deletions.
77 changes: 55 additions & 22 deletions src/Perl6/Actions.pm
View file
Expand Up @@ -2252,28 +2252,38 @@ class Perl6::Actions is HLL::Actions {
# Get, or find, enumeration base type and create type object with
# correct base type.
my $longname := $<longname> ?? $*W.disect_longname($<longname>) !! 0;
my $base_type := $*OFTYPE ?? $*OFTYPE.ast !! $*W.find_symbol(['Int']);
my $name := $<longname> ?? $longname.name() !! $<variable><desigilname>;
my $type_obj := $*W.pkg_create_mo($/, %*HOW<enum>, :name($name), :base_type($base_type));

# Add roles (which will provide the enum-related methods).
$*W.apply_trait('&trait_mod:<does>', $type_obj, $*W.find_symbol(['Enumeration']));
if pir::type_check__IPP($type_obj, $*W.find_symbol(['Numeric'])) {
$*W.apply_trait('&trait_mod:<does>', $type_obj, $*W.find_symbol(['NumericEnumeration']));
my $type_obj;
my sub make_type_obj($base_type) {
$type_obj := $*W.pkg_create_mo($/, %*HOW<enum>, :$name, :$base_type);
# Add roles (which will provide the enum-related methods).
$*W.apply_trait('&trait_mod:<does>', $type_obj, $*W.find_symbol(['Enumeration']));
if pir::type_check__IPP($type_obj, $*W.find_symbol(['Numeric'])) {
$*W.apply_trait('&trait_mod:<does>', $type_obj, $*W.find_symbol(['NumericEnumeration']));
}
if pir::type_check__IPP($type_obj, $*W.find_symbol(['Stringy'])) {
$*W.apply_trait('&trait_mod:<does>', $type_obj, $*W.find_symbol(['StringyEnumeration']));
}
# Apply traits, compose and install package.
for $<trait> {
($_.ast)($type_obj) if $_.ast;
}
$*W.pkg_compose($type_obj);
}

# Apply traits, compose and install package.
for $<trait> {
($_.ast)($type_obj) if $_.ast;
my $base_type;
my $has_base_type;
if $*OFTYPE {
$base_type := $*OFTYPE.ast;
$has_base_type := 1;
make_type_obj($base_type);
}
$*W.pkg_compose($type_obj);

if $<variable> {
$*W.throw($/, 'X::Comp::NYI',
feature => "Variable case of enums",
);
}
$*W.install_package($/, $longname.type_name_parts('enum name', :decl(1)),
($*SCOPE || 'our'), 'enum', $*PACKAGE, $*W.cur_lexpad(), $type_obj);

# Get list of either values or pairs; fail if we can't.
my @values;
Expand Down Expand Up @@ -2308,32 +2318,53 @@ class Perl6::Actions is HLL::Actions {
# for each of the keys, unless they have them supplied.
# XXX Should not assume integers, and should use lexically
# scoped &postfix:<++> or so.
my $cur_value := 0;
my $cur_value := nqp::box_i(-1, $*W.find_symbol(['Int']));
for @values {
# If it's a pair, take that as the value; also find
# key.
my $cur_key;
if $_.returns() eq 'Pair' {
$cur_key := $_[1]<compile_time_value>;
if $_[2]<has_compile_time_value> {
$cur_value := nqp::unbox_i($_[2]<compile_time_value>);
$cur_value := $_[2]<compile_time_value>;
}
else {
my $ok;
try {
$cur_value := nqp::unbox_i(
Perl6::ConstantFolder.fold(
$_[2], $*W.cur_lexpad(), $*W
)<compile_time_value>);
$cur_value := Perl6::ConstantFolder.fold(
$_[2], $*W.cur_lexpad(), $*W
)<compile_time_value>;
$ok := 1;
}
unless $ok {
$*W.throw($/, ['X', 'Value', 'Dynamic'], what => 'Enumeration');
}
}
if $has_base_type {
unless pir::type_check__IPP($cur_value, $base_type) {
$/.CURSOR.panic("Type error in enum. Got '"
~ $cur_value.HOW.name($cur_value)
~ "' Expected: '"
~ $base_type.HOW.name($base_type)
~ "'"
);
}
}
else {
$base_type := $cur_value.WHAT;
$has_base_type := 1;
make_type_obj($base_type);
}
}
else {
unless $has_base_type {
$base_type := $*W.find_symbol(['Int']);
make_type_obj($base_type);
$has_base_type := 1;
}

$cur_key := $_<compile_time_value>;
$cur_value := $cur_value.succ();
}

# Create and install value.
Expand All @@ -2345,10 +2376,12 @@ class Perl6::Actions is HLL::Actions {
if $*SCOPE eq '' || $*SCOPE eq 'our' {
$*W.install_package_symbol($*PACKAGE, nqp::unbox_s($cur_key), $val_obj);
}

# Increment for next value.
$cur_value := $cur_value + 1;
}
# create a type object even for empty enums
make_type_obj($*W.find_symbol(['Int'])) unless $has_base_type;

$*W.install_package($/, $longname.type_name_parts('enum name', :decl(1)),
($*SCOPE || 'our'), 'enum', $*PACKAGE, $*W.cur_lexpad(), $type_obj);

# We evaluate to the enum type object.
make $*W.get_ref($type_obj);
Expand Down
6 changes: 2 additions & 4 deletions src/Perl6/World.pm
View file
Expand Up @@ -1214,11 +1214,9 @@ class Perl6::World is HLL::World {
# Adds a value to an enumeration.
method create_enum_value($enum_type_obj, $key, $value) {
# Create directly.
my $val := pir::repr_box_int__PiP($value, $enum_type_obj);
my $base_type := ($enum_type_obj.HOW.parents($enum_type_obj, :local(1)))[0];
my $val := pir::repr_change_type__0PP(pir::repr_clone__PP($value), $enum_type_obj);
nqp::bindattr($val, $enum_type_obj, '$!key', $key);
nqp::bindattr($val, $enum_type_obj, '$!value',
pir::repr_box_int__PiP($value, $base_type));
nqp::bindattr($val, $enum_type_obj, '$!value', $value);
self.add_object($val);

# Add to meta-object.
Expand Down
5 changes: 5 additions & 0 deletions src/core/Enumeration.pm
View file
Expand Up @@ -46,6 +46,11 @@ my role NumericEnumeration {
self.key
}
}
my role StringyEnumeration {
multi method Str(::?CLASS:D:) {
self.value
}
}

sub ANON_ENUM(*@args) {
my Mu $prev = -1;
Expand Down

0 comments on commit 777259d

Please sign in to comment.