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..ea9462348ca 100644 --- a/src/Perl6/Actions.pm +++ b/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) ); diff --git a/src/core/MAIN.pm b/src/core/MAIN.pm new file mode 100644 index 00000000000..0d0c86fd402 --- /dev/null +++ b/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); +} diff --git a/src/glue/run.pir b/src/glue/run.pir index e54bb07bbc6..469ed86eb9b 100644 --- a/src/glue/run.pir +++ b/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