mescc: mes parses simplest main with lalr.

GNUmakefile

@@ -92,6 +92,9 @@ paren.test: lib/lalr.scm paren.scm
 guile-paren: paren.test
 	echo '___P((()))' | guile -s $^ 
 
+mescc: all
+	echo ' EOF ' | cat scm.mes syntax.mes lib/srfi/srfi-0.scm lib/record.mes lib/record.scm lib/srfi/srfi-9.scm lib/lalr.mes lib/lalr.scm c-lexer.scm mescc.scm - main.c | ./mes
+
 mescc.test: lib/lalr.scm c-lexer.scm mescc.scm
 	cat $^ > $@
 

c-lexer.scm

@@ -40,7 +40,6 @@
    )
   )
 
-
 (define (port-source-location port)
   (make-source-location (port-filename port)
                         (port-line port)
@@ -106,15 +105,15 @@
 
 (define (read-string loc)
   (let ((c (read-char)))
-    (let ((terms (string c #\\ #\nl #\cr)))
+    (let ((terms (string c #\\ #\newline #\return)))
       (define (read-escape)
         (let ((c (read-char)))
           (case c
             ((#\' #\" #\\) c)
-            ((#\b) #\bs)
-            ((#\f) #\np)
-            ((#\n) #\nl)
-            ((#\r) #\cr)
+            ((#\b) #\backspace)
+            ((#\f) #\page)
+            ((#\n) #\newline)
+            ((#\r) #\return)
             ((#\t) #\tab)
             ((#\v) #\vt)
             ((#\0)
@@ -343,7 +342,7 @@
                                 puncs))))))
     (lambda (loc)
       (let lp ((c (peek-char)) (tree punc-tree) (candidate #f))
-        (display "read-punctuation c=") (display c) (newline)
+        ;;(display "read-punctuation c=") (display c) (newline)
         (cond
          ((assv-ref tree c)
           (let ((node-tail (assv-ref tree c)))
@@ -357,13 +356,14 @@
 (define (next-token div?)
   (let ((c   (peek-char))
         (loc (port-source-location (current-input-port))))
-    (display "next-token c=") (display c) (newline)
+    ;;(display "next-token c=") (display c) (newline)
 
     (case c
-      ((#\ht #\vt #\np #\space #\x00A0) ; whitespace
+      ((#\tab #\vt #\page #\space ;;#\x00A0
+        ) ; whitespace
        (read-char)
        (next-token div?))
-      ((#\newline #\cr)                 ; line break
+      ((#\newline #\return)                 ; line break
        (read-char)
        (next-token div?))
       ((#\/)

mes.c

@@ -634,6 +634,22 @@ string_append (scm *x/*...*/)
   return make_string (buf);
 }
 
+scm *
+list_to_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);
+    }
+  *p = 0;
+  return make_string (buf);
+}
+
 scm *
 string_length (scm *x)
 {

scm.mes

@@ -68,6 +68,20 @@
        ,@body
        (loop ,@(cddar init)))))
 
+(define-macro (case val . args)
+  (if (null? args)
+      #f
+      (let* ((clause (car args))
+             (pred (car clause))
+             (body (cdr clause)))
+        (if (pair? pred)
+            `(if ,(if (null? (cdr pred))
+                      `(eq? ,val ',(car pred))
+                           `(member ,val ',pred))
+                 (begin ,@body)
+                 (case ,val ,@(cdr args)))
+            `(begin ,@body)))))  ; else clause
+
 (define-macro (or2 x y)
   `(cond (,x ,x) (#t ,y)))
 
@@ -145,6 +159,11 @@
         ((equal? key (caar alist)) (car alist))
         (#t (assoc key (cdr alist)))))
 
+(define (assoc-ref alist key)
+  (let ((entry (assoc key alist)))
+    (if entry (cdr entry)
+        #f)))
+
 (define (memq x lst)
   (cond ((null? lst) #f)
         ((eq? x (car lst)) lst)
@@ -276,6 +295,11 @@
         (or (and (>= i (char->integer #\A)) (<= i (char->integer #\Z)))
             (and (>= i (char->integer #\a)) (<= i (char->integer #\z)))))))
 
+(define (char-numeric? x)
+  (and (char? x)
+       (let ((i (char->integer x)))
+         (and (>= i (char->integer #\0)) (<= i (char->integer #\9))))))
+
 (define (current-input-port) #f)
 (define (port-filename port) "<stdin>")
 (define (port-line port) 0)