core: Remove define.
[mes.git] / string.c
index d0f792a640a95ae57768eba11652630fd08ea9af..36c27816381fd4d466ae6a78eade536cd9bf651b 100644 (file)
--- a/string.c
+++ b/string.c
  * along with Mes.  If not, see <http://www.gnu.org/licenses/>.
  */
 
-scm *
-string (scm *x) ///((args . n))
+SCM
+string (SCM x) ///((arity . n))
 {
-  char buf[STRING_MAX] = "";
-  char *p = buf;
-  while (x != &scm_nil)
-    {
-      scm *s = car (x);
-      assert (s->type == CHAR);
-      *p++ = s->value;
-      x = cdr (x);
-    }
-  return make_string (buf);
+  return make_string (x);
 }
 
-scm *
-string_append (scm *x) ///((args . n))
+SCM
+string_append (SCM x) ///((arity . n))
 {
-  char buf[STRING_MAX] = "";
-
-  while (x != &scm_nil)
+  SCM p = cell_nil;
+  while (x != cell_nil)
     {
-      scm *s = car (x);
-      assert (s->type == STRING);
-      strcat (buf, s->name);
+      SCM s = car (x);
+      assert (TYPE (s) == STRING);
+      p = append2 (p, STRING (s));
       x = cdr (x);
     }
-  return make_string (buf);
+  return make_string (p);
 }
 
-scm *
-list_to_string (scm *x)
+SCM
+list_to_string (SCM x)
 {
-  char buf[STRING_MAX] = "";
-  char *p = buf;
-  while (x != &scm_nil)
-    {
-      scm *s = car (x);
-      assert (s->type == CHAR);
-      *p++ = s->value;
-      x = cdr (x);
-    }
-  *p = 0;
-  return make_string (buf);
+  return make_string (x);
 }
 
-scm *
-string_length (scm *x)
+SCM
+string_length (SCM x)
 {
-  assert (x->type == STRING);
-  return make_number (strlen (x->name));
+  assert (TYPE (x) == STRING);
+  return make_number (VALUE (length (STRING (x))));
 }
 
-scm *
-string_ref (scm *x, scm *k)
+SCM
+string_ref (SCM x, SCM k)
 {
-  assert (x->type == STRING);
-  assert (k->type == NUMBER);
-  return make_char (x->name[k->value]);
+  assert (TYPE (x) == STRING);
+  assert (TYPE (k) == NUMBER);
+  VALUE (tmp_num) = VALUE (k);
+  return make_char (VALUE (list_ref (STRING (x), tmp_num)));
 }
 
-scm *
-substring (scm *x) ///((args . n))
+SCM
+substring (SCM x) ///((arity . n))
 {
-  assert (x->type == PAIR);
-  assert (x->car->type == STRING);
-  char const *s = x->car->name;
-  assert (x->cdr->car->type == NUMBER);
-  int start = x->cdr->car->value;
-  int end = strlen (s);
-  if (x->cdr->cdr->type == PAIR) {
-    assert (x->cdr->cdr->car->type == NUMBER);
-    assert (x->cdr->cdr->car->value <= end);
-    end = x->cdr->cdr->car->value;
+  assert (TYPE (x) == PAIR);
+  assert (TYPE (car (x)) == STRING);
+  SCM s = STRING (car (x));
+  assert (TYPE (cadr (x)) == NUMBER);
+  int start = VALUE (cadr (x));
+  int end = VALUE (length (s));
+  if (TYPE (cddr (x)) == PAIR) {
+    assert (TYPE (caddr (x)) == NUMBER);
+    assert (VALUE (caddr (x)) <= end);
+    end = VALUE (caddr (x));
   }
-  char buf[STRING_MAX];
-  strncpy (buf, s+start, end - start);
-  buf[end-start] = 0;
-  return make_string (buf);
+  int n = end - start;
+  while (start--) s = cdr (s);
+  SCM p = cell_nil;
+  while (n-- && s != cell_nil) {
+    p = append2 (p, cons (make_char (VALUE (car (s))), cell_nil));
+    s = cdr (s);
+  }
+  return make_string (p);
+}
+
+SCM
+number_to_string (SCM x)
+{
+  assert (TYPE (x) == NUMBER);
+  int n = VALUE (x);
+  SCM p = n < 0 ? cons (make_char ('-'), cell_nil) : cell_nil;
+  do {
+    p = cons (make_char (n % 10 + '0'), p);
+    n = n / 10;
+  } while (n);
+  return make_string (p);
+}
+
+SCM
+string_to_symbol (SCM x)
+{
+  assert (TYPE (x) == STRING);
+  return make_symbol (STRING (x));
 }
 
-scm *
-number_to_string (scm *x)
+SCM
+symbol_to_string (SCM x)
 {
-  assert (x->type == NUMBER);
-  char buf[STRING_MAX];
-  sprintf (buf,"%d", x->value);
-  return make_string (buf);
+  assert (TYPE (x) == SYMBOL);
+  return make_string (STRING (x));
 }
 
-scm *
-string_to_symbol (scm *x)
+SCM
+keyword_to_symbol (SCM x)
 {
-  assert (x->type == STRING);
-  return make_symbol (x->name);
+  assert (TYPE (x) == KEYWORD);
+  return make_symbol (STRING (x));
 }
 
-scm *
-symbol_to_string (scm *x)
+SCM
+symbol_to_keyword (SCM x)
 {
-  assert (x->type == SYMBOL);
-  return make_string (x->name);
+  assert (TYPE (x) == SYMBOL);
+  return make_keyword (STRING (x));
 }