From 95d913097d1851131717de73c3a870cd45e55d2c Mon Sep 17 00:00:00 2001
From: Jan Nieuwenhuizen <janneke@gnu.org>
Date: Sun, 18 Dec 2016 10:11:22 +0100
Subject: [PATCH] Support non-nested #| |# comment.

* module/mes/read-0.mes (read-word, read-block-comment): Implement #|.
* reader.c (read_word, read_block_comment)[READER]: Likewise.
* tests/read.test: Test it.
* NEWS: Mention it.
---
 NEWS                  |  1 +
 module/mes/read-0.mes | 27 ++++++++++++++++++---------
 reader.c              | 10 +++++-----
 tests/read.test       |  3 +++
 4 files changed, 27 insertions(+), 14 deletions(-)

diff --git a/NEWS b/NEWS
index 6f191f11..0495be8f 100644
--- a/NEWS
+++ b/NEWS
@@ -21,6 +21,7 @@ block-comments are all handled by the Scheme reader later.
 *** Cond now supports =>.
 *** Lambda* and define* are now supported.
 *** #;-comment is now supported.
+*** Non-nested #| |#-comment is now supported.
 * Changes in 0.3 since 0.2
 ** Core
 *** Number-based rather than pointer-based cells.
diff --git a/module/mes/read-0.mes b/module/mes/read-0.mes
index 1e77ddd7..31554846 100644
--- 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))))))
+                                  (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 c)
-    (if (eq? c 33) (if (eq? (peek-byte) 35) (read-byte)
-                       (read-block-comment (read-byte)))
-        (read-block-comment (read-byte))))
+  (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))
diff --git a/reader.c b/reader.c
index 6698061c..30cd8b08 100644
--- a/reader.c
+++ b/reader.c
@@ -37,10 +37,10 @@ unread_char (SCM c)
 }
 
 int
-read_block_comment (int c)
+read_block_comment (int s, int c)
 {
-  if (c == '!' && peekchar () == '#') return getchar ();
-  return read_block_comment (getchar ());
+  if (c == s && peekchar () == '#') return getchar ();
+  return read_block_comment (s, getchar ());
 }
 
 int
@@ -95,7 +95,7 @@ read_word (int c, SCM w, SCM a)
   if (c == '#' && peekchar () == '\\') {getchar (); return read_character ();}
   if (c == '#' && w == cell_nil && peekchar () == '(') {getchar (); return list_to_vector (read_list (a));}
   if (c == '#' && peekchar () == ';') {getchar (); read_word (getchar (), w, a); return read_word (getchar (), w, a);}
-  if (c == '#' && peekchar () == '!') {getchar (); read_block_comment (getchar ()); return read_word (getchar (), w, a);}
+  if (c == '#' && (peekchar () == '!' || peekchar () == '|')) {c = getchar (); read_block_comment (c, getchar ()); return read_word (getchar (), w, a);}
 #endif //READER
   return read_word (getchar (), append2 (w, cons (make_char (c), cell_nil)), a);
 }
@@ -183,7 +183,7 @@ eat_whitespace (int c)
   while (c == ' ' || c == '\t' || c == '\n' || c == '\f') c = getchar ();
   if (c == ';') return eat_whitespace (read_line_comment (c));
 #if READER
-  if (c == '#' && peekchar () == '!') {getchar (); read_block_comment (getchar ()); return eat_whitespace (getchar ());}
+  if (c == '#' && (peekchar () == '!' || peek_char () == '|')) {c=getchar (); read_block_comment (c, getchar ()); return eat_whitespace (getchar ());}
 #endif
   return c;
 }
diff --git a/tests/read.test b/tests/read.test
index 3ebfe31d..5c9305a1 100755
--- a/tests/read.test
+++ b/tests/read.test
@@ -32,6 +32,9 @@ cons
 #!
 barf
 !#
+#|
+burp
+|#
 #;(bla) (display "must see!\n")
 (display `(display ,display)) (newline)
 (display `(display ,@'(string port))) (newline)