(read) added!

i.c

@@ -1143,6 +1143,14 @@ define_instruction(ssub) {
   gonexti();
 }
 
+define_instruction(spos) {
+  obj x = ac, y = spop(); char *s, *p;
+  ckc(x); cks(y);
+  s = stringchars(y), p = strchr(s, char_from_obj(x));
+  ac = p ? fixnum_obj(p-s) : bool_obj(0);
+  gonexti();
+}
+
 
 define_instruction(bvecp) {
   ac = bool_obj(isbytevector(ac));

i.h

@@ -403,6 +403,7 @@ declare_instruction(sget,       "S4",           0,  "string-ref",          '2',
 declare_instruction(sput,       "S5",           0,  "string-set!",         '3', AUTOGL)
 declare_instruction(scat,       "S6",           0,  "string-cat",          '2', AUTOGL)
 declare_instruction(ssub,       "S7",           0,  "substring",           '3', AUTOGL)
+declare_instruction(spos,       "S8",           0,  "string-position",     '2', AUTOGL)
 declare_instruction(seq,        "S=",           0,  "string=?",            'c', AUTOGL)
 declare_instruction(slt,        "S<",           0,  "string<?",            'c', AUTOGL)
 declare_instruction(sgt,        "S>",           0,  "string>?",            'c', AUTOGL)

s.c

@@ -539,5 +539,132 @@ char *s_code[] = {
   "&0{%2.1,.1,@(y14:read-substring)[22}%x,&0{%1P10,.1,@(y14:read-substrin"
   "g)[12}%x,&2{|10|21%%}@!(y11:read-string)",
 
+  "P", "%read",
+  "%2,,,,,,,,,,,,,,,,,,,,,,#0#1#2#3#4#5#6#7#8#9#(i10)#(i11)#(i12)#(i13)#("
+  "i14)#(i15)#(i16)#(i17)#(i18)#(i19)#(i20)#(i21)n.!0&0{%1.0,&1{%0:0z]0}]"
+  "1}.!1&0{%1.0K0]1}.!2.3,&1{%1.0K0?{${.2[00},:0^[11}.0]1}.!3.4,.4,&2{%1."
+  "0p?{.0aK0?{${.2a,:0^[01},.1sa}{${.2a,:1^[01}}.0dK0?{${.2d,:0^[01},.1sd"
+  "]1}.0d,:1^[11}.0V0?{'0,,#0.2,:0,:1,.3,&4{%1:3V3,.1I<?{.0,:3V4,.0K0?{${"
+  ".2,:2^[01},.2,:3V5}{${.2,:1^[01}}_1'1,.1I+,:0^[11}]1}.!0.0^_1[11}.0Y2?"
+  "{.0zK0?{${.2z,:1^[01},.1sz]1}.0z,:1^[11}f]1}.!4.4,&1{%1${.2,:0^[01}.0]"
+  "1}.!5f.!6f.!7f.!8f.!9'(y12:reader-token),l1,.0.!7'(s17:right parenthes"
+  "is),.1c.!8'(s13:right bracket),.1c.!9'(s5:%22 . %22),.1c.!(i10)_1.6,&1"
+  "{%1.0p?{:0^,.1aq]1}f]1}.!(i10)&0{%1'(s80:ABCDEFGHIJKLMNOPQRSTUVWXYZabc"
+  "defghijklmnopqrstuvwxyz!$%25&*/:<=>?^_~0123456789+-.@),.1S8]1}.!(i11)&"
+  "0{%1.0X8,'(i48),.1<!?{'(i57),.1>!}{f},.0?{.0]3}'(i65),.2<!?{'(i70),.2>"
+  "!}{f},.0?{.0]4}'(i97),.3<!?{'(i102),.3>!]4}f]4}.!(i12)&0{%1.0C1,.0?{.0"
+  "]2}'(c)),.2C=,.0?{.0]3}'(c(),.3C=,.0?{.0]4}'(c]),.4C=,.0?{.0]5}'(c[),."
+  "5C=,.0?{.0]6}'(c%22),.6C=,.0?{.0]7}'(c;),.7C=]7}.!(i13).(i15),.(i11),&"
+  "2{%1${.2,:1^[01},.0R8?{.1,'(y5:port:),'(s22:unexpected end of file),@("
+  "y10:read-error)[23}${.2,:0^[01}?{.1,'(y5:port:),.2d,'(s17:unexpected t"
+  "oken:),@(y10:read-error)[24}.0]2}.!(i14).8,.(i12),.(i20),.(i24),.(i19)"
+  ",.(i12),.(i22),.(i24),.(i27),.(i22),.(i12),.(i25),.(i13),.(i13),.(i37)"
+  ",&(i15){%1.0R0,.0R8?{.0]2}.0C1?{.1,:(i10)^[21}'(c(),.1C=?{t,:9^,.3,.3,"
+  ":8^[24}'(c)),.1C=?{:9^]2}'(c[),.1C=?{t,:(i14)^,.3,.3,:8^[24}'(c]),.1C="
+  "?{:(i14)^]2}'(c'),.1C=?{${.3,:3^[01},'(y5:quote),l2]2}'(c`),.1C=?{${.3"
+  ",:3^[01},'(y10:quasiquote),l2]2}${.2,:(i13)^[01}?{.1,.1,:(i11)^[22}'(c"
+  ";),.1C=?{${.3R0,,#0.5,.1,&2{%1.0R8,.0?{.0]2}'(c%0a),.2C=,.0?{.0]3}:1R0"
+  ",:0^[31}.!0.0^_1[01}.1,:(i10)^[21}'(c,),.1C=?{.1R1,.0R8?{.2,'(y5:port:"
+  "),'(s19:end of file after ,),@(y10:read-error)[33}'(c@),.1C=?{.2R0${.4"
+  ",:3^[01},'(y16:unquote-splicing),l2]3}${.4,:3^[01},'(y7:unquote),l2]3}"
+  "'(c%22),.1C=?{n,,#0.3,:(i12),.2,&3{%1:2R0,.0R8?{:2,'(y5:port:),'(s27:e"
+  "nd of file within a string),@(y10:read-error)[23}'(c%5c),.1C=?{${'(y6:"
+  "string),:2,:1^[02},.0?{.2,.1c}{.2},:0^[31}'(c%22),.1C=?{.1A9X3]2}.1,.1"
+  "c,:0^[21}.!0.0^_1[21}'(c|),.1C=?{n,,#0.3,:(i12),.2,&3{%1:2R0,.0R8?{:2,"
+  "'(y5:port:),'(s29:end of file within a |symbol|),@(y10:read-error)[23}"
+  "'(c%5c),.1C=?{${'(y6:symbol),:2,:1^[02},.0?{.2,.1c}{.2},:0^[31}'(c|),."
+  "1C=?{.1A9X3X5]2}.1,.1c,:0^[21}.!0.0^_1[21}'(c#),.1C=?{.1R1,.0R8?{.2,'("
+  "y5:port:),'(s19:end of file after #),@(y10:read-error)[33}'(ct),.1Ci=,"
+  ".0?{.0}{'(cf),.2Ci=}_1?{${.4,:3^[01},.0,'(l2:y1:t;y4:true;),.1A1?{t]5}"
+  "'(l2:y1:f;y5:false;),.1A1?{f]5}.4,'(y5:port:),.3,'(s23:unexpected name"
+  " after #),@(y10:read-error)[54}'(cb),.1Ci=,.0?{.0}{'(co),.2Ci=,.0?{.0}"
+  "{'(cd),.3Ci=,.0?{.0}{'(cx),.4Ci=,.0?{.0}{'(ci),.5Ci=,.0?{.0}{'(ce),.6C"
+  "i=}_1}_1}_1}_1}_1?{.2,'(c#),:(i11)^[32}'(c&),.1C=?{.2R0${.4,:3^[01}b]3"
+  "}'(c;),.1C=?{.2R0${.4,:3^[01}.2,:(i10)^[31}'(c|),.1C=?{.2R0${,#0.5,.1,"
+  "&2{%0:1R0,.0R8?{:1,'(y5:port:),'(s25:end of file in #| comment),@(y10:"
+  "read-error)[13}'(c|),.1C=?{:1R1,.0R8?{:1,'(y5:port:),'(s25:end of file"
+  " in #| comment),@(y10:read-error)[23}'(c#),.1C=?{:1R0]2}:0^[20}'(c#),."
+  "1C=?{:1R1,.0R8?{:1,'(y5:port:),'(s25:end of file in #| comment),@(y10:"
+  "read-error)[23}'(c|),.1C=?{:1R0${:0^[00}:0^[20}:0^[20}:0^[10}.!0.0^_1["
+  "00}.2,:(i10)^[31}'(c(),.1C=?{.2R0${f,:9^,.6,.5,:8^[04}X1]3}'(cu),.1C=?"
+  "{.2R0'(c8),.3R0q?{'(c(),.3R0q}{f}?{${.4,:7^[01}E1]3}.2,'(y5:port:),'(s"
+  "25:invalid bytevector syntax),@(y10:read-error)[33}'(c%5c),.1C=?{.2R0."
+  "2R1,.0R8?{.3,'(y5:port:),'(s20:end of file after #%5c),@(y10:read-erro"
+  "r)[43}.0,'(cx)C=?{.3R0${.5R1,:5^[01}?{.0]4}f,.4,:6^[42}.0C4?{${.5,:3^["
+  "01},'1,.1X4S3=?{.1]5}.0,'(y4:null),.1v?{'0X9]6}'(y5:space),.1v?{'(c )]"
+  "6}'(y5:alarm),.1v?{'(c%07)]6}'(y9:backspace),.1v?{'(c%08)]6}'(y6:delet"
+  "e),.1v?{'(i127)X9]6}'(y6:escape),.1v?{'(i27)X9]6}'(y3:tab),.1v?{'(c%09"
+  ")]6}'(l2:y7:newline;y8:linefeed;),.1A1?{'(c%0a)]6}'(y4:vtab),.1v?{'(c%"
+  "0b)]6}'(y4:page),.1v?{'(c%0c)]6}'(y6:return),.1v?{'(c%0d)]6}.5,'(y5:po"
+  "rt:),.3,'(s15:unknown #%5c name),@(y10:read-error)[64}.3R0.0]4}.0C5?{:"
+  "0?{${.4,'(y5:port:),'(s44:#N=/#N# notation is not allowed in this mode"
+  "),@(y10:read-error)[03}}n,,#0.4,.1,:4,:3,:2,:1,&6{%1:5R0,.0R8?{:5,'(y5"
+  ":port:),'(s32:end of file within a #N notation),@(y10:read-error)[23}."
+  "0C5?{.1,.1c,:4^[21}'(c#),.1C=?{.1A9X3,'(i10),.1E9,.0I0?{:0^,.1A3}{f},."
+  "0?{.0d]5}'(s22:unknown #n# reference:),'(y5:port:),.4,@(y10:read-error"
+  ")[53}'(c=),.1C=?{.1A9X3,'(i10),.1E9,.0I0~?{${'(s22:invalid #n= referen"
+  "ce:),'(y5:port:),.5,@(y10:read-error)[03}}{:0^,.1A3?{${'(s18:duplicate"
+  " #n= tag:),'(y5:port:),.4,@(y10:read-error)[03}}{f}}fb,:0^,${.3,:1^[01"
+  "},.3cc:!0${:5,:2^[01},${.2,:3^[01}?{'(s31:#n= has another label as tar"
+  "get),'(y5:port:),.5,@(y10:read-error)[63}.0,.2sz.0]6}:5,'(y5:port:),'("
+  "s34:invalid terminator for #N notation),@(y10:read-error)[23}.!0.0^_1["
+  "31}.2,'(y5:port:),.2,'(s16:unknown # syntax),@(y10:read-error)[34}.1,'"
+  "(y5:port:),.2,'(s22:illegal character read),@(y10:read-error)[24}.!(i1"
+  "5).(i15),.(i11),.(i16),.(i12),&4{%4${.3,:3^[01},:0^,.1q?{.2,'(y5:port:"
+  "),'(s42:missing car -- ( immediately followed by .),@(y10:read-error)["
+  "53}.0,,#0.0,.5,:3,:2,.(i10),:1,.(i11),:0,&8{%1.0R8?{:6,'(y5:port:),'(s"
+  "41:eof inside list -- unbalanced parentheses),@(y10:read-error)[13}:1,"
+  ".1q?{n]1}:0^,.1q?{:3?{${:6,:2^[01},${:6,:5^[01},:1,.1q?{.1]3}:6,'(y5:p"
+  "ort:),.2,'(s31:randomness after form after dot),@(y10:read-error)[34}:"
+  "6,'(y5:port:),'(s13:dot in #(...)),@(y10:read-error)[13}${.2,:4^[01}?{"
+  ":6,'(y5:port:),.2d,'(s20:error inside list --),@(y10:read-error)[14}${"
+  "${:6,:5^[01},:7^[01},.1c]1}.!0.0^_1[51}.!(i16).(i15),.8,.(i12),&3{%1${"
+  ".2,:2^[01},,#0.0,.3,:2,:0,:1,&5{%1.0R8?{:3,'(y5:port:),'(s21:eof insid"
+  "e bytevector),@(y10:read-error)[13}:0^,.1q?{n]1}${.2,:1^[01}?{:3,'(y5:"
+  "port:),.2d,'(s26:error inside bytevector --),@(y10:read-error)[14}.0I0"
+  "~,.0?{.0}{'0,.2I<,.0?{.0}{'(i255),.3I>}_1}_1?{:3,'(y5:port:),.2,'(s33:"
+  "invalid byte inside bytevector --),@(y10:read-error)[14}${${:3,:2^[01}"
+  ",:4^[01},.1c]1}.!0.0^_1[11}.!(i17).(i19),&1{%2.0R0,.0R8?{${.3,'(y5:por"
+  "t:),.6,'(s20:end of file within a),@(y10:read-error)[04}}'(c%5c),.1C=,"
+  ".0?{.0}{'(c%22),.2C=,.0?{.0}{'(c|),.3C=}_1}_1?{.0]3}'(ca),.1C=?{'(c%07"
+  ")]3}'(cb),.1C=?{'(c%08)]3}'(ct),.1C=?{'(c%09)]3}'(cn),.1C=?{'(c%0a)]3}"
+  "'(cv),.1C=?{'(c%0b)]3}'(cf),.1C=?{'(c%0c)]3}'(cr),.1C=?{'(c%0d)]3}'(cx"
+  "),.1C=?{t,.2,:0^[32}'(y6:string),.3q?{.0C1}{f}?{.1R1,'(c%0a),.2C=,,#0."
+  "0,.5,&2{%2.1R8,.0?{.0}{.2C1~}_1?{.0?{f]2}:0,'(y5:port:),'(s32:no newli"
+  "ne in line ending escape),@(y10:read-error)[23}.0?{'(c%0a),.2C=}{f}?{f"
+  "]2}:0R0:0R1,.1,.0?{.0}{'(c%0a),.4C=}_1,:1^[22}.!0.0^_1[32}.1,'(y5:port"
+  ":),.2,'(y1::),.6,'(s22:invalid char escape in),@(y10:read-error)[36}.!"
+  "(i18).(i13),.(i13),&2{%2,#0.1,&1{%1.0u?{:0,'(y5:port:),'(s31:%5cx esca"
+  "pe sequence is too short),@(y10:read-error)[13}'(i16),.1A9X3X7X9]1}.!0"
+  "'0,n,.3R1,,#0.0,.6,:0,.7,.(i10),:1,&6{%3.0R8?{:1?{:4,'(y5:port:),'(s27"
+  ":end of file within a string),@(y10:read-error)[33}.1,:2^[31}:1?{'(c;)"
+  ",.1C=}{f}?{:4R0.1,:2^[31}:1~?{${.2,:0^[01}}{f}?{.1,:2^[31}${.2,:3^[01}"
+  "~?{:4,'(y5:port:),.2,'(s37:unexpected char in %5cx escape sequence),@("
+  "y10:read-error)[34}'2,.3>?{:4,'(y5:port:),'(s30:%5cx escape sequence i"
+  "s too long),@(y10:read-error)[33}:4R0'1,.3+,.2,.2c,:4R1,:5^[33}.!0.0^_"
+  "1[33}.!(i19)&0{%4.0,.0?{.0}{.2C5}_1?{f]4}'(s2:+i),.4Si=,.0?{.0}{'(s2:-"
+  "i),.5Si=}_1?{f]4}'(s6:+nan.0),.4Si=,.0?{.0}{'(s6:-nan.0),.5Si=}_1?{f]4"
+  "}'(s6:+inf.0),.4Si=,.0?{.0}{'(s6:-inf.0),.5Si=}_1?{f]4}'(c+),.2C=,.0?{"
+  ".0}{'(c-),.3C=}_1?{.2du?{t]4}'(c.),.3daC=?{.2ddp?{.2ddaC5~]4}f]4}.2daC"
+  "5~]4}'(c.),.2C=?{.2dp?{.2daC5~]4}f]4}f]4}.!(i20).(i13),.(i21),.(i11),."
+  "(i14),&4{%2'(c#),.1C=,.1,l1,.3R1,,#0.5,.1,:0,:1,:2,:3,&6{%3.0R8,.0?{.0"
+  "}{${.3,:0^[01}}_1?{.1A9,.0a,.1X3,.5,.0?{.0}{.2C5,.0?{.0}{'(c+),.4C=,.0"
+  "?{.0}{'(c-),.5C=,.0?{.0}{'(c.),.6C=}_1}_1}_1}_1?{'(s1:.),.1S=?{:2^]6}$"
+  "{.2,.5,.5,.(i10),:1^[04}?{.0X5]6}'(i10),.1E9,.0?{.0]7}:5,'(y5:port:),."
+  "3,'(s54:unsupported number syntax (implementation restriction)),@(y10:"
+  "read-error)[74}.0X5]6}'(c#),.1C=?{:5R0t,.2,.2c,:5R1,:4^[33}${.2,:3^[01"
+  "}?{:5R0.2,.2,.2c,:5R1,:4^[33}:5,'(y5:port:),.2,'(s29:unexpected number"
+  "/symbol char),@(y10:read-error)[34}.!0.0^_1[23}.!(i21)${.(i24),.(i18)^"
+  "[01},${.2,.(i14)^[01}~?{.1^u?{.0](i25)}.0,.7^[(i25)1}.(i23),'(y5:port:"
+  "),.2d,'(s17:unexpected token:),@(y10:read-error)[(i25)4",
+
+  "C", 0,
+  "&0{%1f,.1,@(y5:%25read)[12}%x,&0{%0f,P10,@(y5:%25read)[02}%x,&2{|00|11"
+  "%%}@!(y4:read)",
+
+  "C", 0,
+  "&0{%1t,.1,@(y5:%25read)[12}%x,&0{%0t,P10,@(y5:%25read)[02}%x,&2{|00|11"
+  "%%}@!(y11:read-simple)",
+
   0, 0, 0
 };

src/s.scm

@@ -612,6 +612,7 @@
 ; (%string->list1 s) + 
 ; (string-cat s1 s2) +
 ; (substring s from to)
+; (string-position s c) +
 ; (string-cmp s1 s2) +
 ; (string=? s1 s2 s ...)
 ; (string<? s1 s2 s ...)
@@ -1121,8 +1122,6 @@
               [(char=? c #\return) (loop #f)]
               [else (write-char c op) (loop #f)]))))) 
 
-;read
-
 (define (read-substring! str start end p)
   (let loop ([i start])
     (if (fx>=? i end) (fx- i start)
@@ -1154,6 +1153,342 @@
 ;read-bytevector
 ;read-bytevector!
 
+(define (%read port simple?)
+  (define-syntax r-error
+    (syntax-rules () [(_ p msg a ...) (read-error msg a ... 'port: p)])) ; see read-error below
+
+  (define shared '())
+  (define (make-shared-ref loc) (lambda () (unbox loc)))
+  (define (shared-ref? form) (procedure? form))
+  (define (patch-ref! form) (if (procedure? form) (patch-ref! (form)) form))
+  (define (patch-shared! form)
+    (cond [(pair? form)
+           (if (procedure? (car form)) 
+               (set-car! form (patch-ref! (car form)))
+               (patch-shared! (car form)))
+           (if (procedure? (cdr form)) 
+               (set-cdr! form (patch-ref! (cdr form)))
+               (patch-shared! (cdr form)))]
+          [(vector? form)
+           (let loop ([i 0])
+             (when (fx<? i (vector-length form))
+               (let ([fi (vector-ref form i)])
+                 (if (procedure? fi) 
+                     (vector-set! form i (patch-ref! fi))
+                     (patch-shared! fi)))
+               (loop (fx+ i 1))))]
+          [(box? form)
+           (if (procedure? (unbox form))
+               (set-box! form (patch-shared! (unbox form)))
+               (patch-shared! (unbox form)))]))
+  (define (patch-shared form) (patch-shared! form) form)           
+
+  (define reader-token-marker #f)
+  (define close-paren #f)
+  (define close-bracket #f)
+  (define dot #f)
+  (define () ; idless
+    (let ([rtm (list 'reader-token)])
+          (set! reader-token-marker rtm)
+          (set! close-paren (cons rtm "right parenthesis"))
+          (set! close-bracket (cons rtm "right bracket"))
+          (set! dot (cons rtm "\" . \""))))
+
+  (define (reader-token? form)
+    (and (pair? form) (eq? (car form) reader-token-marker)))
+
+  (define (char-symbolic? c)
+    (string-position c
+      "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz!$%&*/:<=>?^_~0123456789+-.@"))
+
+  (define (char-hex-digit? c)
+    (let ([scalar-value (char->integer c)])
+      (or (and (>= scalar-value 48) (<= scalar-value 57))
+          (and (>= scalar-value 65) (<= scalar-value 70))
+          (and (>= scalar-value 97) (<= scalar-value 102)))))
+
+  (define (char-delimiter? c)
+    (or (char-whitespace? c)
+        (char=? c #\)) (char=? c #\()
+        (char=? c #\]) (char=? c #\[)
+        (char=? c #\") (char=? c #\;)))
+
+  (define (sub-read-carefully p)
+    (let ([form (sub-read p)])
+      (cond [(eof-object? form)
+             (r-error p "unexpected end of file")]
+            [(reader-token? form) 
+             (r-error p "unexpected token:" (cdr form))]
+            [else form])))
+
+  (define (sub-read p)
+    (let ([c (read-char p)])
+      (cond [(eof-object? c) c]
+            [(char-whitespace? c) (sub-read p)]
+            [(char=? c #\() (sub-read-list c p close-paren #t)]
+            [(char=? c #\)) close-paren]
+            [(char=? c #\[) (sub-read-list c p close-bracket #t)]
+            [(char=? c #\]) close-bracket]
+            [(char=? c #\') (list 'quote (sub-read-carefully p))]
+            [(char=? c #\`) (list 'quasiquote (sub-read-carefully p))]
+            [(char-symbolic? c) (sub-read-number-or-symbol c p)]
+            [(char=? c #\;)
+             (let loop ([c (read-char p)])
+               (or (eof-object? c) (char=? c #\newline)
+                   (loop (read-char p))))
+             (sub-read p)]
+            [(char=? c #\,)
+             (let ([next (peek-char p)])
+               (cond [(eof-object? next)
+                      (r-error p "end of file after ,")]
+                     [(char=? next #\@)
+                      (read-char p)
+                      (list 'unquote-splicing (sub-read-carefully p))]
+                     [else (list 'unquote (sub-read-carefully p))]))]
+            [(char=? c #\")
+             (let loop ([l '()])
+               (let ([c (read-char p)])
+                 (cond [(eof-object? c)
+                        (r-error p "end of file within a string")]
+                       [(char=? c #\\)
+                        (let ([e (sub-read-strsym-char-escape p 'string)])
+                          (loop (if e (cons e l) l)))]
+                       [(char=? c #\") (list->string (reverse! l))]
+                       [else (loop (cons c l))])))]
+            [(char=? c #\|)
+             (let loop ([l '()])
+               (let ([c (read-char p)])
+                 (cond [(eof-object? c)
+                        (r-error p "end of file within a |symbol|")]
+                       [(char=? c #\\)
+                        (let ([e (sub-read-strsym-char-escape p 'symbol)])
+                          (loop (if e (cons e l) l)))]
+                       [(char=? c #\|) (string->symbol (list->string (reverse! l)))]
+                       [else (loop (cons c l))])))]
+            [(char=? c #\#)
+             (let ([c (peek-char p)])
+               (cond [(eof-object? c) (r-error p "end of file after #")]
+                     [(or (char-ci=? c #\t) (char-ci=? c #\f))
+                      (let ([name (sub-read-carefully p)])
+                        (case name [(t true) #t] [(f false) #f]
+                          [else (r-error p "unexpected name after #" name)]))]
+                     [(or (char-ci=? c #\b) (char-ci=? c #\o)
+                          (char-ci=? c #\d) (char-ci=? c #\x)
+                          (char-ci=? c #\i) (char-ci=? c #\e))
+                      (sub-read-number-or-symbol #\# p)]
+                     [(char=? c #\&)
+                      (read-char p)
+                      (box (sub-read-carefully p))]
+                     [(char=? c #\;)
+                      (read-char p)
+                      (sub-read-carefully p) 
+                      (sub-read p)]
+                     [(char=? c #\|)
+                      (read-char p)
+                      (let recur () ;starts right after opening #|
+                        (let ([next (read-char p)])
+                          (cond
+                            [(eof-object? next)
+                             (r-error p "end of file in #| comment")]
+                            [(char=? next #\|)
+                             (let ([next (peek-char p)])
+                               (cond
+                                 [(eof-object? next)
+                                  (r-error p "end of file in #| comment")]
+                                 [(char=? next #\#) (read-char p)]
+                                 [else (recur)]))]
+                            [(char=? next #\#)
+                             (let ([next (peek-char p)])
+                               (cond
+                                 [(eof-object? next)
+                                  (r-error p "end of file in #| comment")]
+                                 [(char=? next #\|) (read-char p) (recur) (recur)]
+                                 [else (recur)]))]
+                            [else (recur)])))
+                      (sub-read p)]
+                     [(char=? c #\() ;)
+                      (read-char p)
+                      (list->vector (sub-read-list c p close-paren #f))]
+                     [(char=? c #\u)
+                      (read-char p)
+                      (if (and (eq? (read-char p) #\8) (eq? (read-char p) #\())
+                          (list->bytevector (sub-read-byte-list p))
+                          (r-error p "invalid bytevector syntax"))]
+                     [(char=? c #\\)
+                      (read-char p)
+                      (let ([c (peek-char p)])
+                        (cond
+                          [(eof-object? c)
+                           (r-error p "end of file after #\\")]
+                          [(char=? #\x c)
+                           (read-char p)
+                           (if (char-delimiter? (peek-char p))
+                               c
+                               (sub-read-x-char-escape p #f))]
+                          [(char-alphabetic? c)
+                           (let ([name (sub-read-carefully p)])
+                             (if (= (string-length (symbol->string name)) 1)
+                                 c
+                                 (case name
+                                   [(null) (integer->char #x00)]
+                                   [(space) #\space]
+                                   [(alarm) #\alarm]
+                                   [(backspace) #\backspace]
+                                   [(delete) (integer->char #x7F)] ; todo: support by SFC
+                                   [(escape) (integer->char #x1B)]
+                                   [(tab) #\tab]
+                                   [(newline linefeed) #\newline]
+                                   [(vtab) #\vtab]
+                                   [(page) #\page]
+                                   [(return) #\return]
+                                   [else (r-error p "unknown #\\ name" name)])))]
+                          [else (read-char p) c]))]
+                     [(char-numeric? c)
+                      (when simple? (r-error p "#N=/#N# notation is not allowed in this mode")) 
+                      (let loop ([l '()])
+                        (let ([c (read-char p)])
+                          (cond [(eof-object? c)
+                                 (r-error p "end of file within a #N notation")]
+                                [(char-numeric? c)
+                                 (loop (cons c l))]
+                                [(char=? c #\#) 
+                                 (let* ([s (list->string (reverse! l))] [n (string->number s)])
+                                   (cond [(and (fixnum? n) (assq n shared)) => cdr]
+                                         [else (r-error "unknown #n# reference:" s)]))]   
+                                [(char=? c #\=) 
+                                 (let* ([s (list->string (reverse! l))] [n (string->number s)])
+                                   (cond [(not (fixnum? n)) (r-error "invalid #n= reference:" s)]
+                                         [(assq n shared) (r-error "duplicate #n= tag:" n)])
+                                   (let ([loc (box #f)])
+                                     (set! shared (cons (cons n (make-shared-ref loc)) shared))
+                                     (let ([form (sub-read-carefully p)])
+                                       (cond [(shared-ref? form) (r-error "#n= has another label as target" s)]
+                                             [else (set-box! loc form) form]))))]
+                                [else (r-error p "invalid terminator for #N notation")])))]
+                     [else (r-error p "unknown # syntax" c)]))]
+            [else (r-error p "illegal character read" c)])))
+
+  (define (sub-read-list c p close-token dot?)
+    (let ([form (sub-read p)])
+      (if (eq? form dot)
+          (r-error p "missing car -- ( immediately followed by .") ;)
+          (let recur ([form form])
+            (cond [(eof-object? form)
+                   (r-error p "eof inside list -- unbalanced parentheses")]
+                  [(eq? form close-token) '()]
+                  [(eq? form dot)
+                   (if dot?
+                       (let* ([last-form (sub-read-carefully p)]
+                              [another-form (sub-read p)])
+                         (if (eq? another-form close-token)
+                             last-form
+                             (r-error p "randomness after form after dot" another-form)))
+                       (r-error p "dot in #(...)"))]
+                  [(reader-token? form)
+                   (r-error p "error inside list --" (cdr form))]
+                  [else (cons form (recur (sub-read p)))])))))
+
+  (define (sub-read-byte-list p)
+    (let recur ([form (sub-read p)])
+      (cond [(eof-object? form)
+              (r-error p "eof inside bytevector")]
+            [(eq? form close-paren) '()]
+            [(reader-token? form)
+              (r-error p "error inside bytevector --" (cdr form))]
+            [(or (not (fixnum? form)) (fx<? form 0) (fx>? form 255))
+              (r-error p "invalid byte inside bytevector --" form)]
+            [else (cons form (recur (sub-read p)))])))
+
+  (define (sub-read-strsym-char-escape p what)
+    (let ([c (read-char p)])
+      (if (eof-object? c)
+          (r-error p "end of file within a" what))
+      (cond [(or (char=? c #\\) (char=? c #\") (char=? c #\|)) c]
+            [(char=? c #\a) #\alarm]
+            [(char=? c #\b) #\backspace]
+            [(char=? c #\t) #\tab]
+            [(char=? c #\n) #\newline]
+            [(char=? c #\v) #\vtab]
+            [(char=? c #\f) #\page]
+            [(char=? c #\r) #\return]
+            [(char=? c #\x) (sub-read-x-char-escape p #t)]
+            [(and (eq? what 'string) (char-whitespace? c))
+             (let loop ([gotnl (char=? c #\newline)] [nc (peek-char p)])
+               (cond [(or (eof-object? nc) (not (char-whitespace? nc)))
+                      (if gotnl #f (r-error p "no newline in line ending escape"))]
+                     [(and gotnl (char=? nc #\newline)) #f]
+                     [else (read-char p) (loop (or gotnl (char=? nc #\newline)) (peek-char p))]))]
+            [else (r-error p "invalid char escape in" what ': c)])))
+
+  (define (sub-read-x-char-escape p in-string?)
+    (define (rev-digits->char l)
+      (if (null? l)
+          (r-error p "\\x escape sequence is too short")
+          (integer->char (string->fixnum (list->string (reverse! l)) 16))))
+    (let loop ([c (peek-char p)] [l '()] [cc 0])
+      (cond [(eof-object? c)
+             (if in-string?
+               (r-error p "end of file within a string")
+               (rev-digits->char l))]
+            [(and in-string? (char=? c #\;))
+             (read-char p)
+             (rev-digits->char l)]
+            [(and (not in-string?) (char-delimiter? c))
+             (rev-digits->char l)]
+            [(not (char-hex-digit? c))
+             (r-error p "unexpected char in \\x escape sequence" c)]
+            [(> cc 2)
+             (r-error p "\\x escape sequence is too long")]
+            [else
+             (read-char p)
+             (loop (peek-char p) (cons c l) (+ cc 1))])))
+
+  (define (suspect-number-or-symbol-peculiar? hash? c l s)
+    (cond [(or hash? (char-numeric? c)) #f]
+          [(or (string-ci=? s "+i") (string-ci=? s "-i")) #f]
+          [(or (string-ci=? s "+nan.0") (string-ci=? s "-nan.0")) #f]
+          [(or (string-ci=? s "+inf.0") (string-ci=? s "-inf.0")) #f]
+          [(or (char=? c #\+) (char=? c #\-))
+           (cond [(null? (cdr l)) #t]
+                 [(char=? (cadr l) #\.) (and (pair? (cddr l)) (not (char-numeric? (caddr l))))]
+                 [else (not (char-numeric? (cadr l)))])]
+          [else (and (char=? c #\.) (pair? (cdr l)) (not (char-numeric? (cadr l))))]))
+
+  (define (sub-read-number-or-symbol c p)
+    (let loop ([c (peek-char p)] [l (list c)] [hash? (char=? c #\#)])
+      (cond [(or (eof-object? c) (char-delimiter? c))
+             (let* ([l (reverse! l)] [c (car l)] [s (list->string l)])
+               (if (or hash? (char-numeric? c) 
+                     (char=? c #\+) (char=? c #\-) (char=? c #\.))   
+                   (cond [(string=? s ".") dot]
+                         [(suspect-number-or-symbol-peculiar? hash? c l s) (string->symbol s)]
+                         [(string->number s)]
+                         [else (r-error p "unsupported number syntax (implementation restriction)" s)])
+                   (string->symbol s)))]
+            [(char=? c #\#)
+             (read-char p) 
+             (loop (peek-char p) (cons c l) #t)]
+            [(char-symbolic? c)
+             (read-char p) 
+             (loop (peek-char p) (cons c l) hash?)]
+            [else (r-error p "unexpected number/symbol char" c)])))
+            
+  ; body of %read
+  (let ([form (sub-read port)])
+    (if (not (reader-token? form))
+        (if (null? shared) form (patch-shared form))
+        (r-error port "unexpected token:" (cdr form)))))
+
+(define read
+  (case-lambda
+    [() (%read (current-input-port) #f)]
+    [(p) (%read p #f)]))
+
+(define read-simple
+  (case-lambda
+    [() (%read (current-input-port) #t)]
+    [(p) (%read p #t)]))
+
 
 ;---------------------------------------------------------------------------------------------
 ; Output