diff --git a/read.scm b/read.scm index 7347d2b..7523b78 100644 --- a/read.scm +++ b/read.scm @@ -33,6 +33,7 @@ ;;; (READ): Read the next character in the stream. Returns #F on EOF. ;;; (PUSH CHAR): Push CHAR such that it will be the next character read ;;; when (READ) is called. +;;; (PEEK): Read character, push it back, and return it. ;;; (FOLD-CASE?): Returns a boolean if case folding is enabled. ;;; (FOLD-CASE! BOOL): Sets the case folding to BOOL. (define port->read @@ -65,6 +66,10 @@ (let ((ch (car pushback-buffer))) (set! pushback-buffer (cdr pushback-buffer)) ch)))) + ((eq? op 'peek) + (let ((ch (port 'read))) + (port 'push ch) + ch)) ((eq? op 'push) (let ((ch (car args))) (if (eqv? ch #\newline) @@ -159,6 +164,20 @@ (lambda (table char acc port) (readtable:act table (port 'read) acc port))) +;;; Discard char and return constant. +(define readtable:return + (lambda (return) + (lambda (table char acc port) + return))) + +;;; Jump to a new readtable, discard it's return, and continue reading +;;; in the table. +(define readtable:jump-discard + (lambda (newtable) + (lambda (oldtable char acc port) + (readtable:act newtable (port 'read) '() port) + (readtable:act oldtable (port 'read) acc port)))) + ;;; Push back CHAR and return ACC. (define readtable:return-acc-keep-char (lambda (table char acc port) @@ -212,11 +231,19 @@ table to-skip))) +;;; Readtable for a line comment. +(define readtable:read-to-newline + (readtable:process + (readtable:empty/default readtable:skip) + (list readtable:update #\newline (readtable:return #f)))) + ;;; Toplevel reader. (define readtable:top (readtable:process (readtable:empty/default readtable:read-ident) - (list readtable:add-all-as-skip readtable:ASCII-whitespace))) + (list readtable:add-all-as-skip readtable:ASCII-whitespace) + (list readtable:update #\; + (readtable:jump-discard readtable:read-to-newline)))) ;;; ;;;;;;;;;;; ;;; Test reader @@ -232,13 +259,22 @@ ch))) "test"))) -(let ((true-reader (%list->read (string->list "xyzw abcd x!")))) - (display (list "first:" (readtable:act - readtable:top (true-reader 'read) #f true-reader))) - (newline) - (display (list "second: " (readtable:act - readtable:top (true-reader 'read) #f true-reader))) - (newline) - (display (list "third: " (readtable:act - readtable:top (true-reader 'read) #f true-reader))) - (newline)) +(define read-all + (lambda (str) + (let ((reader (%list->read (string->list str)))) + (letrec ((loop + (lambda () + (if (not (reader 'peek)) + #t + (let ((value (readtable:act + readtable:top (reader 'read) + #f + reader))) + (display (list "return" value)) + (newline) + (loop)))))) + (loop))))) + +(read-all "x yy zz ; this is a comment\nx") + +