add chars.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 10 Jul 2016 22:15:28 +0000 (00:15 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 10 Jul 2016 22:15:28 +0000 (00:15 +0200)
TODO
mes.c
mes.mes
test.mes

diff --git a/TODO b/TODO
index 46e8293da40132af9019f5bd4d8a21ab52284db8..399e3a1f252b6197a02c3e91c2c896b6eae07d7e 100644 (file)
--- a/TODO
+++ b/TODO
@@ -14,16 +14,16 @@ v "string"
 #\CHAR
 assq
 call-with-values
-char?
+char?
 length
-list
+list
 list->vector
 make-vector
 memv
-string
+string
 v string-append
 v string?
-symbol?
+symbol?
 values
 vector
 vector->list
diff --git a/mes.c b/mes.c
index 1774c64b32b10e07ffc14733e01eaefc5a2a4bc1..dfb6924f071ce04b1009866f365e28bd4185f936 100644 (file)
--- a/mes.c
+++ b/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 ()
 {
diff --git a/mes.mes b/mes.mes
index 7d25a7b987d33f7696258816cd9ef00f999a3764..9650bf7e862fb51d0152b26caea947902e8c7e68 100644 (file)
--- a/mes.mes
+++ b/mes.mes
   ;; (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)
index 3143266eb333a3091d62308b2e065eb3cc11d1f2..2eff4e96bb1b61673ef23b7b2d9e0431dddd82e8 100644 (file)
--- a/test.mes
+++ b/test.mes
 (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)
+
 '()