Support non-nested #| |# comment.

[mes.git] / module / mes / read-0.mes

diff --git a/module/mes/read-0.mes b/module/mes/read-0.mes
index 1e77ddd7f2cbdc96a0f6307501a17258d2f6a040..315548465c61f51a3dde9cd810650715768a0f5a 100644 (file)
--- a/module/mes/read-0.mes
+++ b/module/mes/read-0.mes
@@ -74,15 +74,21 @@
      ((eq? (peek-byte) 59) (begin (read-line-comment (read-byte))
                                   (eat-whitespace)))
      ((eq? (peek-byte) 35) (begin (read-byte)
-                                  (if (eq? (peek-byte) 33) (begin (read-byte)
-                                                                  (read-block-comment (read-byte))
-                                                                  (eat-whitespace))
-                                      (unread-byte 35))))))
-
-  (define (read-block-comment c)
-    (if (eq? c 33) (if (eq? (peek-byte) 35) (read-byte)
-                       (read-block-comment (read-byte)))
-        (read-block-comment (read-byte))))
+                                  (cond ((eq? (peek-byte) 33)
+                                         (read-byte)
+                                         (read-block-comment 33 (read-byte))
+                                         (eat-whitespace))
+                                        ((eq? (peek-byte) 124)
+                                         (read-byte)
+                                         (read-block-comment 124 (read-byte))
+                                         (eat-whitespace))
+                                        (#t (unread-byte 35)))
+))))
+
+  (define (read-block-comment s c)
+    (if (eq? c s) (if (eq? (peek-byte) 35) (read-byte)
+                      (read-block-comment s (read-byte)))
+        (read-block-comment s (read-byte))))
 
   ;; (define (read-hex c)
   ;;   (if (eq? c 10) c
@@ -116,8 +122,11 @@
                       (begin (unread-byte c) (lookup w a))))
       ((eq? c 35) (cond
                    ((eq? (peek-byte) 33) (begin (read-byte)
-                                                (read-block-comment (read-byte))
+                                                (read-block-comment 33 (read-byte))
                                                 (read-word (read-byte) w a)))
+                   ((eq? (peek-byte) 124) (begin (read-byte)
+                                                 (read-block-comment 124 (read-byte))
+                                                 (read-word (read-byte) w a)))
                    ((eq? (peek-byte) 40) (read-byte) (list->vector (read-list a)))
                    ((eq? (peek-byte) 92) (read-byte) (read-character))
                    ((eq? (peek-byte) 120) (read-byte) (read-hex))