From f7ddcf57efbf25eb49d2a9b66b47aa80d8dd67df Mon Sep 17 00:00:00 2001
From: Moritz Lenz <moritz@faui2k3.org>
Date: Tue, 8 Jun 2010 22:08:02 +0200
Subject: [PATCH 1/7] try to actually run MAIN subs; most code by patrickas++

---
 build/Makefile.in    |  1 +
 src/Perl6/Actions.pm |  7 +++++
 src/core/MAIN.pm     | 75 ++++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 83 insertions(+)
 create mode 100644 src/core/MAIN.pm

diff --git a/build/Makefile.in b/build/Makefile.in
index 83ea62ab333..48eea9bce3c 100644
--- a/build/Makefile.in
+++ b/build/Makefile.in
@@ -219,6 +219,7 @@ CORE_SOURCES = \
   src/core/Date.pm \
   src/core/Temporal.pm \
   src/core/Match.pm \
+  src/core/MAIN.pm \
   src/core/YOU_ARE_HERE.pm \
 
 PMC_SOURCES = \
diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
index 2e653fc1f18..e5a1dc1e5ab 100644
--- a/src/Perl6/Actions.pm
+++ b/src/Perl6/Actions.pm
@@ -107,6 +107,13 @@ method comp_unit($/, $key?) {
         $unit.unshift(PAST::Op.new(:inline(".annotate 'file', '" ~ $file ~ "'")));
     }
 
+    $unit.push(
+        PAST::Op.new(
+            :pasttype('call'),
+            :name('&MAIN_HELPER'),
+        )
+    );
+
     # Remove the outer module package.
     @PACKAGE.shift;
 
diff --git a/src/core/MAIN.pm b/src/core/MAIN.pm
new file mode 100644
index 00000000000..81b456f0cd8
--- /dev/null
+++ b/src/core/MAIN.pm
@@ -0,0 +1,75 @@
+my sub process-cmd-args(@args, %named) {
+    my (@positional-arguments, %named-arguments , $negate);
+    while ( @args )  {
+        my $passed_value = @args.shift;
+        if substr($passed_value,0,2) eq '--' {
+            my $arg = $passed_value.substr(2);
+            if $arg.match(/^\//) {
+                $arg .= substr(1) ;
+                $negate = $arg;
+            }
+
+            if $arg eq '' {
+                @positional-arguments.push: @args;
+                last;
+            } elsif %named{$arg} ~~ Bool {
+                %named-arguments{$arg}=True;
+            } elsif %named{$arg} ~~ Array || ($passed_value.match( /\=/ ) &&  %named{$arg.split('=', 2)[0]} ~~ Array ) {
+                if $passed_value.match( /\=/ ) {
+                    my ($name , $value) = $arg.split('=', 2);
+                    if $negate {$negate=$name;}
+                    %named-arguments{$name} = [$value.split(',')];
+                } else {
+                    %named-arguments{$arg} = [@args.shift.split(',')];
+                }
+            } elsif $passed_value.match( /\=/ ) {
+                my ($name , $value) = $arg.split('=', 2);
+                if $negate {$negate=$name;}
+                if ($value.match(/^\'.*\'$/) || $value.match(/^\".*\"$/) ) {
+                    %named-arguments{$name} = $value.substr(1,-1);
+                } elsif $value.match( /.\,./ ) { #--separator=, should not be an array by default but --values=1,2,3 should be
+                    %named-arguments{$name} = [$value.split(',')];
+                } else {
+                    %named-arguments{$name} = $value;
+                }
+            } elsif $negate {
+                %named-arguments{$arg} = False;
+                $negate='';
+            } else {
+                %named-arguments{$arg}=@args.shift;
+            }
+        } else {
+            @positional-arguments.push: $passed_value;
+        }
+
+        if $negate {
+            %named-arguments{$negate} does False;
+            $negate = '';
+        }
+    }
+
+    return @positional-arguments, %named-arguments;
+}
+
+
+our sub MAIN_HELPER() {
+    my $m = Q:PIR {
+        $P0 = getinterp
+        $P0 = $P0['lexpad';1]
+        $P0 = $P0['&MAIN']
+        unless null $P0 goto has_main
+        %r  = get_hll_global "Any"
+        goto done
+    has_main:
+        %r  = $P0
+    done:
+    };
+    unless $m {
+        say "no MAIN, no cookie";
+    }
+    my @named-params = $m.signature.params.grep: {.named && .type ~~ Bool};
+    my %named-params = @named-params».name».substr(1) Z=> @named-params».type;
+    my @positional = process-cmd-args(@*ARGS, %named-params);
+    my %named = @positional.pop;
+    $m(|@positional, |%named);
+}

From b0d427b127ea72764d8117f8d49c48f80f01fed1 Mon Sep 17 00:00:00 2001
From: Moritz Lenz <moritz@faui2k3.org>
Date: Wed, 9 Jun 2010 07:50:35 +0200
Subject: [PATCH 2/7] second attempt at MAIN sub

---
 src/Perl6/Actions.pm | 15 ++++++++-------
 src/core/MAIN.pm     |  4 ++--
 2 files changed, 10 insertions(+), 9 deletions(-)

diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
index e5a1dc1e5ab..f61e25b3a46 100644
--- a/src/Perl6/Actions.pm
+++ b/src/Perl6/Actions.pm
@@ -61,6 +61,14 @@ method comp_unit($/, $key?) {
         return 1;
     }
 
+    # run MAIN subs
+    $mainline.push(
+        PAST::Op.new(
+            :pasttype('call'),
+            :name('&MAIN_HELPER')
+        )
+    );
+
     # Create a block for the entire compilation unit.
     our $?RAKUDO_HLL;
     my $unit := PAST::Block.new( :node($/), :hll($?RAKUDO_HLL) );
@@ -107,13 +115,6 @@ method comp_unit($/, $key?) {
         $unit.unshift(PAST::Op.new(:inline(".annotate 'file', '" ~ $file ~ "'")));
     }
 
-    $unit.push(
-        PAST::Op.new(
-            :pasttype('call'),
-            :name('&MAIN_HELPER'),
-        )
-    );
-
     # Remove the outer module package.
     @PACKAGE.shift;
 
diff --git a/src/core/MAIN.pm b/src/core/MAIN.pm
index 81b456f0cd8..0d0c86fd402 100644
--- a/src/core/MAIN.pm
+++ b/src/core/MAIN.pm
@@ -1,4 +1,4 @@
-my sub process-cmd-args(@args, %named) {
+our sub process-cmd-args(@args, %named) {
     my (@positional-arguments, %named-arguments , $negate);
     while ( @args )  {
         my $passed_value = @args.shift;
@@ -65,7 +65,7 @@ our sub MAIN_HELPER() {
     done:
     };
     unless $m {
-        say "no MAIN, no cookie";
+        return;
     }
     my @named-params = $m.signature.params.grep: {.named && .type ~~ Bool};
     my %named-params = @named-params».name».substr(1) Z=> @named-params».type;

From 3657ad7554ef7ef32a502f48afbfa3412302afb2 Mon Sep 17 00:00:00 2001
From: Moritz Lenz <moritz@faui2k3.org>
Date: Wed, 9 Jun 2010 07:58:48 +0200
Subject: [PATCH 3/7] add TODO comment wrt MAIN sub

---
 src/Perl6/Actions.pm | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
index f61e25b3a46..07e27f1b55e 100644
--- a/src/Perl6/Actions.pm
+++ b/src/Perl6/Actions.pm
@@ -62,6 +62,7 @@ method comp_unit($/, $key?) {
     }
 
     # run MAIN subs
+    # TODO: run this only when not in a module and not in eval
     $mainline.push(
         PAST::Op.new(
             :pasttype('call'),

From c77e2780c294bfac6612a1c5c004ca51b3af3f54 Mon Sep 17 00:00:00 2001
From: Moritz Lenz <moritz@faui2k3.org>
Date: Wed, 9 Jun 2010 09:58:20 +0200
Subject: [PATCH 4/7] check for eval()ness by walking the call chain

---
 src/Perl6/Actions.pm | 17 ++++++++++-------
 src/glue/run.pir     | 23 +++++++++++++++++++++++
 2 files changed, 33 insertions(+), 7 deletions(-)

diff --git a/src/Perl6/Actions.pm b/src/Perl6/Actions.pm
index 07e27f1b55e..ea9462348ca 100644
--- a/src/Perl6/Actions.pm
+++ b/src/Perl6/Actions.pm
@@ -62,13 +62,16 @@ method comp_unit($/, $key?) {
     }
 
     # run MAIN subs
-    # TODO: run this only when not in a module and not in eval
-    $mainline.push(
-        PAST::Op.new(
-            :pasttype('call'),
-            :name('&MAIN_HELPER')
-        )
-    );
+    # TODO: run this only when not in a module
+    # TODO: find a less hacky solution than IN_EVAL
+    unless IN_EVAL() {
+        $mainline.push(
+            PAST::Op.new(
+                :pasttype('call'),
+                :name('&MAIN_HELPER')
+            )
+        );
+    }
 
     # Create a block for the entire compilation unit.
     our $?RAKUDO_HLL;
diff --git a/src/glue/run.pir b/src/glue/run.pir
index e54bb07bbc6..1e3c4cf7c8a 100644
--- a/src/glue/run.pir
+++ b/src/glue/run.pir
@@ -21,6 +21,29 @@ of the compilation unit.
  .include 'sysinfo.pasm'
 .include 'iglobals.pasm'
 
+.sub 'IN_EVAL'
+    .local pmc interp
+    .local int level
+    .local int result
+    result = 0
+    level  = 0
+    interp = getinterp
+  loop:
+    inc level
+    $P0 = interp['sub'; level]
+    if null $P0 goto done
+    $S0 = $P0
+    if $S0 == 'eval' goto has_eval
+    goto loop
+
+  has_eval:
+    result = 1
+
+  done:
+    $P0 = box result
+    .return($P0)
+.end
+
 .sub '!UNIT_START'
     .param pmc mainline
     .param pmc args            :slurpy

From d33a9583dbdd82b0587221a80a6247a5c6018e16 Mon Sep 17 00:00:00 2001
From: Moritz Lenz <moritz@faui2k3.org>
Date: Wed, 9 Jun 2010 12:25:02 +0200
Subject: [PATCH 5/7] IN_EVAL needs to count the number of eval()s, since there
 is always one in the compilation call chain

---
 src/glue/run.pir | 13 ++++++++++++-
 1 file changed, 12 insertions(+), 1 deletion(-)

diff --git a/src/glue/run.pir b/src/glue/run.pir
index 1e3c4cf7c8a..c1fe7dafbe8 100644
--- a/src/glue/run.pir
+++ b/src/glue/run.pir
@@ -25,9 +25,18 @@ of the compilation unit.
     .local pmc interp
     .local int level
     .local int result
+
+    # walk tha call chain to determine if we're inside an eval()
+    # this is a bit clumsy and brittle because the compilation process
+    # already contains a sub or method named 'eval', so we have to check if
+    # there are at least two subs named 'eval' in the call chain.
+
     result = 0
     level  = 0
     interp = getinterp
+    # interp[sub;$to_high_level] throws an exception
+    # so when we catch one, we're done walking the call chain
+    push_eh done
   loop:
     inc level
     $P0 = interp['sub'; level]
@@ -37,9 +46,11 @@ of the compilation unit.
     goto loop
 
   has_eval:
-    result = 1
+    inc result
+    goto loop
 
   done:
+    dec result
     $P0 = box result
     .return($P0)
 .end

From 9f05efac869ae7205bd9ad46f2c494d3caf6e8cb Mon Sep 17 00:00:00 2001
From: Moritz Lenz <moritz@faui2k3.org>
Date: Wed, 9 Jun 2010 13:24:38 +0200
Subject: [PATCH 6/7] exit early in MAIN_HELPER

---
 src/glue/run.pir | 1 +
 1 file changed, 1 insertion(+)

diff --git a/src/glue/run.pir b/src/glue/run.pir
index c1fe7dafbe8..2288acebf16 100644
--- a/src/glue/run.pir
+++ b/src/glue/run.pir
@@ -47,6 +47,7 @@ of the compilation unit.
 
   has_eval:
     inc result
+    if result == 2 goto done
     goto loop
 
   done:

From 11366ab9467c6142db67841f97be54c4e792f253 Mon Sep 17 00:00:00 2001
From: Moritz Lenz <moritz@faui2k3.org>
Date: Wed, 9 Jun 2010 13:50:30 +0200
Subject: [PATCH 7/7] make IN_EVAL more robust, with input from jnthn++

---
 src/glue/run.pir | 15 +++++----------
 1 file changed, 5 insertions(+), 10 deletions(-)

diff --git a/src/glue/run.pir b/src/glue/run.pir
index 2288acebf16..469ed86eb9b 100644
--- a/src/glue/run.pir
+++ b/src/glue/run.pir
@@ -25,15 +25,14 @@ of the compilation unit.
     .local pmc interp
     .local int level
     .local int result
-
-    # walk tha call chain to determine if we're inside an eval()
-    # this is a bit clumsy and brittle because the compilation process
-    # already contains a sub or method named 'eval', so we have to check if
-    # there are at least two subs named 'eval' in the call chain.
+    .local pmc eval
 
     result = 0
     level  = 0
     interp = getinterp
+    eval = get_hll_global '&eval'
+    eval = getattribute eval, '$!do'
+
     # interp[sub;$to_high_level] throws an exception
     # so when we catch one, we're done walking the call chain
     push_eh done
@@ -41,17 +40,13 @@ of the compilation unit.
     inc level
     $P0 = interp['sub'; level]
     if null $P0 goto done
-    $S0 = $P0
-    if $S0 == 'eval' goto has_eval
+    eq_addr $P0, eval, has_eval
     goto loop
 
   has_eval:
     inc result
-    if result == 2 goto done
-    goto loop
 
   done:
-    dec result
     $P0 = box result
     .return($P0)
 .end