mes.c, scm.c: add read-char, peek-char, char=?, char-alphabetic?.

mes.c

@@ -913,7 +913,7 @@ ungetchar (int c) //int
 }
 
 int
-peekchar () //int
+peek_char () //int
 {
   int c = getchar ();
   ungetchar (c);
@@ -927,9 +927,9 @@ builtin_getchar ()
 }
 
 scm*
-builtin_peekchar ()
+builtin_peek_char ()
 {
-  return make_number (peekchar ());
+  return make_char (getchar ());
 }
 
 scm*
@@ -950,7 +950,7 @@ readcomment (int c)
 int
 readblock (int c)
 {
-  if (c == '!' && peekchar () == '#') return getchar ();
+  if (c == '!' && peek_char () == '#') return getchar ();
   return readblock (getchar ());
 }
 
@@ -968,7 +968,7 @@ readword (int c, char* w, scm *a)
   if (c == '(') {ungetchar (c); return lookup (w, a);}
   if (c == ')' && !w) {ungetchar (c); return &scm_nil;}
   if (c == ')') {ungetchar (c); return lookup (w, a);}
-  if (c == ',' && peekchar () == '@') {getchar (); return cons (lookup (",@", a),
+  if (c == ',' && peek_char () == '@') {getchar (); return cons (lookup (",@", a),
                                                                 cons (readword (getchar (), w, a),
                                                                       &scm_nil));}
   if ((c == '\''
@@ -977,47 +977,47 @@ readword (int c, char* w, scm *a)
       && !w) {return cons (lookup_char (c, a),
                                      cons (readword (getchar (), w, a),
                                            &scm_nil));}
-  if (c == '#' && peekchar () == ',' && !w) {
+  if (c == '#' && peek_char () == ',' && !w) {
     getchar ();
-    if (peekchar () == '@'){getchar (); return cons (lookup ("#,@", a),
+    if (peek_char () == '@'){getchar (); return cons (lookup ("#,@", a),
                                                      cons (readword (getchar (), w, a),
                                                            &scm_nil));}
     return cons (lookup ("#,", a), cons (readword (getchar (), w, a), &scm_nil));
   }
   if (c == '#'
-     && (peekchar () == '\''
+     && (peek_char () == '\''
-         || peekchar () == '`')
+         || peek_char () == '`')
      && !w) {char buf[3] = "#"; buf[1] = getchar (); return cons (lookup (buf, 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 == '#' && peek_char () == '\\') {getchar (); return read_char ();}
-  if (c == '#' && !w && peekchar () == '(') {getchar (); return list_to_vector (readlist (a));}
+  if (c == '#' && !w && peek_char () == '(') {getchar (); return list_to_vector (readlist (a));}
-  if (c == '#' && peekchar () == '(') {ungetchar (c); return lookup (w, a);}
+  if (c == '#' && peek_char () == '(') {ungetchar (c); return lookup (w, a);}
-  if (c == '#' && peekchar () == '!') {getchar (); readblock (getchar ()); return readword (getchar (), w, a);}
+  if (c == '#' && peek_char () == '!') {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 ()
+read_char ()
 {
   int c = getchar ();
   if (c >= '0' && c <= '7'
-      && peekchar () >= '0' && peekchar () <= '7') {
+      && peek_char () >= '0' && peek_char () <= '7') {
     c = c - '0';
-    while (peekchar () >= '0' && peekchar () <= '7') {
+    while (peek_char () >= '0' && peek_char () <= '7') {
       c <<= 3;
       c += getchar () - '0';
     }
   }
   else if (c >= 'a' && c <= 'z'
-      && peekchar () >= 'a' && peekchar () <= 'z') {
+      && peek_char () >= 'a' && peek_char () <= 'z') {
     char buf[256];
     char *p = buf;
     *p++ = c;
-    while (peekchar () >= 'a' && peekchar () <= 'z') {
+    while (peek_char () >= 'a' && peek_char () <= 'z') {
       *p++ = getchar ();
     }
     *p = 0;
@@ -1041,7 +1041,7 @@ readstring ()
   while (true) {
     if (c == '"') break;
     *p++ = c;
-    if (c == '\\' && peekchar () == '"') *p++ = getchar ();
+    if (c == '\\' && peek_char () == '"') *p++ = getchar ();
     if (c == EOF) assert (!"EOF in string");
     c = getchar ();
   }
@@ -1054,7 +1054,7 @@ eat_whitespace (int c)
 {
   while (c == ' ' || c == '\t' || c == '\n') c = getchar ();
   if (c == ';') return eat_whitespace (readcomment (c));
-  if (c == '#' && peekchar () == '!') {getchar (); readblock (getchar ()); return eat_whitespace (getchar ());}
+  if (c == '#' && peek_char () == '!') {getchar (); readblock (getchar ()); return eat_whitespace (getchar ());}
   return c;
 }
 

mes.mes

@@ -164,7 +164,7 @@
 
 ;; readenv et al works, but slows down dramatically
 (define (DISABLED-readenv a)
-  (readword (getchar) '() a))
+  (readword (read-char) '() a))
 
 (define (readword c w a)
   ;; (display 'mes-readword:)
@@ -174,59 +174,59 @@
          (cond ((eq? w '()) '())
                (#t (lookup w a))))
         ((eq? c 10) ;; \n
-         (cond ((eq? w '()) (readword (getchar) w a))
+         (cond ((eq? w '()) (readword (read-char) w a))
-               ;; DOT ((eq? w '(*dot*)) (car (readword (getchar) '() a)))
+               ;; DOT ((eq? w '(*dot*)) (car (readword (read-char) '() a)))
                (#t (lookup w a))))
         ((eq? c 32) ;; \space
          (readword 10 w a))
         ((eq? c 40) ;; (
          (cond ((eq? w '()) (readlist a))
-               (#t (ungetchar c) (lookup w a))))
+               (#t (unread-char c) (lookup w a))))
         ((eq? c 41) ;; )
-         (cond ((eq? w '()) (ungetchar c) w)
+         (cond ((eq? w '()) (unread-char c) w)
-               (#t (ungetchar c) (lookup w a))))
+               (#t (unread-char c) (lookup w a))))
         ((eq? c 39) ;; '
          (cond ((eq? w '())
                 (cons (lookup (cons c '()) a)
-                      (cons (readword (getchar) w a) '())))
+                      (cons (readword (read-char) w a) '())))
-               (#t (ungetchar c) (lookup w a))))
+               (#t (unread-char c) (lookup w a))))
         ((eq? c 59) ;; ;
          (readcomment c)
          (readword 10 w a))
         ((eq? c 35) ;; #
-         (cond ((eq? (peekchar) 33) ;; !
+         (cond ((eq? (peek-char) 33) ;; !
-                (getchar)
+                (read-char)
-                (readblock (getchar))
+                (readblock (read-char))
                 (readword 10 w a))
                ;; TODO: char, vector
-               (#t (readword (getchar) (append w (cons c '())) a))))
+               (#t (readword (read-char) (append w (cons c '())) a))))
-        (#t (readword (getchar) (append w (cons c '())) a))))
+        (#t (readword (read-char) (append w (cons c '())) a))))
 
 (define (readblock c)
   ;; (display 'mes-readblock:)
   ;; (display c)
   ;; (newline)
-  (cond ((eq? c 33) (cond ((eq? (peekchar) 35) (getchar))
+  (cond ((eq? c 33) (cond ((eq? (peek-char) 35) (read-char))
-                         (#t (readblock (getchar)))))
+                         (#t (readblock (read-char)))))
-        (#t (readblock (getchar)))))
+        (#t (readblock (read-char)))))
 
 (define (eat-whitespace)
-  (cond ((eq? (peekchar) 10) (getchar) (eat-whitespace))
+  (cond ((eq? (peek-char) 10) (read-char) (eat-whitespace))
-        ((eq? (peekchar) 32) (getchar) (eat-whitespace))
+        ((eq? (peek-char) 32) (read-char) (eat-whitespace))
-        ((eq? (peekchar) 35) (getchar) (eat-whitespace))
+        ((eq? (peek-char) 35) (read-char) (eat-whitespace))
         (#t #t)))
 
 (define (readlist a)
   ;; (display 'mes-readlist:)
   ;; (newline)
   (eat-whitespace)
-  (cond ((eq? (peekchar) 41) ;; )
+  (cond ((eq? (peek-char) 41) ;; )
-         (getchar)
+         (read-char)
          '())
         ;; TODO *dot*
-        (#t (cons (readword (getchar) '() a) (readlist a)))))
+        (#t (cons (readword (read-char) '() a) (readlist a)))))
 
 (define (readcomment c)
   (cond ((eq? c 10) ;; \n
          c)
-        (#t (readcomment (getchar)))))
+        (#t (readcomment (read-char)))))

scm.mes

@@ -260,3 +260,16 @@
 (define (reverse lst)
   (if (null? lst) '()
       (append (reverse (cdr lst)) (cons (car lst) '()))))
+
+(define (eof-object? x)
+  (and (number? x) (= x -1)))
+
+(define (char=? x y)
+  (and (char? x) (char? y)
+       (eq? x y)))
+
+(define (char-alphabetic? x)
+  (and (char? x)
+       (let ((i (char->integer x)))
+        (or (and (>= i (char->integer #\A)) (<= i (char->integer #\Z)))
+            (and (>= i (char->integer #\a)) (<= i (char->integer #\z)))))))

test.mes

@@ -294,6 +294,9 @@
 
 (pass-if "do" (sequal? (let ((acc '())) (do ((i 0 (+ i 1))) ((>= i 3)) (set! acc (cons i acc))) acc) '(2 1 0)))
 
+(pass-if "char-alphabetic?" (seq? (char-alphabetic? #\a) #t))
+(pass-if "char-alphabetic? 2" (seq? (char-alphabetic? #\[) #f))
+
 (newline)
 (display "passed: ") (display (car (result))) (newline)
 (display "failed: ") (display (cadr (result))) (newline)