Changeset 22500

Timestamp:

10/03/08 20:11:15 (7 weeks ago)

Author:

pmurias

Message:

[mildew] anonymous subroutines

Location:

v6/mildew

Files:

• mildew (modified) (1 diff)
• src/AST.pm (modified) (3 diffs)

v6/mildew/mildew

@@ -31 +31 @@
     } elsif ($m->{value}) {
         value($m->{value});
+    } elsif ($m->{routine_declarator}) {
+        if ($m->{routine_declarator}{routine_def}) {
+            routine_def($m->{routine_declarator}{routine_def});
+        } else {
+            XXX;
+        }
+    } else {
+        XXX;
     }
+}
+sub routine_def {
+    my $m = shift;
+    AST::Call->new(identifier=>AST::StringConstant->new(value => 'new'),
+        capture => AST::Capture->new(
+            invocant => AST::Reg->new(name=>'Code'),
+            positional => [],
+            named => [
+                AST::StringConstant->new(value=>'mold') => block($m->{block}),
+                AST::StringConstant->new(value=>'outer') => AST::Reg->new(name=>'$scope')
+            ]
+        ),
+    );
+}
+sub block {
+    my $m = shift;
+    AST::Block->new(regs=>['interpreter','scope'],stmts=>statementlist($m->{in}{statementlist}));
 }
 sub value {

v6/mildew/src/AST.pm

@@ -25 +25 @@
 extends 'AST::Base';
 has 'stmts' => (is=>'ro');
-has 'regs' => (is=>'ro');
+has 'regs' => (is=>'ro',default=>sub {[]});
 sub m0ld {
     my ($self,$ret) = @_;
+    use YAML::XS;
     "my $ret = mold {\n"
         . join('',map {'my $'.$_.";\n"} @{$self->regs})
@@ -61 +62 @@
 =cut
 
+package AST::Named;
+use Moose;
+extends 'AST::Base';
+has 'key' => (is=>'ro');
+has 'value' => (is=>'ro');
+
+sub emit {
+    my $self = shift;
+    return ":".$self->key->emit."(".$self->value->emit.")";
+}
+sub m0ld {
+    die "method m0ld is not supported on AST::Named\n"
+}
+
 package AST::Call;
 use Moose;
@@ -69 +84 @@
     my ($self,$ret) = @_;
     if ($self->capture->isa("AST::Capture")) {
+        my @args = @{$self->capture->positional};
+        my @named = @{$self->capture->named};
+        while (@named) {
+            push (@args,AST::Named->new(key=>shift @named,value=>shift @named));
+        }
         "my $ret = "
         . $self->capture->invocant->emit
         . "." . $self->identifier->emit
-        . "(" . join('', map {$_->emit} @{$self->capture->positional}) . ");\n";
+        . "(" . join('', map {$_->emit} @args) . ");\n";
     } else {
     }