view release on metacpan or  search on metacpan

src/perl6/Prelude.pm  view on Meta::CPAN

            month   => @tm[1],
            day     => @tm[2],
            hour    => @tm[3],
            min     => @tm[4],
            sec     => @tm[5],
            picosec => @tm[6],
            wday    => @tm[7],
            yday    => @tm[8],
            tzname  => @tm[9],
            tz      => @tm[10],
            is_dst  => @tm[11],
        );
    #}
    $res;
}

class Num {

    # Not Public API

    multi sub round_gen(Int $n, Code $corner) returns Int is primitive is safe {
        $n
    }
    multi sub round_gen(Num $n, Code $corner) returns Int is primitive is safe {
        (int($n) == $n) ?? int($n) !! $corner($n);
    }

    sub do_round($n) is primitive is safe {
        ($n < 0) ?? int( $n - 0.5) !! int($n + 0.5);
    }
    sub do_ceil($n) is primitive is safe {
        ($n < 0) ?? (-int(-$n)) !! int($n + 1)
    }
    sub do_floor($n) is primitive is safe {
        ($n < 0) ?? (-int(1-$n)) !! int($n)
    }

    # Public API (but signatures are not spec)

    sub round($n) is primitive is safe {
        Num::round_gen($n, &Num::do_round)
    }

    sub truncate($n) is primitive is safe {
        int($n)
    }
    our &trunc ::= &truncate;

    sub ceiling($n) is primitive is safe {
        Num::round_gen($n, &Num::do_ceil)
    }
    our &ceil ::= &ceiling;

    sub floor($n) is primitive is safe {
        Num::round_gen($n, &Num::do_floor)
    }
}

# *pi is non-spec (S29);  Should require use Math::Basic :constants;
# use Math::Basic :GLOBAL<pi>; fails to define *pi, so...
sub pi() is primitive is builtin is safe {Math::Basic::pi}


sub sprintf ($fmt, *@args) is primitive is builtin is safe {
    my $flen = $fmt.chars;
    my $fi = 0;
    my $ai = 0;
    my $str = "";
    while ($fi < $flen) {
        # optional non-conversion text
        my $idx = index($fmt,"%",$fi);
        if $idx < 0 {
            $str ~= substr($fmt,$fi);
            last;
        } else {
            my $len = $idx - $fi;
            $str ~= substr($fmt,$fi, $len) if $len > 0;
            $fi = $idx;
        }

        # a conversion
        my $start = $fi;
        $fi++;
        while !(substr($fmt,$fi,1)
                ~~ any(<% c s d u o x e f g X E G b p n i D U O F>)) {
            $fi++;
        }
        my $specifier = substr($fmt,$fi,1); $fi++;
        my $conversion = substr($fmt,$start,$fi - $start);

        # FIXME -- when next; works, do if $spec eq "%" { ...; next; }
        my $arg;
        if $specifier ne '%' {
            die "Insufficient arguments to sprintf" if $ai >= +@args;
            $arg = @args[$ai];
            $ai++;
        }

        given $specifier {
            when any(<c d u o x i>) {
                $str ~= Pugs::Internals::sprintf($conversion,int($arg));
            }

            ##
            # No "%b" in Haskell Printf libraries
            # This may not be 100% compatible with C sprintf,
            # or even the rest of Perl 6's sprintf
            when 'b' {
                my Bool @num;
                for (0..~int($arg).bytes*8-1) -> $bit {
                    push @num, int($arg) +& ( 1 ~ (0 x ($bit))) ?? 1 !! 0;
                }

                my $converted = int(@num.reverse.join(""));

                $conversion ~~ m:P5/(\d+)/;
                my $formatter = ~$0;
   
                my $length = int($formatter) - $converted.bytes;
   
                my $ret;