diff --git a/scheme/rts/read.scm b/scheme/rts/read.scm index 40bf59b..af198dd 100644 --- a/scheme/rts/read.scm +++ b/scheme/rts/read.scm @@ -14,6 +14,11 @@ ; (define (make-immutable! x) x) ; signal (only for use by reading-error; easily excised) +;scsh start + +(define preferred-case (lambda (x) x)) + +; scsh stop (define (read . port-option) (let ((port (input-port-option port-option))) @@ -138,27 +143,27 @@ (list keyword (sub-read-carefully port))))) -(set-standard-read-macro! #\" #t - (lambda (c port) - c ;ignored - (let loop ((l '()) (i 0)) - (let ((c (read-char port))) - (cond ((eof-object? c) - (reading-error port "end of file within a string")) - ((char=? c #\\) - (let ((c (read-char port))) - (cond ((eof-object? c) - (reading-error port "end of file within a string")) - ((or (char=? c #\\) (char=? c #\")) - (loop (cons c l) (+ i 1))) - (else - (reading-error port - "invalid escaped character in string" - c))))) - ((char=? c #\") - (reverse-list->string l i)) - (else - (loop (cons c l) (+ i 1)))))))) +;(set-standard-read-macro! #\" #t +; (lambda (c port) +; c ;ignored +; (let loop ((l '()) (i 0)) +; (let ((c (read-char port))) +; (cond ((eof-object? c) +; (reading-error port "end of file within a string")) +; ((char=? c #\\) +; (let ((c (read-char port))) +; (cond ((eof-object? c) +; (reading-error port "end of file within a string")) +; ((or (char=? c #\\) (char=? c #\")) +; (loop (cons c l) (+ i 1))) +; (else +; (reading-error port +; "invalid escaped character in string" +; c))))) +; ((char=? c #\") +; (reverse-list->string l i)) +; (else +; (loop (cons c l) (+ i 1)))))))) (set-standard-read-macro! #\; #t (lambda (c port) @@ -242,18 +247,109 @@ (loop (cons (preferred-case c) l) (+ n 1))))))) +;(define (parse-token string port) +; (if (let ((c (string-ref string 0))) +; (or (char-numeric? c) (char=? c #\+) (char=? c #\-) (char=? c #\.))) +; (cond ((string->number string)) +; ((member string strange-symbol-names) +; (string->symbol (make-immutable! string))) +; ((string=? string ".") +; dot) +; (else +; (reading-error port "unsupported number syntax" string))) +; (string->symbol (make-immutable! string)))) + +; scsh start (define (parse-token string port) (if (let ((c (string-ref string 0))) (or (char-numeric? c) (char=? c #\+) (char=? c #\-) (char=? c #\.))) (cond ((string->number string)) - ((member string strange-symbol-names) - (string->symbol (make-immutable! string))) - ((string=? string ".") - dot) - (else - (reading-error port "unsupported number syntax" string))) + ((string=? string ".") dot) + (else (string->symbol (make-immutable! string)))) (string->symbol (make-immutable! string)))) +(set-standard-syntax! #\| #f + (lambda (c port) + (parse-token (sub-read-token c port) port))) + + + +(define bel (ascii->char 7)) +(define bs (ascii->char 8)) +(define ff (ascii->char 12)) +(define cr (ascii->char 13)) +(define ht (ascii->char 9)) +(define vt (ascii->char 11)) + +;;; Full ANSI C strings: +;;; - read as themselves: \\ \? \" \' +;;; - control chars: +;;; \a alert (bell -- ^g) +;;; \b backspace (^h) +;;; \f form feed (^l) +;;; \n newline (^j) +;;; \r carriage return (^m) +;;; \t tab (^i) +;;; \v vertical tab (^k) +;;; - octal escapes \nnn +;;; - hex escapes \xnn + +;;; Is this the elegant thing to do? Too much might make it hard to shift +;;; to Unicode implementations. How about \^g for embedding control chars? +;;; And I haven't done anything about chars (as opposed to strings). + +(set-standard-read-macro! #\" #t + (lambda (c port) + c ;ignored + (let* ((readc (lambda () + (let ((c (read-char port))) + (if (eof-object? c) + (reading-error port "end of file within a string") + c)))) + (read-digit (lambda (base base-name) + (let* ((c (readc)) + (d (- (char->ascii c) (char->ascii #\0)))) + (if (and (<= 0 d) (< d base)) d + (reading-error port + (string-append "invalid " + base-name + " code in string.") + d)))))) + + (let loop ((l '()) (i 0)) + (let ((c (readc))) + (cond ((char=? c #\\) + (let* ((c (readc)) + (rc (case c + ((#\\ #\" #\? #\') c) + ((#\a) bel) + ((#\b) bs) + ((#\f) ff) + ((#\n) #\newline) + ((#\r) cr) + ((#\t) ht) + ((#\v) vt) + ((#\0 #\1 #\2 #\3) + (let* ((d1 (- (char->ascii c) (char->ascii #\0))) + (d2 (read-digit 8 "octal")) + (d3 (read-digit 8 "octal"))) + (ascii->char (+ (* 64 d1) (+ (* 8 d2) d3))))) + ((#\x) + (let ((d1 (read-digit 16 "hex")) + (d2 (read-digit 16 "hex"))) + (ascii->char (+ (* 16 d1) d2)))) + (else + (reading-error port + "invalid escapedcharacter in string" + c))))) + (loop (cons rc l) (+ i 1)))) + ((char=? c #\") + (reverse-list->string l i)) + (else + (loop (cons c l) (+ i 1))))))))) + +;scsh stop + (define strange-symbol-names '("+" "-" "..." "1+" "-1+" ;Only for S&ICP support @@ -276,8 +372,8 @@ ((>= i ascii-limit)) (string-set! p-c-v i (p-c (ascii->char i))))) -(define (preferred-case c) - (string-ref p-c-v (char->ascii c))) +;(define (preferred-case c) +; (string-ref p-c-v (char->ascii c))) ; Reader errors