diff --git a/read.scm b/read.scm index bb84f0c..66b3962 100644 --- a/read.scm +++ b/read.scm @@ -593,6 +593,13 @@ (port 'restore-mutable! mutable)) (readtable:next toplevel #f port))) +;;; ;;;;;;;;;;;;;;;;;;;;;;;; +;;; Handling hash messages +;;; +;;; A "hash message" is any identifier that immediately follows a "#". +;;; This can be a constant, a part of a constant (like for numbers), or +;;; a directive (like #!FOLD-CASE). + ;;; String map from constants to procedures with formal arguments ;;; (TOPLEVEL PORT) ;;; with TOPLEVEL being the current toplevel table and PORT being the @@ -600,7 +607,7 @@ ;;; ;;; Each one must return something. Directives that return nothing must ;;; call the toplevel again. -(define read:hash-constants +(define read:hash-messages (smap:insert-many '() (cons "true" (lambda unused #t)) @@ -619,21 +626,60 @@ (port 'fold-case! #f) (readtable:act toplevel (port 'read) #f port))))) -(define read:read-hash-constants +(define read:read-hash-messages (lambda (_ char acc port) (let ((ident (readtable:read-ident #f char #f port))) - (let ((container (smap:search read:hash-constants + (let ((container (smap:search read:hash-messages (ident 'value)))) + ;; TODO: check if the hash message starts a number. (if (null? container) - (error 'read-hash-constants 'unknown-constant + (error 'read-hash-messages 'unknown-constant (ident 'value)) ((map:val container) acc port)))))) +;;; ;;;;;;;;;;;;;;;;;;;;;; +;;; Characters +;;; +;;; For completeness, this adds a few more newline characters that are C +;;; escape sequences but are not standard Scheme. + +(define read:named-characters + (smap:insert-many + '() + (cons "null" (integer->char 0)) + (cons "alarm" (integer->char #x7)) + (cons "backspace" (integer->char #x8)) + (cons "tab" (integer->char #x9)) + (cons "newline" (integer->char #xA)) + (cons "vertical-tab" (integer->char #xB)) + (cons "form-feed" (integer->char #xC)) + (cons "return" (integer->char #xD)) + (cons "escape" (integer->char #x1B)) + (cons "space" (integer->char #x20)) + (cons "delete" (integer->char #x7F)))) + +(define readtable:character + (lambda (_ char __ port) + (let ((char (port 'read))) + (let ((ident (readtable:read-ident #f char #f port))) + (let ((container (smap:search read:named-characters + (ident 'value)))) + (display (ident 'value)) + (newline) + (cond + ((and (null? container) + (= (string-length (ident 'value)) 1)) + (string-ref (ident 'value) 0)) + ((null? container) (error 'character 'unknown-character ident)) + (else (map:val container)))))))) + (define readtable:hash (readtable:process - (readtable:empty/default read:read-hash-constants) + (readtable:empty/default read:read-hash-messages) + ;; TODO: add whitespace to fail (list readtable:update #\| (readtable:jump/next readtable:block-comment)) (list readtable:update #\; readtable:datum-comment) + (list readtable:update #\\ readtable:character) (list readtable:update-list readtable:digits ; Datum labels (lambda (_ char toplevel port) (readtable:act readtable:datum-label-next @@ -747,3 +793,4 @@ (read-all "#!no-fold-case #!fold-case #!NO-FOLD-CASE #false") (read-all "#!fold-case #TRUE") (read-all "#u8(x y z w)") +(read-all "#\\newline")