/*
** string.ops
*/

VERSION = PARROT_VERSION;

=head1 NAME

string.ops - String Operations

=head1 DESCRIPTION

Operations that work on strings, whether constructing, modifying 
or examining them.  See also F<rx.ops>.

=over 4

=cut

###############################################################################

=item B<ord>(out INT, in STR)

Two-argument form returns the 0th character of string $2 in register $1.
If $2 is empty, throws an exception.

=item B<ord>(out INT, in STR, in INT)

Three-argument form returns character $3 of string $2 in register $1.
If $2 is empty, throws an exception.
If $3 is greater than the length of string $2, throws an exception.
If $3 is less then zero but greater than the negative of the length, counts
backwards through the string, such that -1 is the last character, -2 is the
second-to-last character, and so on.
If $3 is less than the negative of the length, throws an exception.

=cut

inline op ord (out INT, in STR) {
  $1 = string_ord($2,0);
  goto NEXT();
}

inline op ord (out INT, in STR, in INT) {
  $1 = string_ord($2,$3);
  goto NEXT();
}

=item B<chr>(out STR, in INT)

Returns the character represented by the $2 number in the ASCII
character set.

=cut

inline op chr (out STR, in INT) {
  STRING *s;
  s = string_make(interpreter, &$1, (UINTVAL)1, NULL, 0, NULL);
  *(char *)s->strstart = $2;
  s->strlen = 1;
  $1 = s;
  goto NEXT();
}


########################################

=item B<chopn>(inout STR, in INT)

=item B<chopn>(out STR, in STR, in INT)

Remove $2 characters from the end of the string in $1.  The 3-arg version
removes $3 characters from the end of the string in $2 and returns the result
in $1

=cut

inline op chopn(inout STR, in INT) {
  (void)string_chopn($1, $2);
  goto NEXT();
}

inline op chopn(out STR, in STR, in INT) {
  $1 = string_copy(interpreter, $2);
  (void)string_chopn($1,$3);
  goto NEXT();
}

########################################

=item B<concat>(inout STR, in STR)

Append the string in $2 to the string in $1.

=item B<concat>(out STR, in STR, in STR)

=item B<concat>(in PMC, in PMC, in PMC)

=item B<concat>(in PMC, in PMC, in STR)

Append the string $3 to $2 and places the result into $1.

=cut

inline op concat(inout STR, in STR) {
  $1 = string_append(interpreter, $1, $2, 1);
  goto NEXT();
}

inline op concat(out STR, in STR, in STR) {
  $1 = string_concat(interpreter, $2, $3, 1);
  goto NEXT();
}

inline op concat (in PMC, in PMC, in PMC) {
  $2->vtable->concatenate(interpreter, $2, $3, $1);
  goto NEXT();
}

inline op concat (in PMC, in PMC, in STR) {
  $2->vtable->concatenate_native(interpreter, $2, $3, $1);
  goto NEXT();
}
#######################################

=item B<repeat>(out STR, in STR, in INT)

=item B<repeat>(in PMC, in PMC, in PMC)

=item B<repeat>(in PMC, in PMC, in INT)

Repeats string $2 $3 times and stores result in $1.

=cut

inline op repeat(out STR, in STR, in INT) {
  if ($3 < 0) {
      internal_exception(NEG_REPEAT, "Cannot repeat with negative arg\n");
  }
  $1 = string_repeat(interpreter, $2, (UINTVAL)$3, NULL);
  goto NEXT();
}

inline op repeat (in PMC, in PMC, in PMC) {
  $2->vtable->repeat(interpreter, $2, $3, $1);
  goto NEXT();
}

inline op repeat (in PMC, in PMC, in INT) {
  $2->vtable->repeat_int(interpreter, $2, $3, $1);
  goto NEXT();
}

########################################

=item B<length>(out INT, in STR)

Set $1 to the length (in characters) of the string in $2.

=cut

inline op length(out INT, in STR) {
  $1 = string_length($2);
  goto NEXT();
}

=item B<pin>(inout STR)

Make the memory in $1 immobile. This memory will I<not> be moved by
the GC, and may be safely passed to external libraries. (Well, as long
as they don't free it) Pinning a string will move the contents.

The memory only need be unpinned if you plan on using it for any
length of time after its pinning is no longer necessary.

=cut

op pin(inout STR) {
   string_pin(interpreter, $1);
   goto NEXT();
}


=item B<unpin>(inout STR)

Make the memory in $1 movable again. This will make the memory in $1
move.

=cut

op unpin(inout STR) {
   string_unpin(interpreter, $1);
   goto NEXT();
}


########################################

=item B<substr>(out STR, in STR, in INT, in INT)

=item B<substr>(out STR, in STR, in INT, in INT, in STR)

=item B<substr>(inout STR, in INT, in INT, in STR)

=item B<substr>(out STR, in PMC, in INT, in INT)

Set $1 to the portion of $2 starting at (zero-based) character position
$3 and having length $4.

Optionally pass in string $5 for replacement. If the length of $5 is
different from the length specified in $4, then $2 will grow or shrink
accordingly. If $3 is one character position larger than the length of
$2, then $5 is appended to $2 (and the empty string is returned);
this is essentially the same as

  concat $2, $5

Finally, if $3 is negative, then it is taken to count backwards from
the end of the string (ie an offset of -1 corresponds to the last
character).

The third form is optimized for replace only, ignoring the replaced
substring and does not waste a register to do the string replace.

The B<_r> variants reuse an existing string header and therefore normally
do not create a new string in the destination register.

=cut

inline op substr(out STR, in STR, in INT, in INT) {
  $1 = string_substr(interpreter, $2, $3, $4, &$1, 0);
  goto NEXT();
}

inline op substr_r(out STR, in STR, in INT, in INT) {
  $1 = string_substr(interpreter, $2, $3, $4, &$1, 1);
  goto NEXT();
}

inline op substr(out STR, inout STR, in INT, in INT, in STR) {
  $1 = string_replace(interpreter, $2, $3, $4, $5, &$1);
  goto NEXT();
}

inline op substr(inout STR, in INT, in INT, in STR) {
  (void)string_replace(interpreter, $1, $2, $3, $4, NULL);
  goto NEXT();
}

inline op substr(out STR, in PMC, in INT, in INT) {
  $1 = $2->vtable->substr_str(interpreter, $2, $3, $4);
  goto NEXT();
}

=cut

########################################

=item B<index>(out INT, in STR, in STR)

=item B<index>(out INT, in STR, in STR, in INT)

The index function searches for one string within
another, but without the wildcard-like behavior of
a full regular-expression pattern match.  It
returns the position of the first occurrence of
$3 in $2 at or after $4.  If $4 is omitted, starts
searching from the beginning of the string.
The return value is based at "0".
If the substring is not found, returns "-1".

=cut

inline op index(out INT, in STR, in STR) {
    $1 = string_str_index(interpreter, $2, $3, 0);
    goto NEXT();
}

inline op index(out INT, in STR, in STR, in INT) {
    $1 = string_str_index(interpreter, $2, $3, $4);
    goto NEXT();
}

=cut


########################################

=item B<pack>(inout STR, in INT, in INT)

=item B<pack>(inout STR, in INT, in NUM)

=item B<pack>(inout STR, in INT, in STR)

=item B<pack>(inout STR, in INT, in INT, in INT)

=item B<pack>(inout STR, in INT, in NUM, in INT)

=item B<pack>(inout STR, in INT, in STR, in INT)

Concat $2 bytes from $3 at the end of $1 or replace them at $4 if provided.

BE AFRAID, THIS IS A QUICK HACK, USE IT AT YOUR OWN RISK.

=cut

inline op pack(inout STR, in INT, in INT) {
    char *c = (char *)&$3;
    STRING *s;

    s = string_make(interpreter, c, (UINTVAL)$2, NULL, 0, NULL);
    $1 = string_concat(interpreter, $1, s, 1);

    goto NEXT();
}

inline op pack(inout STR, in INT, in NUM) {
    char *c = (char *)&$3;
    STRING *s;

    s = string_make(interpreter, c, (UINTVAL)$2, NULL, 0, NULL);
    $1 = string_concat(interpreter, $1, s, 1);

    goto NEXT();
}

inline op pack(inout STR, in INT, in STR) {
    STRING *t,*s = $3;
    UINTVAL len = (UINTVAL)$2;
    char buf[3];

    if (s->buflen < len) {
        t = string_make(interpreter, buf, (UINTVAL)(len - s->buflen), NULL, 0, NULL);
        $1 = string_concat(interpreter, $1, s, 1);
    } else {
        t = string_make(interpreter, s->strstart, (UINTVAL)len, NULL, 0, NULL);
    }
    $1 = string_concat(interpreter, $1, t, 1);

    goto NEXT();
}


inline op pack(inout STR, in INT, in INT, in INT) {
    char *c = (char *)&$3, *n;
    STRING *s;
    INTVAL ln;
    const char *t;
    int i;

    s = string_make(interpreter, c, (UINTVAL)$2, NULL, 0, NULL);
    ln = string_length($1);
    if (ln < $4 + $2)
    {
       $1->buflen = $1->strlen;
       string_grow(interpreter, $1, $4 + $2 - ln);
       $1->bufused = $1->strlen = $1->buflen;
    }

    /* XXX this is EVIL, use string_replace */
    n = $1->strstart;
    t = string_to_cstring(interpreter, s);
    for (i = $4; i < $4 + $2; i++)
        n[i] = t[i - $4];


    goto NEXT();
}

=cut

########################################

=item B<sprintf>(out STR, in STR, in PMC)

=item B<sprintf>(out PMC, in PMC, in PMC)

=item B<sprintf>(out STR, in STR) [unimplemented]

=item B<sprintf>(out PMC, in PMC) [unimplemented]

Sets $1 to the result of calling C<Parrot_psprintf> with the
given format ($2) and arguments ($3, which should be an ordered
aggregate PMC).  In the (unimplemented) versions that don't include
$3, arguments are popped off the user stack.

The result is quite similar to using the system C<sprintf>, but is
protected against buffer overflows and the like.  There are some
differences, especially concerning sizes (which are largely ignored);
see F<misc.c> for details.

=cut

inline op sprintf(out STR, in STR, in PMC) {
    $1=Parrot_psprintf(interpreter, $2, $3);
    goto NEXT();
}

inline op sprintf(out PMC, in PMC, in PMC) {
    $1->vtable->set_string_native(interpreter, $1,
        Parrot_psprintf(interpreter, $2->vtable->get_string(interpreter, $2), $3)
    );
    goto NEXT();
}

=cut

=item B<new>(out STR)

=item B<new>(out STR, in INT)

=item B<new>(out STR, in INT, in INT)

=item B<new>(out STR, in INT, in INT, in INT)

Allocate a new empty string, of length $2 (optional), encoding $3
(optional) and type $4. (optional)

=cut

inline op new(out STR) {
  $1 = string_make(interpreter, NULL, 0, NULL, 0, NULL);
  goto NEXT();
}

inline op new(out STR, in INT) {
  $1 = string_make(interpreter, NULL, $2, NULL, 0, NULL);
  goto NEXT();
}

inline op new(out STR, in INT, in INT) {
  $1 = string_make(interpreter, NULL, $2, encoding_lookup_index($3), 0, NULL);
  goto NEXT();
}

inline op new(out STR, in INT, in INT, in INT) {
  internal_exception(INVALID_CHARTYPE, 
                     "new_s_i_i_i op not yet implemented\n");
  $1 = string_make(interpreter, NULL, $2, encoding_lookup_index($3), 0, NULL);
  goto NEXT();
}

=item B<transcode>(inout STR, in INT)

Transcode a string from its current encoding to the encoding in $2. $1
becomes a new string. (Transcoding is not inplace)

=item B<transcode>(out STR, in STR, in INT)

Put a transcoded version of $2 in $1, turning it to the encoding in $3

=item B<transcode>(out STR, in STR, in INT, in INT)

Put a transcoded version of $2 in $1, turning it to the encoding in $3
and the chartype in $4.

=cut

op transcode(inout STR, in INT) {
  $1 = string_transcode(interpreter, $1, encoding_lookup_index($2), NULL, NULL);
  goto NEXT();
}

op transcode(out STR, in STR, in INT) {
  $1 = string_transcode(interpreter, $2, encoding_lookup_index($3), NULL, NULL);
  goto NEXT();
}

op transcode(out STR, in STR, in INT, in INT) {
  $1 = string_transcode(interpreter, $2, encoding_lookup_index($3), 
                        chartype_lookup_index($4), NULL);
  goto NEXT();
}

=item B<find_encoding>(out INT, in STR)

Find the encoding named in $2 and return its number in $1

=cut

op find_encoding(out INT, in STR) {
  char *encoding = string_to_cstring(interpreter, $2);
  $1 = encoding_find_encoding(encoding);
  string_cstring_free(encoding);
  goto NEXT();
}

=item B<string_encoding>(out INT, in STR)

Find the encoding type for $2 and put it in $1

=cut

op string_encoding(out INT, in STR) {
   $1 = $2->encoding->index;
   goto NEXT();
}

=item B<find_chartype>(out INT, in STR)

Find the chartype named in $2 and return its number in $1

=cut

op find_chartype(out INT, in STR) {
  char *chartype = string_to_cstring(interpreter, $2);
  $1 = chartype_find_chartype(chartype);
  string_cstring_free(chartype);
  goto NEXT();
}

=item B<string_chartype>(out INT, in STR)

Find the chartype type for $2 and put it in $1

=cut

op string_chartype(out INT, in STR) {
   $1 = $2->type->index;
   goto NEXT();
}

########################################

=item B<set_encoding>(in STR, in INT)
=item B<set_chartype>(in STR, in INT)

Temporary ops to set the encoding and chartype of a string

=cut

inline op set_encoding(in STR, in INT) {
   $1->encoding = encoding_lookup_index($2);
   goto NEXT();
}

inline op set_chartype(in STR, in INT) {
   $1->type = chartype_lookup_index($2);
   goto NEXT();
}

########################################

=item B<stringinfo>(out INT, in STR, in INT)

Extract some information about string $2 and store it in $1.
Possible values for $3 are:

=over 4

=item 1 The location of the string buffer header.

=item 2 The location of the start of the string.

=item 3 The length of the string buffer (in bytes).

=item 4 The flags attached to the string (if any).

=item 5 The amount of the string buffer used (in bytes).

=item 6 The length of the string (in characters).

=back

=cut

inline op stringinfo(out INT, in STR, in INT) {
  switch ($3) {
    case STRINGINFO_HEADER:   $1 = PTR2UINTVAL($2);
                              break;
    case STRINGINFO_STRSTART: $1 = PTR2UINTVAL($2->strstart);
                              break;
    case STRINGINFO_BUFLEN:   $1 = $2->buflen;
                              break;
    case STRINGINFO_FLAGS:    $1 = PObj_get_FLAGS($2);
                              break;
    case STRINGINFO_BUFUSED:  $1 = $2->bufused;
                              break;
    case STRINGINFO_STRLEN:   $1 = $2->strlen;
                              break;
  }
  goto NEXT();
}

=back

=cut

###############################################################################

=head1 COPYRIGHT

Copyright (C) 2001-2003 The Perl Foundation.  All rights reserved.

=head1 LICENSE

This program is free software. It is subject to the same license
as the Parrot interpreter itself.

=cut
