Changeset 14980

Timestamp:

01/02/07 14:04:48 (23 months ago)

Author:

fglock

Message:

mp6-mo - method calls now use 'method_call()' instead of '->'

Location:

v6/v6-MiniPerl6-MO

Files:

• lib/MiniPerl6/Perl5/Emitter.pm (modified) (6 diffs)
• lib/MiniPerl6/Perl5MO/Emitter.pm (deleted)
• lib5/MiniPerl6/Perl5/Emitter.pm (modified) (3 diffs)
• mp6-perl5-mo.pl (modified) (2 diffs)

v6/v6-MiniPerl6-MO/lib/MiniPerl6/Perl5/Emitter.pm

@@ -1 +1 @@
 use v6-alpha;
 
-class CompUnit {
+# Perl5MO emitter
+
+class Module {
     has $.name;
-    has %.attributes;
-    has %.methods;
     has @.body;
     method emit {
-        'package ' ~ $.name ~ "; " ~ 
-        'sub new { shift; bless { @_ }, "' ~ $.name ~ '" }' ~ " " ~
-        (@.body.>>emit).join( "; " )
+        my $a := @.body;
+        my $item;
+        my $s;
+        $s := $s 
+            ~ 'package ' ~ $.name ~ ';' ~ Main::newline();
+        for @$a -> $item {
+            $s := $s ~ $item.emit ~ ';' ~ Main::newline();
+        };
+        return $s;
     }
 }
@@ -259 +265 @@
         };
         
-        my $call := '->' ~ $meth ~ '(' ~ (@.arguments.>>emit).join(', ') ~ ')';
         if ($.hyper) {
-            '[ map { $_' ~ $call ~ ' } @{ ' ~ $invocant ~ ' } ]';
+            '[ map { '
+           ~ 'MO::Run::Aux::method_call( ' 
+           ~   '$_' 
+           ~   ', q(' ~ $meth ~ '), '
+           ~   (@.arguments.>>emit).join(', ') 
+           ~ ')'
+           ~ ' } @{ ' ~ $invocant ~ ' } ]';
         }
         else {
-            $invocant ~ $call;
+             'MO::Run::Aux::method_call( ' 
+           ~   $invocant 
+           ~   ', q(' ~ $meth ~ '), '
+           ~   (@.arguments.>>emit).join(', ') 
+           ~ ')';
         };
 
@@ -316 +331 @@
     has $.result;
     method emit {
-        return
-        #'do { print Main::perl(caller(),' ~ $.result.emit ~ '); return(' ~ $.result.emit ~ ') }';
         'return(' ~ $.result.emit ~ ')';
     }
@@ -390 +403 @@
 
         my $pos := $sig.positional;
-        my $str := 'my $List__ = \@_; ';   # no strict "vars"; ';
-
-        # TODO - follow recursively
-        my $pos := $sig.positional;
-        for @$pos -> $field { 
-            $str := $str ~ 'my ' ~ $field.emit ~ '; ';
-        };
-
+        my $str := 'my $List__ = \@_; no strict "vars"; ';
         my $bind := ::Bind( 
             'parameters' => ::Lit::Array( array => $sig.positional ), 
@@ -412 +418 @@
 #        };
 
-        'sub ' ~ $.name ~ ' { ' ~ 
+        'sub { ' ~ 
           'my ' ~ $invocant.emit ~ ' = shift; ' ~
           $str ~
@@ -431 +437 @@
         # say $invocant.emit;
         my $pos := $sig.positional;
-        my $str := 'my $List__ = \@_; ';  # no strict "vars"; ';
-
-        # TODO - follow recursively
-        my $pos := $sig.positional;
-        for @$pos -> $field { 
-            $str := $str ~ 'my ' ~ $field.emit ~ '; ';
-        };
+        my $str := 'my $List__ = \@_; no strict "vars"; ';
 
         my $bind := ::Bind( 

v6/v6-MiniPerl6-MO/lib5/MiniPerl6/Perl5/Emitter.pm

@@ -4 +4 @@
 use MiniPerl6::Perl5::Runtime;
 use MiniPerl6::Perl5::Match;
-package CompUnit; sub new { shift; bless { @_ }, "CompUnit" } sub name { @_ == 1 ? ( $_[0]->{name} ) : ( $_[0]->{name} = $_[1] ) }; sub attributes { @_ == 1 ? ( $_[0]->{attributes} ) : ( $_[0]->{attributes} = $_[1] ) }; sub methods { @_ == 1 ? ( $_[0]->{methods} ) : ( $_[0]->{methods} = $_[1] ) }; sub body { @_ == 1 ? ( $_[0]->{body} ) : ( $_[0]->{body} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; ('package ' . ($self->{name} . ('; ' . ('sub new { shift; bless { @_ }, "' . ($self->{name} . ('" }' . (' ' . Main::join([ map { $_->emit() } @{ $self->{body} } ], '; ')))))))) }
+package Module; sub new { shift; bless { @_ }, "Module" } sub name { @_ == 1 ? ( $_[0]->{name} ) : ( $_[0]->{name} = $_[1] ) }; sub body { @_ == 1 ? ( $_[0]->{body} ) : ( $_[0]->{body} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; my  $a = $self->{body}; my  $item; my  $s; $s = ($s . ('package ' . ($self->{name} . (';' . Main::newline())))); do { for my $item ( @{$a} ) { $s = ($s . ($item->emit() . (';' . Main::newline()))) } }; return($s) }
 ;
 package Val::Int; sub new { shift; bless { @_ }, "Val::Int" } sub int { @_ == 1 ? ( $_[0]->{int} ) : ( $_[0]->{int} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; $self->{int} }
@@ -38 +38 @@
 package Proto; sub new { shift; bless { @_ }, "Proto" } sub name { @_ == 1 ? ( $_[0]->{name} ) : ( $_[0]->{name} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; ("" . $self->{name}) }
 ;
-package Call; sub new { shift; bless { @_ }, "Call" } sub invocant { @_ == 1 ? ( $_[0]->{invocant} ) : ( $_[0]->{invocant} = $_[1] ) }; sub hyper { @_ == 1 ? ( $_[0]->{hyper} ) : ( $_[0]->{hyper} = $_[1] ) }; sub method { @_ == 1 ? ( $_[0]->{method} ) : ( $_[0]->{method} = $_[1] ) }; sub arguments { @_ == 1 ? ( $_[0]->{arguments} ) : ( $_[0]->{arguments} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; my  $invocant = $self->{invocant}->emit(); do { if (($invocant eq 'self')) { $invocant = '$self' } else {  } }; do { if ((($self->{method} eq 'perl') || (($self->{method} eq 'yaml') || (($self->{method} eq 'say') || (($self->{method} eq 'join') || (($self->{method} eq 'chars') || ($self->{method} eq 'isa'))))))) { do { if ($self->{hyper}) { return(('[ map { Main::' . ($self->{method} . ('( $_, ' . (', ' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . (')' . (' } @{ ' . ($invocant . ' } ]'))))))))) } else { return(('Main::' . ($self->{method} . ('(' . ($invocant . (', ' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . ')'))))))) } } } else {  } }; my  $meth = $self->{method}; do { if (($meth eq 'postcircumfix:<( )>')) { $meth = '' } else {  } }; my  $call = ('->' . ($meth . ('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . ')')))); do { if ($self->{hyper}) { ('[ map { $_' . ($call . (' } @{ ' . ($invocant . ' } ]')))) } else { ($invocant . $call) } } }
+package Call; sub new { shift; bless { @_ }, "Call" } sub invocant { @_ == 1 ? ( $_[0]->{invocant} ) : ( $_[0]->{invocant} = $_[1] ) }; sub hyper { @_ == 1 ? ( $_[0]->{hyper} ) : ( $_[0]->{hyper} = $_[1] ) }; sub method { @_ == 1 ? ( $_[0]->{method} ) : ( $_[0]->{method} = $_[1] ) }; sub arguments { @_ == 1 ? ( $_[0]->{arguments} ) : ( $_[0]->{arguments} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; my  $invocant = $self->{invocant}->emit(); do { if (($invocant eq 'self')) { $invocant = '$self' } else {  } }; do { if ((($self->{method} eq 'perl') || (($self->{method} eq 'yaml') || (($self->{method} eq 'say') || (($self->{method} eq 'join') || (($self->{method} eq 'chars') || ($self->{method} eq 'isa'))))))) { do { if ($self->{hyper}) { return(('[ map { Main::' . ($self->{method} . ('( $_, ' . (', ' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . (')' . (' } @{ ' . ($invocant . ' } ]'))))))))) } else { return(('Main::' . ($self->{method} . ('(' . ($invocant . (', ' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . ')'))))))) } } } else {  } }; my  $meth = $self->{method}; do { if (($meth eq 'postcircumfix:<( )>')) { $meth = '' } else {  } }; do { if ($self->{hyper}) { ('[ map { ' . ('MO::Run::Aux::method_call( ' . ('$_' . (', q(' . ($meth . ('), ' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . (')' . (' } @{ ' . ($invocant . ' } ]')))))))))) } else { ('MO::Run::Aux::method_call( ' . ($invocant . (', q(' . ($meth . ('), ' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . ')')))))) } } }
 ;
 package Apply; sub new { shift; bless { @_ }, "Apply" } sub code { @_ == 1 ? ( $_[0]->{code} ) : ( $_[0]->{code} = $_[1] ) }; sub arguments { @_ == 1 ? ( $_[0]->{arguments} ) : ( $_[0]->{arguments} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; my  $code = $self->{code}; do { if (($code eq 'say')) { return(('Main::say(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . ')'))) } else {  } }; do { if (($code eq 'print')) { return(('Main::print(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . ')'))) } else {  } }; do { if (($code eq 'array')) { return(('@{' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' ') . '}'))) } else {  } }; do { if (($code eq 'prefix:<~>')) { return(('("" . ' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' ') . ')'))) } else {  } }; do { if (($code eq 'prefix:<!>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' ') . ' ? 0 : 1)'))) } else {  } }; do { if (($code eq 'prefix:<?>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' ') . ' ? 1 : 0)'))) } else {  } }; do { if (($code eq 'prefix:<$>')) { return(('${' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' ') . '}'))) } else {  } }; do { if (($code eq 'prefix:<@>')) { return(('@{' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' ') . '}'))) } else {  } }; do { if (($code eq 'prefix:<%>')) { return(('%{' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' ') . '}'))) } else {  } }; do { if (($code eq 'infix:<~>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' . ') . ')'))) } else {  } }; do { if (($code eq 'infix:<+>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' + ') . ')'))) } else {  } }; do { if (($code eq 'infix:<->')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' - ') . ')'))) } else {  } }; do { if (($code eq 'infix:<&&>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' && ') . ')'))) } else {  } }; do { if (($code eq 'infix:<||>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' || ') . ')'))) } else {  } }; do { if (($code eq 'infix:<eq>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' eq ') . ')'))) } else {  } }; do { if (($code eq 'infix:<ne>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' ne ') . ')'))) } else {  } }; do { if (($code eq 'infix:<==>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' == ') . ')'))) } else {  } }; do { if (($code eq 'infix:<!=>')) { return(('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ' != ') . ')'))) } else {  } }; do { if (($code eq 'ternary:<?? !!>')) { return(('(' . ($self->{arguments}->[0]->emit() . (' ? ' . ($self->{arguments}->[1]->emit() . (' : ' . ($self->{arguments}->[2]->emit() . ')'))))))) } else {  } }; ($self->{code} . ('(' . (Main::join([ map { $_->emit() } @{ $self->{arguments} } ], ', ') . ')'))) }
 ;
-package Return; sub new { shift; bless { @_ }, "Return" } sub result { @_ == 1 ? ( $_[0]->{result} ) : ( $_[0]->{result} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; return(('return(' . ($self->{result}->emit() . ')'))) }
+package Return; sub new { shift; bless { @_ }, "Return" } sub result { @_ == 1 ? ( $_[0]->{result} ) : ( $_[0]->{result} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; ('return(' . ($self->{result}->emit() . ')')) }
 ;
 package If; sub new { shift; bless { @_ }, "If" } sub cond { @_ == 1 ? ( $_[0]->{cond} ) : ( $_[0]->{cond} = $_[1] ) }; sub body { @_ == 1 ? ( $_[0]->{body} ) : ( $_[0]->{body} = $_[1] ) }; sub otherwise { @_ == 1 ? ( $_[0]->{otherwise} ) : ( $_[0]->{otherwise} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; ('do { if (' . ($self->{cond}->emit() . (') { ' . (Main::join([ map { $_->emit() } @{ $self->{body} } ], ';') . (' } else { ' . (Main::join([ map { $_->emit() } @{ $self->{otherwise} } ], ';') . ' } }')))))) }
@@ -52 +52 @@
 package Sig; sub new { shift; bless { @_ }, "Sig" } sub invocant { @_ == 1 ? ( $_[0]->{invocant} ) : ( $_[0]->{invocant} = $_[1] ) }; sub positional { @_ == 1 ? ( $_[0]->{positional} ) : ( $_[0]->{positional} = $_[1] ) }; sub named { @_ == 1 ? ( $_[0]->{named} ) : ( $_[0]->{named} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; ' print \'Signature - TODO\'; die \'Signature - TODO\'; ' }; sub invocant { my $self = shift; my $List__ = \@_; do { [] }; $self->{invocant} }; sub positional { my $self = shift; my $List__ = \@_; do { [] }; $self->{positional} }
 ;
-package Method; sub new { shift; bless { @_ }, "Method" } sub name { @_ == 1 ? ( $_[0]->{name} ) : ( $_[0]->{name} = $_[1] ) }; sub sig { @_ == 1 ? ( $_[0]->{sig} ) : ( $_[0]->{sig} = $_[1] ) }; sub block { @_ == 1 ? ( $_[0]->{block} ) : ( $_[0]->{block} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; my  $sig = $self->{sig}; my  $invocant = $sig->invocant(); my  $pos = $sig->positional(); my  $str = 'my $List__ = \@_; '; my  $pos = $sig->positional(); do { for my $field ( @{$pos} ) { $str = ($str . ('my ' . ($field->emit() . '; '))) } }; my  $bind = Bind->new( 'parameters' => Lit::Array->new( 'array' => $sig->positional(), ),'arguments' => Var->new( 'sigil' => '@','twigil' => '','name' => '_', ), ); $str = ($str . ($bind->emit() . '; ')); ('sub ' . ($self->{name} . (' { ' . ('my ' . ($invocant->emit() . (' = shift; ' . ($str . (Main::join([ map { $_->emit() } @{ $self->{block} } ], '; ') . ' }')))))))) }
+package Method; sub new { shift; bless { @_ }, "Method" } sub name { @_ == 1 ? ( $_[0]->{name} ) : ( $_[0]->{name} = $_[1] ) }; sub sig { @_ == 1 ? ( $_[0]->{sig} ) : ( $_[0]->{sig} = $_[1] ) }; sub block { @_ == 1 ? ( $_[0]->{block} ) : ( $_[0]->{block} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; my  $sig = $self->{sig}; my  $invocant = $sig->invocant(); my  $pos = $sig->positional(); my  $str = 'my $List__ = \@_; no strict "vars"; '; my  $bind = Bind->new( 'parameters' => Lit::Array->new( 'array' => $sig->positional(), ),'arguments' => Var->new( 'sigil' => '@','twigil' => '','name' => '_', ), ); $str = ($str . ($bind->emit() . '; ')); ('sub { ' . ('my ' . ($invocant->emit() . (' = shift; ' . ($str . (Main::join([ map { $_->emit() } @{ $self->{block} } ], '; ') . ' }')))))) }
 ;
-package Sub; sub new { shift; bless { @_ }, "Sub" } sub name { @_ == 1 ? ( $_[0]->{name} ) : ( $_[0]->{name} = $_[1] ) }; sub sig { @_ == 1 ? ( $_[0]->{sig} ) : ( $_[0]->{sig} = $_[1] ) }; sub block { @_ == 1 ? ( $_[0]->{block} ) : ( $_[0]->{block} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; my  $sig = $self->{sig}; my  $pos = $sig->positional(); my  $str = 'my $List__ = \@_; '; my  $pos = $sig->positional(); do { for my $field ( @{$pos} ) { $str = ($str . ('my ' . ($field->emit() . '; '))) } }; my  $bind = Bind->new( 'parameters' => Lit::Array->new( 'array' => $sig->positional(), ),'arguments' => Var->new( 'sigil' => '@','twigil' => '','name' => '_', ), ); $str = ($str . ($bind->emit() . '; ')); ('sub ' . ($self->{name} . (' { ' . ($str . (Main::join([ map { $_->emit() } @{ $self->{block} } ], '; ') . ' }'))))) }
+package Sub; sub new { shift; bless { @_ }, "Sub" } sub name { @_ == 1 ? ( $_[0]->{name} ) : ( $_[0]->{name} = $_[1] ) }; sub sig { @_ == 1 ? ( $_[0]->{sig} ) : ( $_[0]->{sig} = $_[1] ) }; sub block { @_ == 1 ? ( $_[0]->{block} ) : ( $_[0]->{block} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; my  $sig = $self->{sig}; my  $pos = $sig->positional(); my  $str = 'my $List__ = \@_; no strict "vars"; '; my  $bind = Bind->new( 'parameters' => Lit::Array->new( 'array' => $sig->positional(), ),'arguments' => Var->new( 'sigil' => '@','twigil' => '','name' => '_', ), ); $str = ($str . ($bind->emit() . '; ')); ('sub ' . ($self->{name} . (' { ' . ($str . (Main::join([ map { $_->emit() } @{ $self->{block} } ], '; ') . ' }'))))) }
 ;
 package Do; sub new { shift; bless { @_ }, "Do" } sub block { @_ == 1 ? ( $_[0]->{block} ) : ( $_[0]->{block} = $_[1] ) }; sub emit { my $self = shift; my $List__ = \@_; do { [] }; ('do { ' . (Main::join([ map { $_->emit() } @{ $self->{block} } ], '; ') . ' }')) }

v6/v6-MiniPerl6-MO/mp6-perl5-mo.pl

@@ -14 +14 @@
 package Main;
 use MiniPerl6::Grammar;
-use MiniPerl6::Perl5MO::Emitter;
+use MiniPerl6::Perl5::Emitter;
 use MiniPerl6::Grammar::Regex;
 use MiniPerl6::Emitter::Token;
@@ -27 +27 @@
 say( "use MiniPerl6::Perl5::Match;" );
 
+#say( "use MO::Run::Aux;" );
+#say( "BEGIN { $MO::Run::Aux::MO_NATIVE_RUNTIME = 1 }");
+
 while ( $pos < length( $source ) ) {
     #say( "Source code:", $source );