add chars.

TODO

@@ -14,16 +14,16 @@ v "string"
 #\CHAR
 assq
 call-with-values
-char?
+v char?
 length
-list
+v list
 list->vector
 make-vector
 memv
-string
+v string
 v string-append
 v string?
-symbol?
+v symbol?
 values
 vector
 vector->list

mes.c

@@ -42,7 +42,7 @@
 #define QUOTE_SUGAR 1
 #endif
 
-enum type {STRING, SYMBOL, NUMBER, PAIR,
+enum type {STRING, SYMBOL, CHAR, NUMBER, PAIR,
            FUNCTION0, FUNCTION1, FUNCTION2, FUNCTION3, FUNCTIONn};
 struct scm_t;
 typedef struct scm_t* (*function0_t) (void);
@@ -140,10 +140,14 @@ scm *
 eq_p (scm *x, scm *y)
 {
   return (x == y
+          || (x->type == CHAR && y->type == CHAR
+              && x->value == y->value)
           || (x->type == NUMBER && y->type == NUMBER
               && x->value == y->value)
           // FIXME: alist lookup symbols
           || (atom_p (x) == &scm_t
+              && x->type != CHAR
+              && y->type != CHAR
               && x->type != NUMBER
               && y->type != NUMBER
               && atom_p (y) == &scm_t
@@ -298,7 +302,9 @@ eval_ (scm *e, scm *a)
   display (e);
   puts ("");
 #endif
-  if (e->type == NUMBER)
+  if (e->type == CHAR)
+    return e;
+  else if (e->type == NUMBER)
     return e;
   else if (e->type == STRING)
     return e;
@@ -414,6 +420,12 @@ builtin_p (scm *x)
     ? &scm_t : &scm_f;
 }
 
+scm *
+char_p (scm *x)
+{
+  return x->type == CHAR ? &scm_t : &scm_f;
+}
+
 scm *
 number_p (scm *x)
 {
@@ -474,6 +486,15 @@ append (scm *x, scm *y)
    return cons (car (x), append (cdr (x), y));
 }
 
+scm *
+make_char (int x)
+{
+  scm *p = malloc (sizeof (scm));
+  p->type = CHAR;
+  p->value = x;
+  return p;
+}
+
 scm *
 make_number (int x)
 {
@@ -502,6 +523,21 @@ make_symbol (char const *s)
   return p;
 }
 
+scm *
+string (scm *x/*...*/)
+{
+  char buf[256] = "";
+  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);
+}
+
 scm *
 string_append (scm *x/*...*/)
 {
@@ -599,7 +635,10 @@ display_helper (scm *x, bool cont, char *sep, bool quote)
 {
   scm *r;
   printf ("%s", sep);
-  if (x->type == NUMBER) printf ("%d", x->value);
+  if (x->type == CHAR && x->value == 10) printf ("#\\%s", "newline");
+  else if (x->type == CHAR && x->value == 32) printf ("#\\%s", "space");
+  else if (x->type == CHAR) printf ("#\\%c", x->value);
+  else if (x->type == NUMBER) printf ("%d", x->value);
   else if (x->type == PAIR) {
 #if QUOTE_SUGAR
     if (car (x) == &scm_quote) {
@@ -708,12 +747,44 @@ readword (int c, char* w, scm *a)
                                      cons (readword (getchar (), w, a),
                                            &scm_nil));}
   if (c == ';') {readcomment (c); return readword ('\n', w, a);}
+  if (c == '#' && peekchar () == '\\') {getchar (); return readchar ();}
   if (c == '#' && peekchar () == '!') {getchar (); readblock (getchar ()); return readword (getchar (), w, a);}
   char buf[256] = {0};
   char ch = c;
   return readword (getchar (), strncat (w ? w : buf, &ch, 1), a);
 }
 
+scm *
+readchar ()
+{
+  int c = getchar ();
+  if (c >= '0' && c <= '7'
+      && peekchar () >= '0' && peekchar () <= '7') {
+    c = c - '0';
+    while (peekchar () >= '0' && peekchar () <= '7') {
+      c <<= 3;
+      c += getchar () - '0';
+    }
+  }
+  else if (c >= 'a' && c <= 'z'
+      && peekchar () >= 'a' && peekchar () <= 'z') {
+    char buf[256];
+    char *p = buf;
+    *p++ = c;
+    while (peekchar () >= 'a' && peekchar () <= 'z') {
+      *p++ = getchar ();
+    }
+    *p = 0;
+    if (!strcmp (buf, "newline")) c = 10;
+    else if (!strcmp (buf, "space")) c = 32;
+    else {
+      printf ("char not supported: %s", buf);
+      assert (!"char not supported");
+    }
+  }
+  return make_char (c);
+}
+
 scm *
 readstring ()
 {

mes.mes

@@ -121,9 +121,10 @@
   ;; (display a)
   ;; (newline)
   (cond
-   ((number? e) e)
    ((eq? e #t) #t)
    ((eq? e #f) #f)
+   ((char? e) e)
+   ((number? e) e)
    ((string? e) e)
    ((atom? e) (cdr (assoc e a)))
    ((builtin? e) e)

test.mes

@@ -169,4 +169,17 @@
 (display (string-length (string-append "a" "b" "c")))
 (newline)
 
+#\m
+(display #\m)
+(newline)
+(display #\101)
+(newline)
+(display #\newline)
+(newline)
+(display #\space)
+(newline)
+
+(display (string #\a #\space #\s #\t #\r #\i #\n #\g #\newline))
+(newline)
+
 '()