mescc: mes parses simplest main with lalr.
authorJan Nieuwenhuizen <janneke@gnu.org>
Sun, 24 Jul 2016 23:12:22 +0000 (01:12 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sun, 24 Jul 2016 23:12:22 +0000 (01:12 +0200)
GNUmakefile
c-lexer.scm
mes.c
scm.mes

index 404176abd872a1a2a4f9460de8ce35c7de1878fc..81c685e62b85baa6ec76858517869b43af96adca 100644 (file)
@@ -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 $^ > $@
 
index 1664c2390461b7b823c10cebc9ad534af6a51a37..3ad1c94e4fe4f652664b33323b4b832648f736b5 100644 (file)
@@ -40,7 +40,6 @@
    )
   )
 
-
 (define (port-source-location port)
   (make-source-location (port-filename port)
                         (port-line port)
 
 (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)
                                 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)))
 (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?))
       ((#\/)
diff --git a/mes.c b/mes.c
index 93204ec577f78b01a984eecbe51d92f343f07f06..5d6355101b297a19efd6ecdba5b3be957754c378 100644 (file)
--- a/mes.c
+++ b/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)
 {
diff --git a/scm.mes b/scm.mes
index 75e7ee449dcd68698afdd62737fa07b73bbf1439..bfcf1b0825dcb57742b99d468be891524ff7825d 100755 (executable)
--- a/scm.mes
+++ b/scm.mes
        ,@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)))
 
         ((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)
         (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)