Merge branch 'MAIN'

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 = \

src/Perl6/Actions.pm

@@ -61,6 +61,18 @@ method comp_unit($/, $key?) {
         return 1;
     }
 
+    # run MAIN subs
+    # 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;
     my $unit := PAST::Block.new( :node($/), :hll($?RAKUDO_HLL) );

src/core/MAIN.pm

@@ -0,0 +1,75 @@
+our 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 {
+        return;
+    }
+    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);
+}

src/glue/run.pir

@@ -21,6 +21,36 @@ of the compilation unit.
  .include 'sysinfo.pasm'
 .include 'iglobals.pasm'
 
+.sub 'IN_EVAL'
+    .local pmc interp
+    .local int level
+    .local int result
+    .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
+  loop:
+    inc level
+    $P0 = interp['sub'; level]
+    if null $P0 goto done
+    eq_addr $P0, eval, has_eval
+    goto loop
+
+  has_eval:
+    inc result
+
+  done:
+    $P0 = box result
+    .return($P0)
+.end
+
 .sub '!UNIT_START'
     .param pmc mainline
     .param pmc args            :slurpy