4 STRING* allot_string(CELL capacity)
6 STRING* string = (STRING*)allot_object(STRING_TYPE,
7 sizeof(STRING) + capacity * CHARS);
8 string->capacity = capacity;
12 /* call this after constructing a string */
13 /* uses same algorithm as java.lang.String for compatibility */
14 void hash_string(STRING* str)
18 for(i = 0; i < str->capacity; i++)
19 hash = 31*hash + string_nth(str,i);
24 STRING* string(CELL capacity, CELL fill)
28 STRING* string = allot_string(capacity);
30 for(i = 0; i < capacity; i++)
31 put(SREF(string,i),fill);
38 STRING* grow_string(STRING* string, CELL capacity, CHAR fill)
40 /* later on, do an optimization: if end of array is here, just grow */
43 STRING* new_string = allot_string(capacity);
45 memcpy(new_string + 1,string + 1,string->capacity * CHARS);
47 for(i = string->capacity; i < capacity; i++)
48 put(SREF(new_string,i),fill);
54 STRING* from_c_string(const char* c_string)
56 CELL length = strlen(c_string);
57 STRING* s = allot_string(length);
60 for(i = 0; i < length; i++)
62 put(SREF(s,i),*c_string);
72 char* to_c_string(STRING* s)
74 STRING* _c_str = allot_string(s->capacity + 1 /* null byte */);
77 char* c_str = (char*)(_c_str + 1);
79 for(i = 0; i < s->capacity; i++)
80 c_str[i] = string_nth(s,i);
82 c_str[s->capacity] = '\0';
87 void primitive_stringp(void)
89 check_non_empty(env.dt);
90 env.dt = tag_boolean(typep(STRING_TYPE,env.dt));
93 void primitive_string_length(void)
95 env.dt = tag_fixnum(untag_string(env.dt)->capacity);
98 void primitive_string_nth(void)
100 STRING* string = untag_string(env.dt);
101 CELL index = to_fixnum(dpop());
103 if(index < 0 || index >= string->capacity)
104 range_error(tag_object(string),index,string->capacity);
105 env.dt = tag_fixnum(string_nth(string,index));
108 FIXNUM string_compare(STRING* s1, STRING* s2)
110 CELL len1 = s1->capacity;
111 CELL len2 = s2->capacity;
113 CELL limit = (len1 < len2 ? len1 : len2);
118 CHAR c1 = string_nth(s1,i);
119 CHAR c2 = string_nth(s2,i);
128 void primitive_string_compare(void)
130 STRING* s1 = untag_string(env.dt);
131 STRING* s2 = untag_string(dpop());
133 env.dt = tag_fixnum(string_compare(s1,s2));
136 bool string_eq(STRING* s1, STRING* s2)
138 if(s1->hashcode != s2->hashcode)
141 return (string_compare(s1,s2) == 0);
144 void primitive_string_eq(void)
146 STRING* s1 = untag_string(env.dt);
148 check_non_empty(with);
149 if(typep(STRING_TYPE,with))
150 env.dt = tag_boolean(string_eq(s1,(STRING*)UNTAG(with)));
155 void primitive_string_hashcode(void)
157 env.dt = tag_object(bignum(untag_string(env.dt)->hashcode));
160 CELL index_of_ch(CELL index, STRING* string, CELL ch)
163 range_error(tag_object(string),index,string->capacity);
165 while(index < string->capacity)
167 if(string_nth(string,index) == ch)
175 INLINE FIXNUM index_of_str(FIXNUM index, STRING* string, STRING* substring)
178 CELL limit = string->capacity - substring->capacity;
181 if(substring->capacity == 1)
182 return index_of_ch(index,string,string_nth(substring,0));
184 if(substring->capacity > string->capacity)
187 outer: if(i <= limit)
189 for(scan = 0; scan < substring->capacity; scan++)
191 if(string_nth(string,i + scan)
192 != string_nth(substring,scan))
199 /* We reached here and every char in the substring matched */
203 /* We reached here and nothing matched */
207 /* index string substring -- index */
208 void primitive_index_of(void)
215 string = untag_string(dpop());
216 index = to_fixnum(dpop());
217 if(index < 0 || index > string->capacity)
219 range_error(tag_object(string),index,string->capacity);
220 result = -1; /* can't happen */
222 else if(TAG(ch) == FIXNUM_TYPE)
223 result = index_of_ch(index,string,to_fixnum(ch));
225 result = index_of_str(index,string,untag_string(ch));
226 env.dt = tag_fixnum(result);
229 INLINE STRING* substring(CELL start, CELL end, STRING* string)
234 range_error(tag_object(string),start,string->capacity);
237 range_error(tag_object(string),end,string->capacity);
239 result = allot_string(end - start);
241 (void*)((CELL)(string + 1) + CHARS * start),
242 CHARS * (end - start));
248 /* start end string -- string */
249 void primitive_substring(void)
251 STRING* string = untag_string(env.dt);
252 CELL end = to_fixnum(dpop());
253 CELL start = to_fixnum(dpop());
254 env.dt = tag_object(substring(start,end,string));