diff --git a/CgOp.pm b/CgOp.pm index 2b3b80e0..ae55870b 100644 --- a/CgOp.pm +++ b/CgOp.pm @@ -407,6 +407,11 @@ use warnings; fetch(methodcall(newscalar(rawsget('Kernel.ArrayP')), 'new')))); } + sub newblankhash { + newrwlistvar( + fetch(methodcall(newscalar(rawsget('Kernel.HashP')), 'new'))); + } + sub string_var { box('Str', clr_string($_[0])); } diff --git a/CodeGen.pm b/CodeGen.pm index 304ed4c7..fda207f6 100644 --- a/CodeGen.pm +++ b/CodeGen.pm @@ -90,6 +90,7 @@ use 5.010; 'String.Concat' => [m => 'String'], 'Kernel.AnyP' => [f => 'IP6'], 'Kernel.ArrayP' => [f => 'IP6'], + 'Kernel.HashP' => [f => 'IP6'], 'Kernel.SubMO' => [f => 'DynMetaObject'], 'Kernel.ScalarMO' => [f => 'DynMetaObject'], 'Kernel.MainlineContinuation' => [f => 'DynBlockDelegate'], diff --git a/Decl.pm b/Decl.pm index 0e90ded9..3f863de8 100644 --- a/Decl.pm +++ b/Decl.pm @@ -100,6 +100,7 @@ use CgOp; has slot => (isa => 'Str', is => 'ro', required => 1); has list => (isa => 'Bool', is => 'ro', default => 0); + has hash => (isa => 'Bool', is => 'ro', default => 0); has shared => (isa => 'Bool', is => 'ro', default => 0); has zeroinit => (isa => 'Bool', is => 'ro', default => 0); has noenter => (isa => 'Bool', is => 'ro', default => 0); @@ -115,6 +116,8 @@ use CgOp; CgOp::proto_var($self->slot, CgOp::newrwscalar(CgOp::null('IP6'))); } elsif ($self->list) { CgOp::proto_var($self->slot, CgOp::newblanklist); + } elsif ($self->hash) { + CgOp::proto_var($self->slot, CgOp::newblankhash); } else { CgOp::proto_var($self->slot, CgOp::newrwscalar(CgOp::fetch(CgOp::scopedlex('Any')))); @@ -129,6 +132,7 @@ use CgOp; ($body->mainline || $self->shared) ? CgOp::share_lex($self->slot) : CgOp::scopedlex($self->slot, $self->list ? CgOp::newblanklist : + $self->hash ? CgOp::newblankhash : CgOp::newrwscalar(CgOp::fetch(CgOp::scopedlex('Any')))); } diff --git a/Kernel.cs b/Kernel.cs index 77e2f334..5e466378 100644 --- a/Kernel.cs +++ b/Kernel.cs @@ -682,6 +682,7 @@ public class Kernel { public static IP6 AnyP; public static IP6 ArrayP; + public static IP6 HashP; public static IP6 StrP = new DynObject(null); public static DynMetaObject CallFrameMO; diff --git a/Niecza/Actions.pm b/Niecza/Actions.pm index 8bcfe2b6..a77d9a18 100644 --- a/Niecza/Actions.pm +++ b/Niecza/Actions.pm @@ -1101,11 +1101,11 @@ sub param_var { my ($cl, $M) = @_; } my $twigil = $M->{twigil}[0] ? $M->{twigil}[0]->Str : ''; my $sigil = $M->{sigil}->Str; - if ($twigil || ($sigil ne '$' && $sigil ne '@')) { + if ($twigil || ($sigil ne '$' && $sigil ne '@' && $sigil ne '%')) { $M->sorry('Non bare scalar targets NYI'); return; } - $M->{_ast} = { list => ($sigil eq '@'), slot => + $M->{_ast} = { list => ($sigil eq '@'), hash => ($sigil eq '%'), slot => $M->{name}[0] ? ($sigil . $M->{name}[0]->Str) : undef }; } @@ -1361,13 +1361,13 @@ sub variable_declarator { my ($cl, $M) = @_; } elsif ($scope eq 'state') { $M->{_ast} = Op::Lexical->new(node($M), name => $slot, state_decl => 1, state_backing => $cl->gensym, declaring => 1, - list => scalar ($M->{variable}->Str =~ /^\@/)); + list => ($v->{sigil} eq '@'), hash => ($v->{sigil} eq '%')); } elsif ($scope eq 'our') { $M->{_ast} = Op::PackageVar->new(node($M), name => $slot, slot => $slot, path => [ 'OUR' ]); } else { $M->{_ast} = Op::Lexical->new(node($M), name => $slot, declaring => 1, - list => scalar ($M->{variable}->Str =~ /^\@/)); + list => ($v->{sigil} eq '@'), hash => ($v->{sigil} eq '%')); } } diff --git a/Op.pm b/Op.pm index 2b1e8bdf..6ca28112 100644 --- a/Op.pm +++ b/Op.pm @@ -797,6 +797,7 @@ use CgOp; has declaring => (isa => 'Bool', is => 'ro'); has list => (isa => 'Bool', is => 'ro'); + has hash => (isa => 'Bool', is => 'ro'); has state_backing => (isa => 'Str', is => 'ro'); @@ -806,10 +807,11 @@ use CgOp; if ($self->state_backing) { return Decl::StateVar->new(slot => $self->name, - backing => $self->state_backing, list => $self->list); + backing => $self->state_backing, list => $self->list, + hash => $self->hash); } else { return Decl::SimpleVar->new(slot => $self->name, - list => $self->list); + list => $self->list, hash => $self->hash); } } diff --git a/Sig.pm b/Sig.pm index e77c38d2..b8b879ba 100644 --- a/Sig.pm +++ b/Sig.pm @@ -16,13 +16,14 @@ use 5.010; has names => (is => 'ro', isa => 'ArrayRef[Str]', default => sub { [] }); has name => (is => 'ro', isa => 'Str', required => 1); has list => (is => 'ro', isa => 'Bool', default => 0); + has hash => (is => 'ro', isa => 'Bool', default => 0); has zeroinit => (is => 'ro', isa => 'Bool', default => 0); has type => (is => 'ro', isa => 'Str', default => 'Any'); sub local_decls { my ($self) = @_; my @r; - push @r, Decl::SimpleVar->new(slot => $self->slot, + push @r, Decl::SimpleVar->new(slot => $self->slot, hash => $self->hash, list => $self->list, zeroinit => $self->zeroinit) if defined $self->slot; push @r, $self->default->lift_decls if $self->default; diff --git a/test2.pl b/test2.pl index 339acc0e..aeee91d7 100644 --- a/test2.pl +++ b/test2.pl @@ -1,6 +1,8 @@ # vim: ft=perl6 use Test; +PRE-INIT { Q:CgOp { (prog (rawsset Kernel.HashP (@ (l Hash))) (null Variable)) } } + my class Enum is Cool { has $.key; has $.value; @@ -29,4 +31,7 @@ sub infix:<< => >>($k, $v) { Pair.RAWCREATE("key", $k, "value", $v) } is ("foo" => 1).key, 'foo', '"foo" => 1 keeps key'; is ("foo" => 1).value, '1', '"foo" => 1 keeps value'; +my %hash; +ok %hash ~~ Hash, '%-vars are Hash'; + done-testing;