cvsuser 04/12/10 02:15:20
Modified: classes perlstring.pmc string.pmc
t/pmc perlstring.t
Log:
class refactoring 4 - String
Revision Changes Path
1.90 +19 -565 parrot/classes/perlstring.pmc
Index: perlstring.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/perlstring.pmc,v
retrieving revision 1.89
retrieving revision 1.90
diff -u -r1.89 -r1.90
--- perlstring.pmc 14 Oct 2004 09:07:07 -0000 1.89
+++ perlstring.pmc 10 Dec 2004 10:15:17 -0000 1.90
@@ -1,6 +1,6 @@
/*
Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-$Id: perlstring.pmc,v 1.89 2004/10/14 09:07:07 leo Exp $
+$Id: perlstring.pmc,v 1.90 2004/12/10 10:15:17 leo Exp $
=head1 NAME
@@ -19,154 +19,12 @@
*/
#include "parrot/parrot.h"
-#include "parrot/perltypes.h"
-pmclass PerlString extends perlscalar {
+void Parrot_perlscalar_morph(Interp* , PMC* pmc, INTVAL type);
+void Parrot_perlscalar_set_pmc(Interp* , PMC* pmc, PMC* value);
- void class_init () {
- }
-
-/*
-
-=item C<PMC* lower()>
-
-NCI method: downcase this string
-
-=cut
-
-*/
-
- METHOD PMC* lower() {
- STRING *s = string_downcase(interpreter, PMC_str_val(SELF));
- PMC *ret = pmc_new(interpreter, enum_class_PerlString);
- string_set(interpreter, PMC_str_val(ret), s);
- return ret;
- }
-
-/*
-
-=item C<void* invoke(void* next)>
-
-Pythonic object constructor. SELF is a PerlString Class object. Return a new
-C<str> object according to 2.1. Built-in Functions.
-
-=cut
-
-*/
- void* invoke(void* next) {
- int argcP = REG_INT(3);
- PMC *res = pmc_new(interpreter, enum_class_PerlString);
- if (argcP)
- VTABLE_set_string_native(interpreter, res,
- VTABLE_get_string(interpreter, REG_PMC(5)));
- REG_PMC(5) = res;
- return next;
- }
-/*
-
-=item C<void init()>
-
-Initializes the string.
+pmclass PerlString extends String {
-=cut
-
-*/
-
- void init () {
- PMC_str_val(SELF) = string_make_empty(INTERP,enum_stringrep_one,0);
- PObj_custom_mark_SET(SELF);
- }
-
-/*
-
-=item C<void mark()>
-
-Marks the string as live.
-
-=cut
-
-*/
-
- void mark () {
- if (PMC_str_val(SELF))
- pobject_lives(INTERP, (PObj *)PMC_str_val(SELF));
- }
-
-/*
-
-=item C<PMC *clone()>
-
-Creates and returns a clone of the string.
-
-=cut
-
-*/
-
- PMC* clone () {
- PMC* dest = pmc_new_noinit(INTERP, SELF->vtable->base_type);
- PObj_custom_mark_SET(dest);
- PMC_str_val(dest) = string_copy(INTERP,PMC_str_val(SELF));
- return dest;
- }
-
-/*
-
-=item C<INTVAL get_integer()>
-
-Returns the integer value of the string.
-
-=cut
-
-*/
-
- INTVAL get_integer () {
- STRING* s = (STRING*) PMC_str_val(SELF);
- return string_to_int(INTERP, s);
- }
-
-/*
-
-=item C<FLOATVAL get_number()>
-
-Returns the floating-point value for the string.
-
-=cut
-
-*/
-
- FLOATVAL get_number () {
- STRING* s = (STRING*) PMC_str_val(SELF);
- return string_to_num(INTERP, s);
- }
-
-/*
-
-=item C<BIGNUM *get_bignum()>
-
-Unimplemented. Returns C<NULL>.
-
-=cut
-
-*/
-
- BIGNUM* get_bignum () {
- /* XXX */
- return NULL;
- }
-
-/*
-
-=item C<INTVAL get_bool()>
-
-Returns the boolean value of the string.
-
-=cut
-
-*/
-
- INTVAL get_bool () {
- return string_bool(INTERP, PMC_str_val(SELF));
- }
/*
@@ -194,24 +52,6 @@
/*
-=item C<INTVAL is_same(PMC *other)>
-
-Returns whether the string is the same as C<*other>.
-
-=cut
-
-*/
-
- INTVAL is_same (PMC* other) {
- STRING* s1 = (STRING*)PMC_str_val(SELF);
- STRING* s2 = (STRING*)PMC_str_val(other);
- return (INTVAL)( other->vtable == SELF->vtable &&
- s1->bufused == s2->bufused &&
- (memcmp(s1->strstart,PObj_bufstart(s2),(size_t)s1->bufused)==0));
- }
-
-/*
-
=item C<void set_integer_native(INTVAL value)>
Morphs the string to a C<PerlInt> and sets its value to C<value>.
@@ -240,60 +80,52 @@
DYNSELF.set_number_native(value);
}
-/*
-
-=item C<void set_string_native(STRING *value)>
-Sets the string's value to the value of the specified Parrot string.
+/*
-=item C<void assign_string_native(STRING *value)>
+=item C<void set_pmc(PMC *value)>
-Assign a copy of the passed string value.
+Sets the value of the number to the value in C<*value>.
=cut
*/
- void set_string_native (STRING * value) {
- PMC_str_val(SELF) = value;
+ void set_pmc (PMC* value) {
+ perlscalar.SELF.set_pmc(value);
}
- void assign_string_native (STRING * value) {
- PMC_str_val(SELF) = string_set(INTERP, PMC_str_val(SELF), value);
- }
/*
-=item C<void set_string_same(PMC *value)>
+=item C<void morph(INTVAL type)>
-Sets the string's value to the value of the specified C<PerlString>.
+Morphs the scalar to the specified type.
=cut
*/
- void set_string_same (PMC * value) {
- PMC_str_val(SELF) = string_set(INTERP, PMC_str_val(SELF),
- PMC_str_val(value));
+ void morph (INTVAL type) {
+ perlscalar.SELF.morph(type);
}
-
/*
=item C<void add(PMC *value, PMC *dest)>
Adds C<*value> to the string and returns the result in C<*dest>.
-When Python mode is enabled does concat :(
-
=cut
*/
void add (PMC * value, PMC* dest) {
+MMD_PerlString: {
+ /* work around MMD setup bug */
+ VTABLE_set_number_native(INTERP, dest,
+ VTABLE_get_number(INTERP, SELF) +
+ VTABLE_get_number(INTERP, value));
+ }
MMD_PerlNum: {
- if (Interp_flags_TEST(INTERP, PARROT_PYTHON_MODE)) {
- SELF.concatenate(value, dest);
- return;
- }
VTABLE_set_number_native(INTERP, dest,
VTABLE_get_number(INTERP, SELF) +
PMC_num_val(value)
@@ -303,10 +135,6 @@
FLOATVAL pmcf, valf;
INTVAL pmci, vali;
- if (Interp_flags_TEST(INTERP, PARROT_PYTHON_MODE)) {
- SELF.concatenate(value, dest);
- return;
- }
pmcf = VTABLE_get_number(INTERP, SELF);
pmci = VTABLE_get_integer(INTERP, SELF);
valf = VTABLE_get_number(INTERP, value);
@@ -446,234 +274,6 @@
/*
-=back
-
-=head2 String Bitwise Operations
-
-=over 4
-
-=item C<void bitwise_ors(PMC* value, PMC* dest)>
-
-=cut
-
-*/
-
- void bitwise_ors (PMC* value, PMC* dest) {
- STRING* result;
-
- result = string_bitwise_or(interpreter, PMC_str_val(SELF),
- VTABLE_get_string(INTERP, value), NULL);
- VTABLE_set_string_native(INTERP, dest, result);
- }
-
-/*
-
-=item C<void bitwise_ors_str(STRING *value, PMC *dest)>
-
-Calculates the string bitwise C<OR> for the string and C<*value> and
-returns the result in C<*dest>.
-
-=cut
-
-*/
-
- void bitwise_ors_str (STRING* value, PMC* dest) {
- STRING* result;
-
- result = string_bitwise_or(interpreter, PMC_str_val(SELF),
- value, NULL);
- VTABLE_set_string_native(INTERP, dest, result);
- }
-
-/*
-
-=item C<void bitwise_xors(PMC *value, PMC *dest)>
-
-=cut
-
-*/
-
- void bitwise_xors (PMC* value, PMC* dest) {
- STRING* result;
-
- result = string_bitwise_xor(interpreter, PMC_str_val(SELF),
- VTABLE_get_string(INTERP, value), NULL);
- VTABLE_set_string_native(INTERP, dest, result);
- }
-
-/*
-
-=item C<void bitwise_xors_str(STRING *value, PMC *dest)>
-
-Calculates the string bitwise C<XOR> for the string and C<*value> and
-returns the result in C<*dest>.
-
-=cut
-
-*/
-
- void bitwise_xors_str (STRING* value, PMC* dest) {
- STRING* result;
-
- result = string_bitwise_xor(interpreter, PMC_str_val(SELF),
- value, NULL);
- VTABLE_set_string_native(INTERP, dest, result);
- }
-
-/*
-
-=item C<void bitwise_ands(PMC *value, PMC *dest)>
-
-=cut
-
-*/
-
- void bitwise_ands (PMC* value, PMC* dest) {
- STRING* result;
-
- result = string_bitwise_and(interpreter, PMC_str_val(SELF),
- VTABLE_get_string(INTERP, value), NULL);
- VTABLE_set_string_native(INTERP, dest, result);
- }
-
-/*
-
-=item C<void bitwise_ands_str(STRING *value, PMC *dest)>
-
-Calculates the string bitwise C<AND> for the string and C<*value> and
-returns the result in C<*dest>.
-
-=cut
-
-*/
-
- void bitwise_ands_str (STRING* value, PMC* dest) {
- STRING* result;
-
- result = string_bitwise_and(interpreter, PMC_str_val(SELF),
- value, NULL);
- VTABLE_set_string_native(INTERP, dest, result);
- }
-
-/*
-
-=item C<void bitwise_nots(PMC *dest)>
-
-Calculates the string bitwise C<NOT> for the string and returns the result
-in C<*dest>.
-
-=cut
-
-*/
-
- void bitwise_nots (PMC* dest) {
- VTABLE_set_string_native(INTERP, dest,
- string_bitwise_not(interpreter, PMC_str_val(SELF), NULL));
- }
-
-/*
-
-=item C<void concatenate(PMC *value, PMC *dest)>
-
-Concatenates the string and the stringified form of C<*value> and
-return the result in C<*dest>, morphing it to a PerlString if required.
-
-=cut
-
-*/
-
- void concatenate (PMC* value, PMC* dest) {
- STRING* s = PMC_str_val(SELF);
- VTABLE_morph(INTERP, dest, enum_class_PerlString);
- PMC_str_val(dest) =
- string_concat(INTERP, s, VTABLE_get_string(INTERP, value), 0);
- }
-
-/*
-
-=item C<void concatenate_str(STRING *value, PMC *dest)>
-
-Concatenates the string and C<*value> and returns the result in
-C<*dest>.
-
-=cut
-
-*/
-
- void concatenate_str (STRING* value, PMC* dest) {
- STRING* s = PMC_str_val(SELF);
- VTABLE_morph(INTERP, dest, enum_class_PerlString);
- PMC_str_val(dest) = string_concat(INTERP, s, value, 0);
- }
-
-/*
-
-=item C<INTVAL is_equal(PMC *value)>
-
-The C<==> operation.
-
-=cut
-
-*/
-
- INTVAL is_equal (PMC* value) {
- return (INTVAL)( 0 == string_compare(INTERP,
- PMC_str_val(SELF),
- VTABLE_get_string(INTERP, value)
- ));
- }
-
-/*
-
-=item C<INTVAL cmp(PMC *value)>
-
-Returns the result of comparing the string with C<*value>.
-
-=cut
-
-*/
-
- INTVAL cmp(PMC* value) {
- return string_compare(INTERP, PMC_str_val(SELF),
- VTABLE_get_string(INTERP, value));
- }
-
-/*
-
-=item C<void repeat(PMC *value, PMC *dest)>
-
-Returns in C<*dest> the string repeated C<*value> times.
-
-=cut
-
-*/
-
- void repeat (PMC* value, PMC* dest) {
- VTABLE_morph(INTERP, dest, enum_class_PerlString);
- PMC_str_val(dest) =
- string_repeat(INTERP, PMC_str_val(SELF),
- (UINTVAL)VTABLE_get_integer(INTERP, value), NULL
- );
- }
-
-/*
-
-=item C<void repeat_int(INTVAL value, PMC *dest)>
-
-Returns in C<*dest> the string repeated C<value> times.
-
-=cut
-
-*/
-
- void repeat_int (INTVAL value, PMC* dest) {
- VTABLE_morph(INTERP, dest, enum_class_PerlString);
- PMC_str_val(dest) = string_repeat(INTERP,
- PMC_str_val(SELF), (UINTVAL)value, NULL);
- }
-
-/*
-
=item C<void increment()>
=item C<void decrement()>
@@ -695,104 +295,9 @@
VTABLE_set_integer_native(INTERP, SELF, i - 1);
}
-/*
-
-=item C<void substr(INTVAL offset, INTVAL length, PMC *dest)>
-
-Returns in C<*dest> the C<length> character substring of the string
-starting at C<offset>.
-
-=cut
-
-*/
-
- void substr (INTVAL offset, INTVAL length, PMC* dest) {
- DYNSELF.morph(enum_class_PerlString);
- VTABLE_morph(INTERP, dest, enum_class_PerlString);
- PMC_str_val(dest) = string_substr(INTERP,
- PMC_str_val(SELF), offset, length, NULL, 0);
- }
-
-/*
-
-=item C<STRING *substr_str(INTVAL offset, INTVAL length)>
-
-Returns the C<length> character substring of the string starting at
-C<offset>.
-
-
-=cut
-
-*/
-
- STRING* substr_str (INTVAL offset, INTVAL length) {
- return string_substr(INTERP, PMC_str_val(SELF), offset,
- length, NULL, 0);
- }
-
-/*
-
-=back
-
-=head2 Iterator Interface
-
-=over 4
-
-=item C<PMC* slice (PMC *key, INTVAL f)>
-
-Return a new iterator for the slice PMC C<key> if f==0.
-
-Return a new pythonic slice if f == 1.
-
-=item C<PMC* get_iter (PMC *key)>
-
-Return a new iterator for this string.
-
-
-=item C<INTVAL elements ()>
-
-Return length of the string.
-
-
-=cut
-
-*/
-
- INTVAL elements () {
- return string_length(INTERP, PMC_str_val(SELF));
- }
-
- PMC* slice (PMC* key, INTVAL f) {
- switch (f) {
- case 0:
- {
- PMC *iter = pmc_new_init(interpreter,
- enum_class_Iterator, SELF);
- PMC_struct_val(iter) = key;
- return iter;
- }
- case 1:
- return Parrot_py_get_slice(INTERP, SELF, key);
- }
- internal_exception(1, "PerlString: Unknown slice type");
- return NULL;
- }
-
- PMC* get_iter () {
- PMC *iter = pmc_new_init(interpreter, enum_class_Iterator, SELF);
- PMC *key = pmc_new(interpreter, enum_class_Key);
- PMC_struct_val(iter) = key;
- PObj_get_FLAGS(key) |= KEY_integer_FLAG;
- PMC_int_val(key) = 0;
- if (!string_length(INTERP, PMC_str_val(SELF)))
- PMC_int_val(key) = -1;
- return iter;
- }
/*
-=item C<STRING *get_string_keyed(PMC *key)>
-
=item C<PMC *get_pmc_keyed(PMC *key)>
Returns the string value for C<SELF[key]>.
@@ -801,11 +306,6 @@
*/
- STRING* get_string_keyed(PMC* key) {
- STRING *s = PMC_str_val(SELF);
-
- return string_substr(INTERP, s, key_integer(INTERP,key), 1, NULL, 0);
- }
PMC* get_pmc_keyed(PMC* key) {
STRING *s = PMC_str_val(SELF);
PMC *ret;
@@ -819,52 +319,6 @@
return ret;
}
-/*
-
-=item C<INTVAL get_integer_keyed(PMC *key)>
-
-Returns the integer value for C<*key>.
-
-=cut
-
-*/
-
- INTVAL get_integer_keyed(PMC* key) {
- STRING *s = PMC_str_val(SELF);
-
- return string_ord(INTERP, s, PMC_int_val(key));
- }
-
-/*
-
-=item C<void freeze(visit_info *info)>
-
-Used to archive the string.
-
-=cut
-
-*/
- void freeze(visit_info *info) {
- IMAGE_IO *io = info->image_io;
- SUPER(info);
- io->vtable->push_string(INTERP, io, PMC_str_val(SELF));
- }
-
-/*
-
-=item C<void thaw(visit_info *info)>
-
-Used to unarchive the string.
-
-=cut
-
-*/
- void thaw(visit_info *info) {
- IMAGE_IO *io = info->image_io;
- SUPER(info);
- if (info->extra_flags == EXTRA_IS_NULL)
- PMC_str_val(SELF) = io->vtable->shift_string(INTERP, io);
- }
}
/*
1.4 +130 -13 parrot/classes/string.pmc
Index: string.pmc
===================================================================
RCS file: /cvs/public/parrot/classes/string.pmc,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -r1.3 -r1.4
--- string.pmc 27 Jun 2004 15:29:40 -0000 1.3
+++ string.pmc 10 Dec 2004 10:15:17 -0000 1.4
@@ -1,6 +1,6 @@
/*
Copyright: 2003 The Perl Foundation. All Rights Reserved.
-$Id: string.pmc,v 1.3 2004/06/27 15:29:40 leo Exp $
+$Id: string.pmc,v 1.4 2004/12/10 10:15:17 leo Exp $
=head1 NAME
@@ -8,7 +8,7 @@
=head1 DESCRIPTION
-C<String> extends C<mmd_default> to provide a string for languages
+C<String> extends C<scalar> to provide a string for languages
that want a C<string> type without going to an S register. Acts as a
wrapper for the functions in /src/string.c
@@ -22,7 +22,7 @@
#include "parrot/parrot.h"
-pmclass String {
+pmclass String extends scalar {
/*
@@ -42,6 +42,25 @@
/*
+=item C<PMC* instantiate()>
+
+Create a new Float from the passed in argument. This is a class method,
+arguments are passed according to pdd03.
+
+=cut
+
+*/
+ PMC* instantiate() {
+ int argcP = REG_INT(3);
+ PMC *class = REG_PMC(2);
+ PMC *res = pmc_new(interpreter, class->vtable->base_type);
+ if (argcP)
+ VTABLE_set_string_native(interpreter, res,
+ VTABLE_get_string(interpreter, REG_PMC(5)));
+ return res;
+ }
+/*
+
=item C<void mark()>
Marks the string as live.
@@ -267,23 +286,23 @@
/*
=item C<VOID bitwise_or(PMC* value, PMC* dest)>
-=cut
+
=item C<VOID bitwise_and(PMC* value, PMC* dest)>
-=cut
+
=item C<VOID bitwise_xor(PMC* value, PMC* dest)>
-=cut
+
=item C<VOID bitwise_ors(PMC* value, PMC* dest)>
-=cut
+
=item C<VOID bitwise_ors_str(PMC* value, PMC* dest)>
-=cut
+
=item C<VOID bitwise_ands(PMC* value, PMC* dest)>
-=cut
+
=item C<VOID bitwise_ands_str(PMC* value, PMC* dest)>
-=cut
+
=item C<VOID bitwise_xors(PMC* value, PMC* dest)>
-=cut
+
=item C<VOID bitwise_xors_str(PMC* value, PMC* dest)>
-=cut
+
=item C<VOID bitwise_nots(PMC* value)>
These functions perform bitwise operations on entire
@@ -602,18 +621,93 @@
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>.
+
=cut
*/
STRING* get_string_keyed(PMC* key) {
STRING *s = PMC_str_val(SELF);
- INTVAL k = VTABLE_get_integer(INTERP, key);
+ INTVAL k = key_integer(INTERP, key);
return string_substr(INTERP, s, k, 1, NULL, 0);
}
+ INTVAL get_integer_keyed(PMC* key) {
+ STRING *s = PMC_str_val(SELF);
+
+ return string_ord(INTERP, s, key_integer(INTERP, key));
+ }
+
+/*
+
+=back
+
+=head2 Iterator Interface
+
+=over 4
+
+=item C<PMC* slice (PMC *key, INTVAL f)>
+
+Return a new iterator for the slice PMC C<key> if f==0.
+
+Return a new pythonic slice if f == 1.
+
+=item C<PMC* get_iter (PMC *key)>
+
+Return a new iterator for this string.
+
+
+=item C<INTVAL elements ()>
+
+Return length of the string.
+
+
+=cut
+
+*/
+
+ INTVAL elements () {
+ return string_length(INTERP, PMC_str_val(SELF));
+ }
+
+ PMC* slice (PMC* key, INTVAL f) {
+ switch (f) {
+ case 0:
+ {
+ PMC *iter = pmc_new_init(interpreter,
+ enum_class_Iterator, SELF);
+ PMC_struct_val(iter) = key;
+ return iter;
+ }
+ case 1:
+ return Parrot_py_get_slice(INTERP, SELF, key);
+ }
+ internal_exception(1, "PerlString: Unknown slice type");
+ return NULL;
+ }
+
+ PMC* get_iter () {
+ PMC *iter = pmc_new_init(interpreter, enum_class_Iterator, SELF);
+ PMC *key = pmc_new(interpreter, enum_class_Key);
+ PMC_struct_val(iter) = key;
+ PObj_get_FLAGS(key) |= KEY_integer_FLAG;
+ PMC_int_val(key) = 0;
+ if (!string_length(INTERP, PMC_str_val(SELF)))
+ PMC_int_val(key) = -1;
+ return iter;
+ }
+
/*
+=back
+
+=head2 Freeze/thaw Interface
+
+=over 4
+
=item C<void freeze(visit_info *info)>
Used to archive the string.
@@ -642,6 +736,29 @@
if (info->extra_flags == EXTRA_IS_NULL)
PMC_str_val(SELF) = io->vtable->shift_string(INTERP, io);
}
+/*
+
+=back
+
+=head2 NCI methods
+
+=over 4
+
+=item C<PMC* lower()>
+
+Downcase this string
+
+=cut
+
+*/
+
+ METHOD PMC* lower() {
+ STRING *s = string_downcase(interpreter, PMC_str_val(SELF));
+ PMC *ret = pmc_new_noinit(interpreter, SELF->vtable->base_type);
+ PMC_str_val(ret) = s;
+ PObj_custom_mark_SET(ret);
+ return ret;
+ }
}
/*
1.29 +7 -1 parrot/t/pmc/perlstring.t
Index: perlstring.t
===================================================================
RCS file: /cvs/public/parrot/t/pmc/perlstring.t,v
retrieving revision 1.28
retrieving revision 1.29
diff -u -r1.28 -r1.29
--- perlstring.t 14 Oct 2004 09:07:09 -0000 1.28
+++ perlstring.t 10 Dec 2004 10:15:19 -0000 1.29
@@ -1,6 +1,6 @@
#! perl -w
# Copyright: 2001-2003 The Perl Foundation. All Rights Reserved.
-# $Id: perlstring.t,v 1.28 2004/10/14 09:07:09 leo Exp $
+# $Id: perlstring.t,v 1.29 2004/12/10 10:15:19 leo Exp $
=head1 NAME
@@ -1252,6 +1252,11 @@
##PIR##
.sub _main @MAIN
.local pmc pmc1
+ pmc1 = new String
+ pmc1 = "ABCdef\n"
+ $P0 = pmc1."lower"()
+ print $P0
+ # PerlString should inherit the method
pmc1 = new PerlString
pmc1 = "ABCdef\n"
$P0 = pmc1."lower"()
@@ -1259,4 +1264,5 @@
.end
CODE
abcdef
+abcdef
OUTPUT
