|Quotify| surrounds its string argument with the separator (a character),
replacing all occurences of `|||' by `|
|' and all occurences of the
separator itself by `|||separator'.
|Specchars| is an association list giving the printed representation of a few special characters. It is used by |write|.
|Strange?| returns whether its argument requires quotification. Strings are always quotified, but atoms will be quotified only if they contain weird characters, are `|.|', or generally speaking would not evaluate to a symbol if re-read unquoted.
|Put-list| prints the tail of a list (the heading `|(|' is printed by the main routine). Note that this code does not check whether the list is circular.
|Delimby| is used for input and can be understood as reversing the action of a |Quotify|: it reads characters until it reaches a specified separator.
|Get-symbol| will return the next symbol from the input (unquoted:
surrounded neither by `"
' nor by `||
')
|Get-number| and |Get-number-prefixed| help reading a number prefixed by `|#|': |Get-number| is called before the `|#|' occured, but when we already know we're dealing with a number. |Get-number-prefixed| is called when the sharp has been read, and we want to interpret the following character. In this version, inexact and exact numbers are handled likewise.
(letrec ((quotify (lambda (string separator)
(define (s l)
(cond ((null? l) (list separator))
((or (equal? (car l) separator)
(equal? (car l) #
))
(cons #
(cons (car l) (s (cdr l)))))
(else (cons (car l) (s (cdr l))))))
(list->string (cons separator (s (string->list string))))))
(specchars '((# . "#
SPACE")
(#. "#
ESCAPE")
(#. "#
TAB")
(#
. "#
NEWLINE")
(#. "#
PAGE")
(#. "#
RETURN")))
(strange? (lambda (s)
(or (string->number s)
(string-null? s)
(equal? s ".")
(equal? (substring (string-append s " ") 0 2) "#
")
(do ((l (string->list s) (cdr l)))
((or (null? l)
(not (char=? (car l) (char-upcase (car l))))
(member (car l) (list* #|| # ##́ ##̈ ## ##̀
(map car specchars))))
(not (null? l)))))))
(put-list (lambda (l printer output)
(cond ((null? l) (((atom? l) ((printer l output) ((else (printer (car l) output)
(if (pair? (cdr l)) ((put-list (cdr l) printer output)))))
(get-char (lambda (input)
(let ((ch (@read-char input)))
(cond ((char-whitespace? ch) (get-char input))
((equal? ch # ) (begin (@read-line input)
(get-char input)))
(else ch)))))
(delimby (lambda (ch input)
(let ((in (@read-char input)))
(cond ((@eof-object? in) (error "Unmatched " ch))
((equal? in #
)
(let ((next (@read-char input)))
(if (@eof-object? next)
(error "Escaped void")
(cons next (delimby ch input)))))
((equal? ch in) ())
(else (cons in (delimby ch input)))))))
(list->symbol (lambda (l)
(string->symbol (list->string l))))
(get-symbol (lambda (input)
(let ((first (@read-char input)))
(cond ((@eof-object? first) '())
((char-whitespace? first) '())
((member first '(## ##́#̀
# ##̈|| #
(set! @read read) (set! @read-atom (lambda port (let* ((input (if (null? port) (current-input-port) (car port))) (first (get-char input))) (case first ((#