package Pugs::Emitter::Perl6::Perl5::Hash; use strict; use warnings; use base 'Pugs::Emitter::Perl6::Perl5::Value'; # XXX use overload ( '""' => sub { $_[0]->{name} }, fallback => 1, ); sub WHAT { $_[0]->node( 'str', 'Hash' ); } sub isa { my $self = $_[0]; return $_[0]->WHAT->eq( $_[1]->WHAT ); #return 'Pugs::Runtime::Perl6::Scalar::isa( \\'. _emit( $n->{self} ) . ', ' . _emit( $n->{param} ) . ')'; } sub get { my $self = $_[0]; return $self->name; } sub set { my $self = $_[0]; return $self->name . ' = ' . $_[1]->hash->get; } sub str { return $_[0]->node( 'StrExpression', ' Pugs::Runtime::Perl6::Hash::str( \\' . $_[0] . ' ) ' ) } sub defined { # TODO } sub kv { $_[0]->array } sub keys { return $_[0]->node( 'ListExpression', '(keys ' . $_[0]->name . ')' ) } sub num { return $_[0]->elems } sub int { return $_[0]->elems } sub elems { return $_[0]->node( 'IntExpression', '(scalar keys ' . $_[0]->name . ')' ) } sub hash { $_[0] } sub array { return $_[0]->node( 'ListExpression', '@{[' . $_[0]->name . ']}' ) } sub scalar { return $_[0]->node( 'Scalar', '( bless \\' . $_[0] . ", 'Pugs::Runtime::Perl6::Hash' )" ) } sub list { $_[0]->node( 'Seq', [ $_[0] ] ); } sub _123__125_ { # .{} my $self = $_[0]; my $other = $_[1]->list; return $_[0] unless $other; # TODO return $self->_dollar_name . '{' . $other . '}'; } package Pugs::Emitter::Perl6::Perl5::SeqHash; use base 'Pugs::Emitter::Perl6::Perl5::Hash'; use overload ( '""' => sub { '{' . join( ', ', map { $_->boxed } @{$_[0]->{name}} ) . '}' }, fallback => 1, ); sub new { # - interpolate Pair Values at compile-time # - variables starting with '$' never interpolate # even if they contain a Pair or a Hash # - variables starting with '%' or '@' do interpolate # at runtime. # - hash and list expressions interpolate # such as %$h # - scalar expressions don't interpolate # such as $%h # - values starting with '&' don't interpolate # - expressions are called in list context #print "SeqHash.new ",Data::Dumper::Dumper(\@_); my @self = map { #print "SeqHash.elem ",$_->WHAT->{name}," ",Data::Dumper::Dumper($_); $_->WHAT->{name} eq 'Pair' ? ( $_->{name}[0], $_->{name}[1] ) : $_ } @{$_[1]->{name}}; return bless { name => \@self }, $_[0]; } sub scalar { return $_[0]->node( 'Scalar', '( bless ' . $_[0] . ", 'Pugs::Runtime::Perl6::Hash' )" ) } sub str { return $_[0]->node( 'StrExpression', ' Pugs::Runtime::Perl6::Hash::str( ' . $_[0] . ' ) ' ) } 1;