1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 04:10:18 +02:00

repl.scm understands comments

* module/system/repl/repl.scm (read-comment, read-scheme-line-comment)
  (read-scheme-datum-comment): New helpers.
  (meta-reader): Take a language instead of a reader.  If we have a
  nonwhitespace char, first check to see that it's a comment, and if so,
  read it off and loop.
  (prompting-meta-read): Call meta-reader with the lang.
This commit is contained in:
Andy Wingo 2011-03-03 23:51:20 +01:00
parent 859e58ae8a
commit 65fa60ca7a

View file

@ -31,6 +31,48 @@
#:use-module (ice-9 control)
#:export (start-repl run-repl))
;;;
;;; Comments
;;;
;;; (You don't want a comment to force a continuation line.)
;;;
(define (read-scheme-line-comment port)
(let lp ()
(let ((ch (read-char port)))
(or (eof-object? ch)
(eqv? ch #\newline)
(lp)))))
(define (read-scheme-datum-comment port)
(read port))
;; ch is a peeked char
(define (read-comment lang port ch)
(and (eq? (language-name lang) 'scheme)
(case ch
((#\;)
(read-char port)
(read-scheme-line-comment port)
#t)
((#\#)
(read-char port)
(case (peek-char port)
((#\;)
(read-char port)
(read-scheme-datum-comment port)
#t)
;; Not doing R6RS block comments because of the possibility
;; of read-hash extensions. Lame excuse. Not doing scsh
;; block comments either, because I don't feel like handling
;; #!r6rs.
(else
(unread-char #\# port)
#f)))
(else
#f))))
;;;
@ -39,7 +81,7 @@
(define meta-command-token (cons 'meta 'command))
(define (meta-reader read env)
(define (meta-reader lang env)
(lambda* (#:optional (port (current-input-port)))
(with-input-from-port port
(lambda ()
@ -52,7 +94,9 @@
((eqv? ch #\,)
(read-char port)
meta-command-token)
(else (read port env))))))))
((read-comment lang port ch)
*unspecified*)
(else ((language-reader lang) port env))))))))
(define (flush-all-input)
(if (and (char-ready?)
@ -70,8 +114,7 @@
(catch #t
(lambda ()
(repl-reader (lambda () (repl-prompt repl))
(meta-reader (language-reader (repl-language repl))
(current-module))))
(meta-reader (repl-language repl) (current-module))))
(lambda (key . args)
(case key
((quit)
@ -116,7 +159,7 @@
(let prompt-loop ()
(let ((exp (prompting-meta-read repl)))
(cond
((eqv? exp *unspecified*)) ; read error, pass
((eqv? exp *unspecified*)) ; read error or comment, pass
((eq? exp meta-command-token)
(catch #t
(lambda ()