# use v6-alpha; # No. This is "fake" perl6 code understood by PIL-Run.

# XXX - doesnt work quite yet...
#module PIL::Run::Root::P5Runtime::PrimP6-0.0.1;

=kwid

This file contains p5 runtime primitives which are written in p6.
Most will eventually be implemented in perl6/Prelude.pm, and can
then be removed from here.

See the note at the top of Prelude.pm.

=cut

my $?PUGS_BACKEND = "BACKEND_PERL5";

multi sub nothing () is builtin is primitive is safe {
    bool::true}

multi sub not ($x) {!$x}

multi sub postcircumfix:<[ ]> ($a,$i) { Array::slice($a,$i) }

multi sub infix:<|> (*@x) { any(@x) }
multi sub infix:<&> (*@x) { all(@x) }
multi sub infix:<^> (*@x) { one(@x) }

# multi sub circumfix:<[]> ($a) { \($a) }

# TODO - string versions
multi sub infix:<..^>   ($x0,$x1) { $x0..($x1.decrement) }
multi sub infix:<^..>   ($x0,$x1) { ($x0.increment)..$x1 }
multi sub infix:<^..^>  ($x0,$x1) { ($x0.increment)..($x1.decrement) }
multi sub postfix:<...> ($x0) { $x0 .. Inf };

multi sub prefix:<~> ($xx) { coerce:as($xx,'Str') }
multi sub prefix:<?> ($xx) { coerce:as($xx,'Bit') }
multi sub prefix:<+> ($xx) { coerce:as($xx,'Num') }
# multi sub prefix:<\\> ($xx) { coerce:as($xx,'Ref') }
multi sub true ($xx) { coerce:as($xx,'Bit') };
multi sub int  ($xx) { coerce:as($xx,'Int') };

multi sub prefix:<!> ($xx) { 1 - coerce:as($xx,'Bit') }

# multi sub zip ($x0,$x1) { $x0.Array::zip($x1) }
multi sub infix:<Y> # is assoc<list>    XXX Pugs parser TODO 
    ($x0,$x1) { $x0.zip($x1) }
multi sub infix:<¥> # is assoc<list>    XXX Pugs parser TODO
    ($x0,$x1) { $x0.zip($x1) }

multi sub prefix:<-> ($x) { 0 - $x }
multi sub sign ($x) { $x <=> 0 }
multi sub abs  ($x) { if $x < 0 { -$x } else { $x } }

multi sub grep ($array,$code) { 
    $array.map( { if ( $code($_) ) { $_ } else { () } } )
}

multi sub uniq ($array) { 
    my %seen;
    # $array.map( { if %seen.fetch($_) { () } else { %seen.store($_,1); $_ } } )
    $array.map( { if %seen{$_} { () } else { %seen{$_} = 1; $_ } } )
}

multi sub statement_control:loop ($init,$test,$incr,$code) {
    while($test()) {
	$code();
	$incr();
    }
}
multi sub statement_control:until ($test,$code) {
    while(!$test()) {
	$code();
    }
}
multi sub statement_control:for (@a,$code) {
    my $i = 0;
    my $len = +@a;
    my $arity = $code.arity;
    if $arity <= 1 {
	while $i < $len {
	    $code(@a[$i]);
	    $i++;
	}
    } elsif $arity == 2 {
	while $i < $len {
	    $code(@a[$i],@a[$i+1]);
	    $i += 2;
	}
    } elsif $arity == 5 {
	while $i < $len {
	    $code(@a[$i],@a[$i+1],@a[$i+2],@a[$i+3],@a[$i+4]);
	    $i += 5;
	}
    } else {
	die "statement_control:for not fully implemented";
    }
}

multi sub eval($code,:$langpair = undef) {
    my $lang = "Perl6";
    try { $lang = $langpair.value }; # XXX - pilrun multi-bug workaround
    $lang = lc $lang;
    if $lang eq "perl6" { Pugs::Internals::eval_perl6($code) }
    elsif $lang eq "perl5" { Pugs::Internals::eval_perl5($code) }
    else { die "Language \"$lang\" unknown."; }
}

multi sub infix:<eqv> ($a, $b) {
    $a eq $b
}