diff --git a/docs/Scheme-Language-Compliance.md b/docs/Scheme-Language-Compliance.md index 82247215..7c602ac6 100644 --- a/docs/Scheme-Language-Compliance.md +++ b/docs/Scheme-Language-Compliance.md @@ -4,7 +4,7 @@ This is the status of Scheme programming language features implemented from the Section | Status | Comments ------- | ------ | --------- -2.2 Whitespace and comments | Partial | No datum or block comments +2.2 Whitespace and comments | Partial | No datum comments 2.3 Other notations | Yes | 2.4 Datum labels | No | 3.1 Variables, syntactic keywords, and regions | Yes | diff --git a/scheme/read.sld b/scheme/read.sld index 3ff73dff..0b9d00ae 100644 --- a/scheme/read.sld +++ b/scheme/read.sld @@ -302,6 +302,10 @@ (in-port:set-cnum! ptbl (+ 1 (in-port:get-cnum ptbl))) (cond + ;; Block comments + ((eq? #\| next-c) + (read-block-comment fp ptbl) + (parse fp '() toks all? #f parens ptbl)) ;; Booleans ;; Do not use add-tok below, no need to quote a bool ((eq? #\t next-c) @@ -473,6 +477,21 @@ (in-port:read-buf! ptbl) ;; Already buffered (read-char fp))) +;; Read chars in the middle of a block comment +(define (read-block-comment fp ptbl) + (let ((c (get-next-char fp ptbl))) + (cond + ((eq? #\| c) (read-block-terminator fp ptbl)) + (else (read-block-comment fp ptbl))))) + +;; Read (possibly) the end of a block comment +(define (read-block-terminator fp ptbl) + (let ((c (get-next-char fp ptbl))) + (cond + ((eq? #\# c) #t) + ((eq? #\| c) (read-block-terminator fp ptbl)) + (else (read-block-comment fp ptbl))))) + (define (parse-number fp toks all? parens ptbl base tok->num) ; (parse-number-rec base fp '() ptbl)) (let ((num (parse-number-rec base fp '() ptbl)))