{-# OPTIONS -fglasgow-exts #-}
 
{-
    *** NOTE ***
    DO NOT EDIT THIS FILE.
    This module is automatically generated by src/gen_prelude.hs.
-}
 
{-|
    Perl 6 Prelude.
 
>   The world was fair, the mountains tall,
>   In Eldar Days before the fall
>   Of mighty kings in Nargothrond
>   And Gondolin, who now beyond
>   The Western Seas have passed away:
>   The world was fair in Durin's day.
 
-}
 
 
module Pugs.CodeGen.PIR.Prelude (
    preludeStr
) where
 
preludeStr :: String
preludeStr = unlines
    [ ""
    , ""
    , "sub prefix:<?> ($var) returns Bool is builtin is primitive { true $var }"
    , ""
    , "sub chomp (Str $str) returns Str is builtin is primitive {"
    , "    if substr($str, -1, 1) eq \"\\n\" {"
    , "        substr $str, 0, chars($str) - 1;"
    , "    } else {"
    , "        $str;"
    , "    }"
    , "}"
    , ""
    , "sub chop (Str $str is rw) returns Str is builtin is primitive {"
    , "    if chars($str) == 0 {"
    , "        undef;"
    , "    } else {"
    , "        my $removed = substr $str, -1, 1;"
    , "        $str = substr $str, 0, chars($str) - 1;"
    , "        $removed;"
    , "    }"
    , "}"
    , ""
    , "sub sleep (Num $seconds) returns Num is builtin is primitive {"
    , "    my $time = time;"
    , "    Perl6::Internals::sleep $seconds;"
    , "    my $seconds_slept = time() - $time;"
    , "    $seconds_slept;"
    , "}"
    , ""
    , "sub exit (Int $status = 0) is builtin is primitive {"
    , "    Perl6::Internals::exit $status;"
    , "}"
    , ""
    , "sub Perl6::Internals::eval_parrot (Str $code) is builtin is primitive {"
    , "    my $sub = substr($code, 0, 1) eq \".\""
    , "        ?? Perl6::Internals::compile_pir($code)"
    , "        !! Perl6::Internals::compile_pir(\".sub pugs_eval_parrot\\n$code\\n.end\\n\");"
    , "    $sub();"
    , "}"
    , ""
    , "sub pi () returns Num is builtin is primitive {"
    , "    3.14159265358979323846264338327950288419716939937510;"
    , "}"
    , ""
    , "sub lcfirst (Str $str) returns Str is builtin is primitive {"
    , "    lc(substr $str, 0, 1) ~ substr $str, 1, chars($str) - 1;"
    , "}"
    , ""
    , "sub ucfirst (Str $str) returns Str is builtin is primitive {"
    , "    uc(substr $str, 0, 1) ~ substr $str, 1, chars($str) - 1;"
    , "}"
    , ""
    , "sub shift (@a) is builtin is primitive {"
    , "    my $top = +@a -1;"
    , "    return undef if $top < 0;"
    , "    my $e = @a[0];"
    , "    my $i = 0;"
    , "    while $i < $top {"
    , "        @a[$i++] = @a[$i];"
    , "    }"
    , "    pop(@a);"
    , "    return $e;"
    , "}"
    , ""
    , "sub splice (@a is rw, $offset=0, $length?, *@list) is builtin is primitive {"
    , "    my $off = +$offset;"
    , "    my $len = $length;"
    , "    my $size = +@a;"
    , ""
    , "    $off += $size if $off < 0;"
    , "    if $off > $size {"
    , "        warn \"splice() offset past end of array\\n\";"
    , "        $off = $size;"
    , "    }"
    , ""
    , "    $len = +$len if defined($len);"
    , "    $len = $size - $off if !defined($len);"
    , "    $len = $size + $len - $off if $len < 0;"
    , "    $len = 0 if $len < 0;"
    , ""
    , "    my $listlen = +@list;"
    , "    my $size_change = $listlen - $len;"
    , "    my @result;"
    , ""
    , "    if 1 {"
    , "        my $i = $off;"
    , "        my $stop = $off + $len;"
    , "        while $i < $stop {"
    , "            push(@result,@a[$i]);"
    , "            $i++;"
    , "        }"
    , "    }"
    , ""
    , "    if $size_change > 0 {"
    , "        my $i = $size + $size_change -1;"
    , "        my $final = $off + $size_change;"
    , "        while $i >= $final {"
    , "            @a[$i] = @a[$i-$size_change];"
    , "            $i--;"
    , "        }"
    , "    } elsif $size_change < 0 {"
    , "        my $i = $off;"
    , "        my $final = $size + $size_change -1;"
    , "        while $i <= $final {"
    , "            @a[$i] = @a[$i-$size_change];"
    , "            $i++;"
    , "        }"
    , "        my $n = 0;"
    , "        while $n-- > $size_change {"
    , "            pop(@a);"
    , "        }"
    , "    }"
    , ""
    , "    if $listlen > 0 {"
    , "        my $i = 0;"
    , "        while $i < $listlen {"
    , "            @a[$off+$i] = @list[$i];"
    , "            $i++;"
    , "        }"
    , "    }"
    , ""
    , "    @result;"
    , "}"

    ]