Miroirs/skint
1
0
Fork 0
mirror of https://github.com/false-schemers/skint.git synced 2024-12-25 21:58:54 +01:00
Code Issues Projects Releases Packages Wiki Activity Actions

(read) added!

Browse source
This commit is contained in:
ESL 2023-03-26 14:52:30 -04:00
parent 7546908e29
commit 8dc87ec18f
4 changed files with 473 additions and 2 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
i.c
View file

@ -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));

1
i.h
View file

@ -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)

127
s.c
View file

@ -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
};

339
src/s.scm
View file

@ -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