From 30a11632fb7fb245415620d72f9662660344d6ec Mon Sep 17 00:00:00 2001
From: marting <marting>
Date: Wed, 15 Sep 1999 01:03:43 +0000
Subject: [PATCH] inserted almost everything from scsh-read, except for the #!
 stuff

---
 scheme/rts/read.scm | 154 +++++++++++++++++++++++++++++++++++---------
 1 file changed, 125 insertions(+), 29 deletions(-)

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