inserted almost everything from scsh-read, except for the #! stuff
This commit is contained in:
marting
parent
d050b89038
commit
30a11632fb
|
|
@ -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
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue