string.pmc

/*
Copyright (C) 2003-2011, Parrot Foundation.

=head1 NAME

src/pmc/string.pmc - String PMC Class

=head1 DESCRIPTION

C<String> extends C<scalar> to provide a string for languages that want a
C<string> type without going to an S register.  It acts as a wrapper for the
functions in F<src/string.c>.

=head2 Methods

=over 4

=cut

*/

/* HEADERIZER HFILE: none */
/* HEADERIZER BEGIN: static */
/* HEADERIZER END: static */

pmclass String extends scalar provides string provides scalar auto_attrs {
    ATTR STRING * str_val;

/*

=item C<void init()>

Initializes the string.

=cut

*/

    VTABLE void init() {
        STRING * const str_val = STRINGNULL;
        SET_ATTR_str_val(INTERP, SELF, str_val);

        PObj_custom_mark_SET(SELF);
    }

/*

=item C<void mark()>

Marks the string as live.

=cut

*/

    VTABLE void mark() {
        STRING *str_val;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        Parrot_gc_mark_STRING_alive(INTERP, str_val);
    }

/*

=item C<PMC *clone()>

Creates a copy of the string.

=cut

*/

    VTABLE PMC *clone() {
        PMC * const dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
        VTABLE_set_string_native(INTERP, dest, SELF.get_string());
        return dest;
    }

/*

=item C<INTVAL get_integer()>

Returns the integer representation of the string.

=cut

*/

    VTABLE INTVAL get_integer() {
        STRING *str_val;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return Parrot_str_to_int(INTERP, str_val);
    }

/*

=item C<FLOATVAL get_number()>

Returns the floating-point representation of the string.

=cut

*/

    VTABLE FLOATVAL get_number() {
        STRING *str_val;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return Parrot_str_to_num(INTERP, str_val);
    }

/*

=item C<STRING *get_string()>

Returns the string itself.

=cut

*/

    VTABLE STRING *get_string() {
        STRING *str_val;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return str_val;
    }

/*

=item C<INTVAL get_bool()>

Returns the boolean value of the string.

=cut

*/

    VTABLE INTVAL get_bool() {
        STRING *str_val;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return Parrot_str_boolean(INTERP, str_val);
    }

/*

=item C<VOID set_integer_native(INTVAL value)>

=item C<VOID set_bool(INTVAL value)>

Sets the value of the string to the integer C<value>.

=cut

*/

    VTABLE void set_integer_native(INTVAL value) {
        SELF.set_string_native(Parrot_str_from_int(INTERP, value));
    }

    VTABLE void set_bool(INTVAL value) {
        SELF.set_string_native(Parrot_str_from_int(INTERP, value));
    }

/*

=item C<VOID set_number_native(FLOATVAL value)>

Sets the value of the string to the floating-point C<value>.

=cut

*/

    VTABLE void set_number_native(FLOATVAL value) {
        SELF.set_string_native(Parrot_str_from_num(INTERP, value));
    }


/*

=item C<VOID set_string_native(STRING *value)>

Sets the value of the string to that of the specified C<string>.

=cut

*/

    VTABLE void set_string_native(STRING *value) {
        if (value == NULL)
            value = STRINGNULL;

        /* Only allow constant PMCs to embed constant strings */
        if (PObj_constant_TEST(SELF) && !PObj_constant_TEST(value))
            value = Parrot_str_new_init(INTERP, value->strstart, value->bufused,
                                        value->encoding, PObj_constant_FLAG);

        SET_ATTR_str_val(INTERP, SELF, value);
    }

/*

=item C<VOID assign_string_native(STRING *value)>

Sets the value of the string to a copy of the specified C<string>.

=cut

*/

    VTABLE void assign_string_native(STRING *value) {
        SET_ATTR_str_val(INTERP, SELF, value);
    }

/*

=item C<VOID set_pmc(PMC *value)>

Sets the value of the string to the string value of
the specified C<PMC>.

=cut

*/
    VTABLE void set_pmc(PMC *value) {
        SELF.set_string_native(VTABLE_get_string(INTERP, value));
    }

/*

=item C<INTVAL is_equal(PMC *value)>

Compares the string with C<value>; returns true if
they match.

=cut

*/
    VTABLE INTVAL is_equal(PMC *value) {
        STRING *str_val;
        STRING * const v = VTABLE_get_string(INTERP, value);
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return (INTVAL)(STRING_equal(INTERP, str_val, v));
    }

/*

=item C<INTVAL is_equal_num(PMC *value)>

Compares the numerical value of the string with that of
C<value>; returns true if they match.

=cut

*/

    VTABLE INTVAL is_equal_num(PMC *value) {
        STRING        *str_val;
        FLOATVAL       sf;
        const FLOATVAL vf = VTABLE_get_number(INTERP, value);

        GET_ATTR_str_val(INTERP, SELF, str_val);
        sf = Parrot_str_to_num(INTERP, str_val);

        return (INTVAL)(sf == vf);
    }

/*

=item C<INTVAL is_equal_string(PMC *value)>

Compares the string with C<value>; returns FALSE if they match.

=cut

*/

    VTABLE INTVAL is_equal_string(PMC *value) {
        STRING *str_val;
        STRING * const v = VTABLE_get_string(INTERP, value);
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return STRING_equal(INTERP, str_val, v);
    }

/*

=item C<INTVAL cmp(PMC *value)>

Compares the string with C<value>; returns -1 if the
string is smaller, 0 if they are equal, and 1 if C<value>
is smaller.

=cut

*/
    VTABLE INTVAL cmp(PMC *value) {
        STRING *str_val;
        STRING * const v = VTABLE_get_string(INTERP, value);
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return STRING_compare(INTERP, str_val, v);
    }

/*

=item C<INTVAL cmp_num(PMC *value)>

Compares the numerical value of the string with that of
C<value>; returns -1 if the string is smaller, 0 if they
are equal, and 1 if C<value> is smaller.

=cut

*/
    VTABLE INTVAL cmp_num(PMC *value) {
        STRING        *str_val;
        FLOATVAL       sf;
        const FLOATVAL vf = VTABLE_get_number(INTERP, value);
        GET_ATTR_str_val(INTERP, SELF, str_val);
        sf = Parrot_str_to_num(INTERP, str_val);

        if (sf < vf)
            return (INTVAL)(-1);

        if (sf > vf)
            return (INTVAL)(1);

        return (INTVAL)(0);
    }

/*

=item C<INTVAL cmp_string(PMC *value)>

Compares the string with C<value>; returns -1 if the
string is smaller, 0 if they are equal, and 1 if C<value>
is smaller.

=cut

*/
    VTABLE INTVAL cmp_string(PMC *value) {
        STRING        *str_val;
        STRING * const v = VTABLE_get_string(INTERP, value);
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return STRING_compare(INTERP, str_val, v);
    }

/*

=item C<void substr(INTVAL offset, INTVAL length, PMC *dest)>

Extracts the substring starting at C<offset>, with size
C<length>, and places it in C<dest>.

=cut

*/
    VTABLE void substr(INTVAL offset, INTVAL length, PMC *dest) {
        STRING *str_val, *s2;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        s2 = STRING_substr(INTERP, str_val, offset, length);
        VTABLE_set_string_native(INTERP, dest, s2);
    }

/*

=item C<STRING *substr_str(INTVAL offset, INTVAL length)>

Extracts the substring starting at C<offset>, with size
C<length>, and returns it.

=cut

*/
    VTABLE STRING *substr_str(INTVAL offset, INTVAL length) {
        STRING *str_val;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return STRING_substr(INTERP, str_val, offset, length);
    }

/*

=item C<INTVAL exists_keyed(PMC *key)>

Returns true if the C<key>'th character in the string exists. Negative
numbers count from the end.

=cut

*/

    VTABLE INTVAL exists_keyed(PMC *key) {
        STRING      *str_val;
        INTVAL       n;
        const INTVAL k = VTABLE_get_integer(INTERP, key);

        GET_ATTR_str_val(INTERP, SELF, str_val);
        n = Parrot_str_length(INTERP, str_val);

        return (INTVAL)((k >= 0 && k < n) || (k < 0 && -k <= n));
    }

/*

=item C<STRING *get_string_keyed(PMC *key)>

Returns the C<key>'th character in the string. Negative numbers count
from the end.

=item C<INTVAL get_integer_keyed(PMC *key)>

Returns the integer value (ord) at C<*key>.

=item C<void set_string_keyed(PMC *key, STRING *val)>

Replace the string at C<key> with C<value>.

=item C<void set_integer_keyed(PMC *key, INTVAL val)>

Replace the string at C<key> with the chr of C<value>.

=cut

*/

    VTABLE STRING *get_string_keyed(PMC *key) {
        return SELF.get_string_keyed_int(VTABLE_get_integer(INTERP, key));
    }

    VTABLE STRING *get_string_keyed_int(INTVAL pos) {
        STRING      *str_val;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return STRING_substr(INTERP, str_val, pos, 1);
    }

    VTABLE INTVAL get_integer_keyed(PMC *key) {
        return SELF.get_integer_keyed_int(VTABLE_get_integer(INTERP, key));
    }

    VTABLE INTVAL get_integer_keyed_int(INTVAL pos) {
        STRING      *str_val;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return STRING_ord(INTERP, str_val, pos);
    }

    VTABLE PMC *get_pmc_keyed(PMC *key) {
        return SELF.get_pmc_keyed_int(VTABLE_get_integer(INTERP, key));
    }

    VTABLE PMC *get_pmc_keyed_int(INTVAL pos) {
        PMC * const dest = Parrot_pmc_new(INTERP, SELF->vtable->base_type);
        VTABLE_set_string_native(INTERP, dest, SELF.get_string_keyed_int(pos));
        return dest;
    }

    VTABLE void set_string_keyed(PMC *key, STRING * const value) {
        SELF.set_string_keyed_int(VTABLE_get_integer(INTERP, key), value);
    }

    VTABLE void set_string_keyed_int(INTVAL pos, STRING * const value) {
        STRING      *str_val;
        const INTVAL len = Parrot_str_length(INTERP, value);
        GET_ATTR_str_val(INTERP, SELF, str_val);
        str_val = Parrot_str_replace(INTERP, str_val, pos, len, value);
        SET_ATTR_str_val(INTERP, SELF, str_val);
    }

    VTABLE void set_integer_keyed(PMC *key, INTVAL value) {
        SELF.set_integer_keyed_int(VTABLE_get_integer(INTERP, key), value);
    }

    VTABLE void set_integer_keyed_int(INTVAL pos, INTVAL value) {
        STRING      *str_val;
        STRING * const c = Parrot_str_chr(INTERP, (UINTVAL) value);
        GET_ATTR_str_val(INTERP, SELF, str_val);
        str_val = Parrot_str_replace(INTERP, str_val, pos, 1, c);
        SET_ATTR_str_val(INTERP, SELF, str_val);
    }

    VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
        SELF.set_pmc_keyed_int(VTABLE_get_integer(INTERP, key), value);
    }

    VTABLE void set_pmc_keyed_int(INTVAL pos, PMC *value) {
        SELF.set_string_keyed_int(pos, VTABLE_get_string(INTERP, value));
    }
/*

=item C<void replace(STRING *orig, STRING *_new)>

Replace every occurrence of C<orig> with C<_new>.

=cut

*/

    METHOD replace(STRING *orig, STRING *_new) {
        const INTVAL   old_len = Parrot_str_length(INTERP, orig);
        const INTVAL   new_len = Parrot_str_length(INTERP, _new);
        STRING       * s       = VTABLE_get_string(INTERP, SELF);
        INTVAL         i       = 0;

        while (-1 != (i = STRING_index(INTERP, s, orig, i))) {
            s = Parrot_str_replace(INTERP, s, i, old_len, _new);
            i += new_len;
        }

        VTABLE_set_string_native(INTERP, SELF, s);
    }
/*

=item C<PMC *to_int(INTVAL base)>

Return the integer equivalent of SELF, which is assumed to be a C<base>
digit string. The String is assumed to be in an ascii-compatible encoding.
The String is considered being unsigned, and no I<+> or I<-> chars are
processed. C<base> has to be within [2..36].

If any chars in the String aren't converted, an exception is thrown.

TODO Currently overflow to BigInt is B<not> handled nor detected.

=cut

*/

    METHOD to_int(INTVAL base) {
        PMC * const result = Parrot_pmc_new(INTERP, Parrot_hll_get_ctx_HLL_type(INTERP,
                        enum_class_Integer));

        String_iter   iter;
        const STRING * const me  = VTABLE_get_string(INTERP, SELF);
        UINTVAL       i   = 0;
        size_t        len = STRING_length(me);

        if (base < 2 || base > 36)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
                    "invalid conversion to int - bad base %d", base);

        STRING_ITER_INIT(interp, &iter);

        while (iter.charpos < len) {
            const int c = STRING_iter_get_and_advance(interp, me, &iter);
            int dig;

            if (isdigit((unsigned char)c))
                dig = c - '0';
            else if (c >= 'a' && c <= 'z')
                dig = c - 'a' + 10;
            else if (c >= 'A' && c <= 'Z')
                dig = c - 'A' + 10;
            else
                dig = base;

            if (dig >= base)
                Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_OPERATION,
                        "invalid conversion to int - bad char %c", c);

            i = i * base + dig;
        }

        /* TODO: autopromote to BigInt instead of casting away the high bit */
        VTABLE_set_integer_native(INTERP, result, (INTVAL)i);
        RETURN(PMC *result);
    }


/*

=back

=head2 Iterator Interface

=over 4

=item C<PMC *get_iter(PMC *key)>

Return a new iterator for this string.

=item C<INTVAL elements()>

Return length of the string.

=cut

*/

    VTABLE INTVAL elements() {
        STRING *str_val;
        GET_ATTR_str_val(INTERP, SELF, str_val);
        return Parrot_str_length(INTERP, str_val);
    }

    VTABLE PMC *get_iter() {
        return Parrot_pmc_new_init(INTERP, enum_class_StringIterator, SELF);
    }

/*

=back

=head2 Freeze/thaw Interface

=over 4

=item C<void freeze(PMC *info)>

Used to archive the string.

=cut

*/
    VTABLE void freeze(PMC *info) {
        STRING *str_val;
        SUPER(info);
        GET_ATTR_str_val(INTERP, SELF, str_val);
        VTABLE_push_string(INTERP, info, str_val);
    }

/*

=item C<void thaw(PMC *info)>

Used to unarchive the string.

=cut

*/
    VTABLE void thaw(PMC *info) {
        SUPER(info);
        SET_ATTR_str_val(INTERP, SELF, VTABLE_shift_string(INTERP, info));
    }
/*

=back

=head2 NCI methods

=over 4

=item C<void trans(STRING *src, PMC *trams_table)>

Translate ascii string C<src> with entries from C<trans_table>.

=cut

*/

    METHOD trans(STRING *src, PMC *table) {
        unsigned char *p;
        INTVAL        *tr_data;
        INTVAL         i;
        STRING        *dest;

        const INTVAL len = Parrot_str_length(INTERP, src);

        if (!len)
            RETURN(STRING src);

        if (src->encoding != Parrot_ascii_encoding_ptr)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_ENCODING,
                "Can't translate non-ascii");

        dest = Parrot_str_clone(INTERP, src);
        p = (unsigned char *)(dest->strstart);
        /* TODO verify trans table */

        GETATTR_FixedIntegerArray_int_array(INTERP, table, tr_data);

        for (i = 0; i < len; ++i, ++p) {
            const unsigned char ch = (unsigned char)tr_data[*p];
            if (ch)
                *p = ch;
        }

        dest->hashval = 0; /* hash is invalid */
        RETURN(STRING dest);
    }

/*

=item C<void reverse(STRING *src)>

Either reverse this PMC's contents or set this PMC's value to the reverse of C<src>,
if present.

=cut

*/

    METHOD reverse(STRING *src :optional, INTVAL got_src :opt_flag) {
        if (got_src) {
            SET_ATTR_str_val(INTERP, SELF, Parrot_str_reverse(INTERP, src));
        }
        else {
            STRING *s;
            GET_ATTR_str_val(INTERP, SELF, s);
            SET_ATTR_str_val(INTERP, SELF, Parrot_str_reverse(INTERP, s));
        }
    }

/*

=item C<INTEGER is_integer(STRING *src)>

Checks if the ascii STRING C<str> is just an integer.

=cut

*/

    METHOD is_integer(STRING *src) {
        const INTVAL   len = Parrot_str_length(INTERP, src);
        const char *p;

        if (!len)
            RETURN(INTVAL 0);

        if (STRING_max_bytes_per_codepoint(src) != 1)
            Parrot_ex_throw_from_c_args(INTERP, NULL, EXCEPTION_INVALID_ENCODING,
                "Can't is_integer non fixed_8");

        p = src->strstart;
        if (p[0] == '-' || p[0] == '+' || (p[0] >= '0' && p[0] <= '9')) {
            int i;
            for (i = 1; i < len; ++i)
                if (p[i] < '0' || p[i] > '9')
                    RETURN(INTVAL 0);

            RETURN(INTVAL 1);
        }
        else
            RETURN(INTVAL 0);
    }

    VTABLE PMC *share_ro() {
        STRING       *str_val;
        PMC   * const ret    = SUPER();

        GET_ATTR_str_val(INTERP, SELF, str_val);
        if (!STRING_IS_NULL(str_val)) {
            /* prevent wrong garbage collection */
            PObj_is_shared_SET(str_val);
        }
        return ret;
    }

    VTABLE STRING* get_repr() {
        return VTABLE_get_string(INTERP, SELF);
    }

/*

=item C<INTEGER reverse_index(STRING *substring, INTVAL start)>

Find last occurrence of C<substring>, but not after the C<start> position.

=cut

*/

    METHOD reverse_index(STRING *substring, INTVAL start) {
        const STRING * const src = VTABLE_get_string(INTERP, SELF);
        INTVAL         res = -1;
        UINTVAL        len;

        if (start < 0)
            RETURN(INTVAL res);

        len = Parrot_str_length(INTERP, src);

        if (!len)
            RETURN(INTVAL res);

        if (start >= (INTVAL)len)
            RETURN(INTVAL res);

        if (!Parrot_str_length(INTERP, substring))
            RETURN(INTVAL res);

        res = STRING_rindex(INTERP, src, substring, (UINTVAL)start);
        RETURN(INTVAL res);
    }

/*

=item C<STRING *unescape()>

EXPERIMENTAL, for testing only. See TT #1628

=cut

*/

    METHOD unescape(STRING *encodingname)
    {
        const STR_VTABLE * const encoding = Parrot_find_encoding_by_string(INTERP, encodingname);
        STRING * const src = VTABLE_get_string(INTERP, SELF);
        STRING * const dest = Parrot_str_unescape_string(INTERP, src,
                encoding, 0);
        Parrot_warn_experimental(INTERP, "Method unescape on String is experimental");
        RETURN(STRING *dest);
    }

}

/*

=back

=cut

*/


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