my src/core/sprintf.nqp

sprintf.nqp

my module sprintf {
    grammar Syntax {
        token TOP {
            :my $*ARGS_USED := 0;
            ^ <statement>* $
        }
        
        method panic($msg) { nqp::die($msg) }
        
        token statement {
            [
            | <?[%]> [ [ <directive> | <escape> ]
                || <.panic("'" ~ nqp::substr(self.orig,1) ~ "' is not valid in sprintf format sequence '" ~ self.orig ~ "'")> ]
            | <![%]> <literal>
            ]
        }

        proto token directive { <...> }
        token directive:sym<b> { '%' <flags>* <size>? [ '.' <precision=.size> ]? $<sym>=<[bB]> }
        token directive:sym<c> { '%' <flags>* <size>? <sym> }
        token directive:sym<d> { '%' <flags>* <size>? <sym> }
        token directive:sym<o> { '%' <flags>* <size>? [ '.' <precision=.size> ]? <sym> }
        token directive:sym<s> { '%' <flags>* <size>? <sym> }
        token directive:sym<u> { '%' <flags>* <size>? <sym> }
        token directive:sym<x> { '%' <flags>* <size>? [ '.' <precision=.size> ]? $<sym>=<[xX]> }

        proto token escape { <...> }
        token escape:sym<%> { '%' <flags>* <size>? <sym> }
        
        token literal { <-[%]>+ }
        
        token flags {
            | $<space> = ' '
            | $<plus>  = '+'
            | $<minus> = '-'
            | $<zero>  = '0'
            | $<hash>  = '#'
        }
        
        token size {
            \d* | $<star>='*'
        }
    }

    class sprintf::Actions {
        method TOP($/) {
            my @statements;
            @statements.push( $_.ast ) for $<statement>;

            if $*ARGS_USED < +@*ARGS_HAVE {
                nqp::die("Too few directives: found $*ARGS_USED,"
                ~ " fewer than the " ~ +@*ARGS_HAVE ~ " arguments after the format string")
            }
            if $*ARGS_USED > +@*ARGS_HAVE {
                nqp::die("Too many directives: found $*ARGS_USED, but "
                ~ (+@*ARGS_HAVE > 0 ?? "only " ~ +@*ARGS_HAVE !! "no")
                ~ " arguments after the format string")
            }
            make nqp::join('', @statements);
        }

        sub infix_x($s, $n) {
            my @strings;
            my $i := 0;
            @strings.push($s) while $i++ < $n;
            nqp::join('', @strings);
        }

        sub next_argument() {
            @*ARGS_HAVE[$*ARGS_USED++]
        }

        sub intify($number_representation) {
            my $result;
            if $number_representation > 0 {
                $result := nqp::floor_n($number_representation);
            }
            else {
                $result := nqp::ceil_n($number_representation);
            }
            $result;
        }

        sub padding_char($st) {
            my $padding_char := ' ';
            unless $st<precision> || has_flag($st, 'minus') {
                $padding_char := '0' if $_<zero> for $st<flags>;
            }
            make $padding_char
        }

        sub has_flag($st, $key) {
            my $ok := 0;
            if $st<flags> {
                $ok := 1 if $_{$key} for $st<flags>
            }
            $ok
        }

        method statement($/){
            my $st;
            if $<directive> { $st := $<directive> }
            elsif $<escape> { $st := $<escape> }
            else { $st := $<literal> }
            my @pieces;
            @pieces.push: infix_x(padding_char($st), $st<size>.ast - nqp::chars($st.ast)) if $st<size>;
            has_flag($st, 'minus')
                ?? @pieces.unshift: $st.ast
                !! @pieces.push:    $st.ast;
            make nqp::join('', @pieces)
        }

        method directive:sym<b>($/) {
            my $int := intify(next_argument());
            my $knowhow := nqp::knowhow().new_type(:repr("P6bigint"));
            $int := nqp::base_I(nqp::box_i($int, $knowhow), 2);
            my $pre := ($<sym> eq 'b' ?? '0b' !! '0B') if $int && has_flag($/, 'hash');
            if nqp::chars($<precision>) {
                $int := '' if $<precision>.ast == 0 && $int == 0;
                $int := $pre ~ infix_x('0', intify($<precision>.ast) - nqp::chars($int)) ~ $int;
            }
            else {
                $int := $pre ~ $int
            }
            make $int;
        }
        method directive:sym<c>($/) {
            make nqp::chr(next_argument())
        }
        method directive:sym<d>($/) {
            my $int := intify(next_argument());
            if $<size> {
                my $sign := $int < 0 ?? '-' !! '';
                $int := nqp::abs_i($int);
                $int := $sign ~ infix_x(padding_char($/), $<size>.ast - nqp::chars($int) - 1) ~ $int
            }
            make $int
        }
        method directive:sym<o>($/) {
            my $int := intify(next_argument());
            my $knowhow := nqp::knowhow().new_type(:repr("P6bigint"));
            $int := nqp::base_I(nqp::box_i($int, $knowhow), 8);
            my $pre := '0' if $int && has_flag($/, 'hash');
            if nqp::chars($<precision>) {
                $int := '' if $<precision>.ast == 0 && $int == 0;
                $int := $pre ~ infix_x('0', intify($<precision>.ast) - nqp::chars($int)) ~ $int;
            }
            else {
                $int := $pre ~ $int
            }
            make $int
        }

        method directive:sym<s>($/) {
            make next_argument()
        }
        # XXX: Should we emulate an upper limit, like 2**64?
        # XXX: Should we emulate p5 behaviour for negative values passed to %u ?
        method directive:sym<u>($/) {
            my $int := intify(next_argument());
            my $knowhow := nqp::knowhow().new_type(:repr("P6bigint"));
            if $int < 0 {
                    my $err := nqp::getstderr();
                    nqp::printfh($err, "negative value '" 
                                    ~ $int
                                    ~ "' for %u in sprintf");
                    $int := 0;
            }

            my $chars := nqp::chars($int);

            # Go throught tostr_I to avoid scientific notation.
            $int := nqp::box_i($int, $knowhow);
            make nqp::tostr_I($int)
        }
        method directive:sym<x>($/) {
            my $int := intify(next_argument());
            my $knowhow := nqp::knowhow().new_type(:repr("P6bigint"));
            $int := nqp::base_I(nqp::box_i($int, $knowhow), 16);
            my $pre := '0X' if $int && has_flag($/, 'hash');
            if nqp::chars($<precision>) {
                $int := '' if $<precision>.ast == 0 && $int == 0;
                $int := $pre ~ infix_x('0', intify($<precision>.ast) - nqp::chars($int)) ~ $int;
            }
            else {
                $int := $pre ~ $int
            }
            make $<sym> eq 'x' ?? nqp::lc($int) !! $int
        }

        method escape:sym<%>($/) {
            make '%'
        }

        method literal($/) {
            make ~$/
        }

        method size($/) {
            make $<star> ?? next_argument() !! ~$/
        }
    }

    my $actions := sprintf::Actions.new();

    sub sprintf($format, *@arguments) {
        my @*ARGS_HAVE := @arguments;
        return Syntax.parse( $format, :actions($actions) ).ast;
    }

    nqp::bindcurhllsym('sprintf', &sprintf);
}

stacktrace

$ make
perl -MExtUtils::Command -e mkpath src/stage1/gen
perl tools/build/gen-cat.pl jvm src/core/NativeTypes.nqp src/core/NQPRoutine.nqp src/core/NQPMu.nqp src/core/NQPCapture.nqp src/core/IO.nqp src/core/Regex.nqp src/core/Hash.nqp src/core/testing.nqp src/core/sprintf.nqp src/core/YOUAREHERE.nqp  > src/stage1/gen/NQPCORE.setting
java -cp src/vm/jvm/stage0 -Xbootclasspath/a:src/vm/jvm/stage0:nqp-runtime.jar:3rdparty/asm/asm-4.1.jar:3rdparty/asm/asm-tree-4.1.jar:3rdparty/jline/jline-1.0.jar:src/vm/jvm/stage0/nqp.jar nqp --bootstrap --module-path=src/stage1 --setting=NULL --no-regex-lib --target=jar \
	    --output=src/stage1/NQPCORE.setting.jar src/stage1/gen/NQPCORE.setting
Can not invoke this object
  in store_regex_caps (src/stage2/gen/NQP.nqp:3425)
  in qbuildsub (src/stage2/gen/NQPP6QRegex.nqp:900)
  in  (src/stage2/gen/NQP.nqp:2891)
  in regex_declarator (src/stage2/gen/NQP.nqp:2876)
  in !reduce (src/stage2/gen/QRegex.nqp:667)
  in !cursor_pass (src/stage2/gen/QRegex.nqp:631)
  in regex_declarator (src/stage2/gen/NQP.nqp:1204)
  in term:sym<regex_declarator> (src/stage2/gen/NQP.nqp)
  in !protoregex (src/stage2/gen/QRegex.nqp:699)
  in term (src/stage2/gen/NQPHLL.nqp)
  in termish (src/stage2/gen/NQPHLL.nqp)
  in EXPR (src/stage2/gen/NQPHLL.nqp:430)
  in statement (src/stage2/gen/NQP.nqp)
  in statementlist (src/stage2/gen/NQP.nqp)
  in blockoid (src/stage2/gen/NQP.nqp:823)
  in package_def (src/stage2/gen/NQP.nqp:1010)
  in package_declarator:sym<grammar> (src/stage2/gen/NQP.nqp:980)
  in !protoregex (src/stage2/gen/QRegex.nqp:699)
  in package_declarator (src/stage2/gen/NQP.nqp)
  in term:sym<package_declarator> (src/stage2/gen/NQP.nqp)
  in !protoregex (src/stage2/gen/QRegex.nqp:699)
  in term (src/stage2/gen/NQPHLL.nqp)
  in termish (src/stage2/gen/NQPHLL.nqp)
  in EXPR (src/stage2/gen/NQPHLL.nqp:430)
  in statement (src/stage2/gen/NQP.nqp)
  in statementlist (src/stage2/gen/NQP.nqp)
  in blockoid (src/stage2/gen/NQP.nqp:823)
  in package_def (src/stage2/gen/NQP.nqp:1010)
  in package_declarator:sym<module> (src/stage2/gen/NQP.nqp:965)
  in !protoregex (src/stage2/gen/QRegex.nqp:699)
  in package_declarator (src/stage2/gen/NQP.nqp)
  in scoped (src/stage2/gen/NQP.nqp:1071)
  in scope_declarator:sym<my> (src/stage2/gen/NQP.nqp)
  in !protoregex (src/stage2/gen/QRegex.nqp:699)
  in scope_declarator (src/stage2/gen/NQP.nqp)
  in term:sym<scope_declarator> (src/stage2/gen/NQP.nqp)
  in !protoregex (src/stage2/gen/QRegex.nqp:699)
  in term (src/stage2/gen/NQPHLL.nqp)
  in termish (src/stage2/gen/NQPHLL.nqp)
  in EXPR (src/stage2/gen/NQPHLL.nqp:430)
  in statement (src/stage2/gen/NQP.nqp)
  in statementlist (src/stage2/gen/NQP.nqp)
  in comp_unit (src/stage2/gen/NQP.nqp:766)
  in TOP (src/stage2/gen/NQP.nqp:663)
  in parse (src/stage2/gen/QRegex.nqp:1191)
  in parse (src/stage2/gen/NQPHLL.nqp:1374)
  in  (src/stage2/gen/NQPHLL.nqp:1330)
  in compile (src/stage2/gen/NQPHLL.nqp:1321)
  in eval (src/stage2/gen/NQPHLL.nqp:1079)
  in evalfiles (src/stage2/gen/NQPHLL.nqp:1288)
  in command_eval (src/stage2/gen/NQPHLL.nqp:1192)
  in command_line (src/stage2/gen/NQPHLL.nqp:1167)
  in MAIN (src/stage2/gen/NQP.nqp:3462)
  in  (src/stage2/gen/NQP.nqp:3458)
  in  (src/stage2/gen/NQP.nqp)
make: *** [src/stage1/NQPCORE.setting.jar] Error 1