perl6str.pmc

/*
$Id$
Copyright (C) 2001-2009, The Perl Foundation.

=head1 NAME

src/pmc/perl6str.pmc - Perl 6 Strings

=head1 DESCRIPTION

C<Perl6Str> extends C<String> to provide Perl 6-specific string numifying
behavior.

=head2 Methods

=over 4

=cut

*/

#include "parrot/parrot.h"
#include <ctype.h>
#include <math.h>
#include <string.h>


static
FLOATVAL
parse_number(const char **start, const char *stop, FLOATVAL radix) {
    const char *pos             = *start;
    FLOATVAL    number          = 0.0;
    int         underscore_skip = 0;

    /* continue until the end or until we've hit a non-digit */
    while (pos + underscore_skip < stop) {
        unsigned int current = *(pos + underscore_skip);
        if (isdigit((unsigned char)current))
            current -= '0';
        else if (isalpha((unsigned char)current))
            current = tolower((unsigned char)current) - 'a' + 10;
        else
           break;

        if (current >= radix) break;
        number = number * radix + current;
        pos += 1 + underscore_skip;
        underscore_skip = (*pos == '_');
    }
    *start = pos;
    return number;
}

static
FLOATVAL
parse_fraction(const char** start, const char* stop, FLOATVAL radix) {
    FLOATVAL frac = 1.0;
    FLOATVAL number = 0.0;
    const char *pos = *start;
    int underscore_skip = 0;
    while (pos + underscore_skip < stop) {
        unsigned int current = *(pos + underscore_skip);
        /* if we find an 'e' in radix 10, we're done */
        if (radix == 10 && tolower((unsigned char)current) == 'e')
            break;
        if (isdigit((unsigned char)current))
            current -= '0';
        else if (isalpha((unsigned char)current))
            current = tolower((unsigned char)current) - 'a' + 10;
        else
            break;

        if (current >= radix)
            break;
        frac /= radix;
        number += current * frac;
        pos += 1 + underscore_skip;
        underscore_skip = (*pos == '_');
    }
    *start = pos;
    return number;
}


pmclass Perl6Str
    extends  String
    provides string
    dynpmc
    auto_attrs
    group    perl6_group
    hll      Perl6
    maps     String {

/*

=item C<INTVAL get_integer()>

Returns the value of a Perl 6 string as an integer.  For now
we just call C<get_number()> and return that as an integer.

=cut

*/

    INTVAL get_integer() {
        const FLOATVAL f = SELF.get_number();
        return (INTVAL)f;
    }


/*

=item C<FLOATVAL get_number()>

Returns the value of a Perl 6 string as a number.  Currently
this routine understands the "0x", "0d", "0o", and "0b" radix
forms, as well as exponents and underscores between pairs of
digits.

=cut

*/

    FLOATVAL get_number() {
        Parrot_Perl6Str_attributes *attrs = PARROT_PERL6STR(SELF);
        STRING                     *s     = attrs->str_val;
        FLOATVAL                    sign  = 1.0;
        FLOATVAL                    f     = 0.0;
        FLOATVAL                    radix = 10.0;
        int                         angle = 0;

        if (s && s->strstart) {
            const char *s1         = s->strstart;
            const char * const end = s1 + s->bufused;

            /* skip leading whitespace */
            while (s1 < end && isspace((unsigned char)*s1))
                s1++;

            /* handle \d+:([0..9A..Za..z]) radix notation */
            if (s1 < end && *s1 == ':') {
                s1++;

                if (s1 >= end)
                    return f;

                radix = parse_number(&s1, end, 10);
                if (*s1 != '<') {
                    return 0.0;
                }
                else {
                    angle = 1;
                    s1++;
                }
            }

            /* handle leading +,- */
            if (s1 < end && *s1 == '+')
                s1++;
            else if (s1 < end && *s1 == '-') {
                sign = -1.0; s1++;
            }

            if (tolower((unsigned char)s1[0]) == 'i'
                    && tolower((unsigned char)s1[1]) == 'n'
                    && tolower((unsigned char)s1[2]) == 'f') {
                s1 += 3;
                while (s1 < end && isspace((unsigned char)*s1))
                    s1++;
                return (s1 == end)
                    ? sign > 0
                        ? PARROT_FLOATVAL_INF_POSITIVE
                        : PARROT_FLOATVAL_INF_NEGATIVE
                    : 0.0;
            }

            if (tolower((unsigned char)s1[0]) == 'n'
                    && tolower((unsigned char)s1[1]) == 'a'
                    && tolower((unsigned char)s1[2]) == 'n') {
                s1 += 3;
                while (s1 < end && isspace((unsigned char)*s1))
                    s1++;
                return (s1 == end) ? PARROT_FLOATVAL_NAN_QUIET : 0.0;
            }

            /* handle 0x, 0o, 0d, 0b radix */
            if (s1 < end && *s1 == '0') {
                s1++;

                if (s1 >= end)
                    return f;

                switch (*s1) {
                    case 'x':
                    case 'X':
                        s1++;
                        return parse_number(&s1, end, 16);
                    case 'd':
                    case 'D':
                        s1++;
                        return parse_number(&s1, end, 10);
                    case 'o':
                    case 'O':
                        s1++;
                        return parse_number(&s1, end, 8);
                    case 'b':
                    case 'B':
                        s1++;
                        return parse_number(&s1, end, 2);
                    default:
                        break;
                }
                if (s1 < end && *s1 == '_'
                    && isdigit((unsigned char)*(s1 + 1)))
                    s1++;
            }

            /* handle integer part */
            if (s1 < end && isalnum((unsigned char)*s1)) {
                f = parse_number(&s1, end, radix);
            }

            /* handle decimal point part */
            if (s1 < end && *s1 == '.') {
                s1++;
                f += parse_fraction(&s1, end, radix);
            }

            /* handle exponential part */
            if (s1 < end && (*s1 == 'e' || *s1 == 'E')) {
                int exp_val  = 0;
                int exp_sign = 1;
                s1++;

                if (s1 < end && *s1 == '+')
                    s1++;
                else if (s1 < end && *s1 == '-') {
                    exp_sign = -1; s1++;
                }

                while (s1 < end && isdigit((unsigned char)*s1)) {
                    exp_val = exp_val * 10 + *s1 - '0';
                    s1++;

                    if (s1 < end && *s1 == '_'
                    &&  isdigit((unsigned char)*(s1+1)))
                        s1++;
                }

                return sign * f * pow(10.0, exp_val * exp_sign);
            }

            if (angle && (s1 >= end || *s1 != '>'))
                return 0.0;
        }
        return sign * f;
    }

}

/*

=back

=cut

*/


/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */