native/string.c

   1 #include "factor.h"
   2
   3 /* untagged */
   4 STRING* allot_string(CELL capacity)
   5 {
   6         STRING* string = (STRING*)allot_object(STRING_TYPE,
   7                 sizeof(STRING) + capacity * CHARS);
   8         string->capacity = capacity;
   9         return string;
  10 }
  11
  12 /* call this after constructing a string */
  13 /* uses same algorithm as java.lang.String for compatibility */
  14 void hash_string(STRING* str)
  15 {
  16         FIXNUM hash = 0;
  17         CELL i;
  18         for(i = 0; i < str->capacity; i++)
  19                 hash = 31*hash + string_nth(str,i);
  20         str->hashcode = hash;
  21 }
  22
  23 /* untagged */
  24 STRING* string(CELL capacity, CELL fill)
  25 {
  26         CELL i;
  27
  28         STRING* string = allot_string(capacity);
  29
  30         for(i = 0; i < capacity; i++)
  31                 put(SREF(string,i),fill);
  32
  33         hash_string(string);
  34
  35         return string;
  36 }
  37
  38 STRING* grow_string(STRING* string, CELL capacity, CHAR fill)
  39 {
  40         /* later on, do an optimization: if end of array is here, just grow */
  41         CELL i;
  42
  43         STRING* new_string = allot_string(capacity);
  44
  45         memcpy(new_string + 1,string + 1,string->capacity * CHARS);
  46
  47         for(i = string->capacity; i < capacity; i++)
  48                 put(SREF(new_string,i),fill);
  49
  50         return new_string;
  51 }
  52
  53 /* untagged */
  54 STRING* from_c_string(const char* c_string)
  55 {
  56         CELL length = strlen(c_string);
  57         STRING* s = allot_string(length);
  58         CELL i;
  59
  60         for(i = 0; i < length; i++)
  61         {
  62                 put(SREF(s,i),*c_string);
  63                 c_string++;
  64         }
  65
  66         hash_string(s);
  67
  68         return s;
  69 }
  70
  71 /* untagged */
  72 char* to_c_string(STRING* s)
  73 {
  74         STRING* _c_str = allot_string(s->capacity + 1 /* null byte */);
  75         CELL i;
  76
  77         char* c_str = (char*)(_c_str + 1);
  78
  79         for(i = 0; i < s->capacity; i++)
  80                 c_str[i] = string_nth(s,i);
  81
  82         c_str[s->capacity] = '\0';
  83
  84         return c_str;
  85 }
  86
  87 void primitive_stringp(void)
  88 {
  89         check_non_empty(env.dt);
  90         env.dt = tag_boolean(typep(STRING_TYPE,env.dt));
  91 }
  92
  93 void primitive_string_length(void)
  94 {
  95         env.dt = tag_fixnum(untag_string(env.dt)->capacity);
  96 }
  97
  98 void primitive_string_nth(void)
  99 {
 100         STRING* string = untag_string(env.dt);
 101         CELL index = to_fixnum(dpop());
 102
 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));
 106 }
 107
 108 FIXNUM string_compare(STRING* s1, STRING* s2)
 109 {
 110         CELL len1 = s1->capacity;
 111         CELL len2 = s2->capacity;
 112
 113         CELL limit = (len1 < len2 ? len1 : len2);
 114
 115         CELL i = 0;
 116         while(i < limit)
 117         {
 118                 CHAR c1 = string_nth(s1,i);
 119                 CHAR c2 = string_nth(s2,i);
 120                 if(c1 != c2)
 121                         return c1 - c2;
 122                 i++;
 123         }
 124
 125         return len1 - len2;
 126 }
 127
 128 void primitive_string_compare(void)
 129 {
 130         STRING* s1 = untag_string(env.dt);
 131         STRING* s2 = untag_string(dpop());
 132
 133         env.dt = tag_fixnum(string_compare(s1,s2));
 134 }
 135
 136 bool string_eq(STRING* s1, STRING* s2)
 137 {
 138         if(s1->hashcode != s2->hashcode)
 139                 return false;
 140         else
 141                 return (string_compare(s1,s2) == 0);
 142 }
 143
 144 void primitive_string_eq(void)
 145 {
 146         STRING* s1 = untag_string(env.dt);
 147         CELL with = dpop();
 148         check_non_empty(with);
 149         if(typep(STRING_TYPE,with))
 150                 env.dt = tag_boolean(string_eq(s1,(STRING*)UNTAG(with)));
 151         else
 152                 env.dt = F;
 153 }
 154
 155 void primitive_string_hashcode(void)
 156 {
 157         env.dt = tag_object(bignum(untag_string(env.dt)->hashcode));
 158 }
 159
 160 INLINE CELL index_of_ch(CELL index, STRING* string, CELL ch)
 161 {
 162         if(index < 0)
 163                 range_error(tag_object(string),index,string->capacity);
 164
 165         while(index < string->capacity)
 166         {
 167                 if(string_nth(string,index) == ch)
 168                         return index;
 169                 index++;
 170         }
 171
 172         return -1;
 173 }
 174
 175 INLINE CELL index_of_str(CELL index, STRING* string, STRING* substring)
 176 {
 177         if(substring->capacity != 1)
 178                 fatal_error("index_of_str not supported yet",substring);
 179
 180         return index_of_ch(index,string,string_nth(substring,0));
 181 }
 182
 183 /* index string substring -- index */
 184 void primitive_index_of(void)
 185 {
 186         CELL ch = env.dt;
 187         STRING* string;
 188         CELL index;
 189         CELL result;
 190         check_non_empty(ch);
 191         string = untag_string(dpop());
 192         index = to_fixnum(dpop());
 193         if(TAG(ch) == FIXNUM_TYPE)
 194                 result = index_of_ch(index,string,to_fixnum(ch));
 195         else
 196                 result = index_of_str(index,string,untag_string(ch));
 197         env.dt = tag_fixnum(result);
 198 }
 199
 200 INLINE STRING* substring(CELL start, CELL end, STRING* string)
 201 {
 202         STRING* result;
 203
 204         if(start < 0)
 205                 range_error(tag_object(string),start,string->capacity);
 206
 207         if(end < start)
 208                 range_error(tag_object(string),end,string->capacity);
 209
 210         result = allot_string(end - start);
 211         memcpy(result + 1,
 212                 (CELL)(string + 1) + CHARS * start,
 213                 CHARS * (end - start));
 214         hash_string(result);
 215
 216         return result;
 217 }
 218
 219 /* start end string -- string */
 220 void primitive_substring(void)
 221 {
 222         STRING* string = untag_string(env.dt);
 223         CELL end = to_fixnum(dpop());
 224         CELL start = to_fixnum(dpop());
 225         env.dt = tag_object(substring(start,end,string));
 226 }