Permalink
Browse files

hash assignment, composer fixes

  • Loading branch information...
1 parent 0bd0e22 commit 41b980f1819e0c32449f306b4c612141ad850c7c @fglock committed Sep 3, 2010
View
@@ -1,5 +1,5 @@
dev version - 2010-09-01
-- backends pending upgrade to the new AST: Go, Common Lisp, Python 2, and Ruby 1.9
+- backends pending upgrade to the new AST: Go, Common Lisp, Python 2, and Ruby 1.9, Eval
- backends not supported in this version: Parrot, Rakudo, Clojure
- added "perlito" command-line compiler and shell
@@ -52,17 +52,15 @@ class Perlito::Expression {
# say "# not a list -- not hash";
return $o
}
- # the argument is a list -- check that the first item looks like a pair
- my $item = ($stmt.arguments)[0];
- # say "# item: ", $item.perl;
- if !($item.isa('Apply')) {
- return $o
- }
- if ($item.code) eq 'infix:<=>>' {
- # the first argument is a pair
- # say "# block: ", $o.perl;
- # say "# hash with args: ", ( expand_list($stmt.arguments) ).perl;
- return Lit::Hash.new(hash1 => expand_list($stmt))
+ # the argument is a list -- check that it contains a pair
+ for @($stmt.arguments) -> $item {
+ # say "# item: ", $item.perl;
+ if $item.isa('Apply') && ($item.code) eq 'infix:<=>>' {
+ # argument is a pair
+ # say "# block: ", $o.perl;
+ # say "# hash with args: ", ( expand_list($stmt.arguments) ).perl;
+ return Lit::Hash.new(hash1 => expand_list($stmt))
+ }
}
return $o;
}
@@ -16,7 +16,7 @@ class Perlito::Javascript::LexicalBlock {
if $decl.isa( 'Apply' ) && $decl.code eq 'infix:<=>' {
my $var = $decl.arguments[0];
if $var.isa( 'Decl' ) && $var.decl eq 'my' {
- $str = $str ~ 'var ' ~ $var.var.emit_javascript() ~ ';';
+ $str = $str ~ $var.emit_javascript_init;
}
}
}
@@ -98,7 +98,7 @@ class CompUnit {
if $decl.isa( 'Apply' ) && $decl.code eq 'infix:<=>' {
my $var = $decl.arguments[0];
if $var.isa( 'Decl' ) && $var.decl eq 'my' {
- $str = $str ~ 'var ' ~ $var.var.emit_javascript() ~ ';';
+ $str = $str ~ $var.emit_javascript_init;
}
}
}
@@ -227,19 +227,42 @@ class Lit::Array {
class Lit::Hash {
has @.hash1;
method emit_javascript {
- my $s = '';
- for @.hash1 -> $field {
- if $field.isa('Apply') && $field.code eq 'infix:<=>>' {
- $s = $s ~ 'a[' ~ $field.arguments[0].emit_javascript() ~ '] = '
- ~ $field.arguments[1].emit_javascript() ~ '; '
+ my @s;
+ my @items;
+ for @.hash1 -> $item {
+ if $item.isa( 'Apply' ) && ( $item.code eq 'circumfix:<( )>' || $item.code eq 'list:<,>' ) {
+ for @($item.arguments) -> $arg {
+ @items.push($arg);
+ }
}
else {
- die 'Error in hash composer: ', $field.perl;
+ @items.push($item);
}
}
- return '(function () { var a = []; '
- ~ $s
- ~ ' return a })()';
+ for @items -> $item {
+ if $item.isa('Apply') && $item.code eq 'infix:<=>>' {
+ push @s, 'a[' ~ $item.arguments[0].emit_javascript() ~ '] = '
+ ~ $item.arguments[1].emit_javascript()
+ }
+ elsif $item.isa( 'Var' ) && $item.sigil eq '%'
+ || $item.isa( 'Apply' ) && $item.code eq 'prefix:<%>'
+ {
+ push @s,
+ '(function (o) { '
+ ~ 'for(var i in o) { '
+ ~ 'a[i] = o[i] '
+ ~ '} '
+ ~ '})(' ~ $item.emit_javascript() ~ ');'
+ }
+ else {
+ die 'Error in hash composer: ', $item.perl;
+ }
+ }
+ return
+ '(function () { var a = {}; '
+ ~ @s.join('; ') ~ '; '
+ ~ 'return a '
+ ~ '})()';
}
}
@@ -439,6 +462,7 @@ class Apply {
if $code eq 'infix:<<>' { return '(' ~ (@.arguments.>>emit_javascript).join(' < ') ~ ')' };
if $code eq 'infix:<>=>' { return '(' ~ (@.arguments.>>emit_javascript).join(' >= ') ~ ')' };
if $code eq 'infix:<<=>' { return '(' ~ (@.arguments.>>emit_javascript).join(' <= ') ~ ')' };
+ if $code eq 'infix:<=>>' { return '(' ~ (@.arguments.>>emit_javascript).join(', ') ~ ')' };
if $code eq 'infix:<..>' {
return '(function (a) { '
@@ -583,6 +607,11 @@ class Apply {
{
$arguments = Lit::Array.new( array1 => [$arguments] );
}
+ elsif $parameters.isa( 'Var' ) && $parameters.sigil eq '%'
+ || $parameters.isa( 'Decl' ) && $parameters.var.sigil eq '%'
+ {
+ $arguments = Lit::Hash.new( hash1 => [$arguments] );
+ }
'(' ~ $parameters.emit_javascript() ~ ' = ' ~ $arguments.emit_javascript() ~ ')';
}
}
@@ -91,6 +91,11 @@ class Lit::Array {
{
push @s, '@{' ~ $item.emit_perl5() ~ ' || []}';
}
+ elsif $item.isa( 'Var' ) && $item.sigil eq '%'
+ || $item.isa( 'Apply' ) && $item.code eq 'prefix:<%>'
+ {
+ push @s, '%{' ~ $item.emit_perl5() ~ ' || {}}';
+ }
else {
push @s, $item.emit_perl5;
}
@@ -102,12 +107,29 @@ class Lit::Array {
class Lit::Hash {
has @.hash1;
method emit_perl5 {
- my $fields = @.hash1;
- my $str = '';
- for @$fields -> $field {
- $str = $str ~ $field.emit_perl5() ~ ',';
- };
- '{ ' ~ $str ~ ' }';
+ my @s;
+ my @items;
+ for @.hash1 -> $item {
+ if $item.isa( 'Apply' ) && ( $item.code eq 'circumfix:<( )>' || $item.code eq 'list:<,>' ) {
+ for @($item.arguments) -> $arg {
+ @items.push($arg);
+ }
+ }
+ else {
+ @items.push($item);
+ }
+ }
+ for @items -> $item {
+ if $item.isa( 'Var' ) && $item.sigil eq '%'
+ || $item.isa( 'Apply' ) && $item.code eq 'prefix:<%>'
+ {
+ push @s, '%{' ~ $item.emit_perl5() ~ ' || {}}';
+ }
+ else {
+ push @s, $item.emit_perl5() ~ ',';
+ }
+ }
+ '{ ' ~ @s.join(', ') ~ ' }';
}
}
@@ -409,6 +431,11 @@ class Apply {
{
$arguments = Lit::Array.new( array1 => [$arguments] );
}
+ elsif $parameters.isa( 'Var' ) && $parameters.sigil eq '%'
+ || $parameters.isa( 'Decl' ) && $parameters.var.sigil eq '%'
+ {
+ $arguments = Lit::Hash.new( hash1 => [$arguments] );
+ }
'(' ~ $parameters.emit_perl5() ~ ' = ' ~ $arguments.emit_perl5() ~ ')';
}
}
@@ -187,7 +187,7 @@ package Main;
my $o = shift;
if ( ref($o) ) {
my $key = "$o";
- return "'!!! Recursive structure !!!' at $key" if $Main::_seen{$key} > 3;
+ return "'!!! Recursive structure !!!' at $key" if ($Main::_seen{$key} || 0) > 3;
$Main::_seen{$key}++;
return '[' . join( ", ", map { perl($_) } @$o ) . ']'
if ref($o) eq 'ARRAY';
@@ -197,7 +197,7 @@ package Main;
if ref($o) eq 'CODE';
}
else {
- return $o if (0+$o) eq $o;
+ return $o if $o =~ /^[0-9]/ && (0+$o) eq $o;
return "'" . perl_escape_string($o) . "'";
}
my $can = UNIVERSAL::can($o => 'perl');
@@ -67,7 +67,7 @@ sub new { shift; bless { @_ }, "Rul::Var" }
sub sigil { $_[0]->{sigil} };
sub twigil { $_[0]->{twigil} };
sub name { $_[0]->{name} };
-sub emit_perl6 { my $self = $_[0]; (my $table = { ('$' => '$'),('@' => '$List_'),('%' => '$Hash_'),('&' => '$Code_'), }); $table->{$self->{sigil}} . $self->{name} }
+sub emit_perl6 { my $self = $_[0]; (my $table = { ('$' => '$'),, ('@' => '$List_'),, ('%' => '$Hash_'),, ('&' => '$Code_'), }); $table->{$self->{sigil}} . $self->{name} }
}
;
Oops, something went wrong.

0 comments on commit 41b980f

Please sign in to comment.