{-# 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 {"
    , "\t@a[$i++] = @a[$i];"
    , "    }"
    , "    pop(@a);"
    , "    return $e;"
    , "}"
    , ""
    , "sub splice (@a, ?$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 {"
    , "\twarn \"splice() offset past end of array\\n\";"
    , "\t$off = $size;"
    , "    }"
    , ""
    , "    $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 $size_change > 0 {"
    , "\tmy $i = $size + $size_change -1;"
    , "\tmy $final = $off + $size_change;"
    , "\twhile $i >= $final {"
    , "\t    @a[$i] = @a[$i-$size_change];"
    , "\t    $i--;"
    , "\t}"
    , "    } elsif $size_change < 0 {"
    , "\tmy $i = $off;"
    , "\tmy $final = $size + $size_change -1;"
    , "\twhile $i <= $final {"
    , "\t    push(@result,$a[$i]);"
    , "\t    @a[$i] = @a[$i-$size_change];"
    , "\t    $i++;"
    , "\t}"
    , "\tmy $n = 0;"
    , "\twhile $n-- > $size_change {"
    , "\t    pop(@a);"
    , "\t}"
    , "    }"
    , ""
    , "    if $listlen > 0 {"
    , "\tmy $i = 0;"
    , "\twhile $i < $listlen {"
    , "\t    @a[$off+$i] = @list[$i];"
    , "\t}"
    , "    }"
    , ""
    , "    return @result;"
    , "}"

    ]

