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

fix in letcc compiler; call/cc redefined via letcc

Browse source
This commit is contained in:
ESL 2023-03-11 12:28:51 -05:00
parent 25fa48c928
commit 6f009ba30a
5 changed files with 563 additions and 540 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1028
k.c
View file

File diff suppressed because it is too large Load diff

8
s.c
View file

@ -1721,8 +1721,12 @@ char *s_code[] = {
"rgs;;;l2:y1:_;y15:%25residual-apply;;", "rgs;;;l2:y1:_;y15:%25residual-apply;;",
"call/cc", "call/cc",
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py4:%25ccc;y4:args;;;l2:y1:_;y" "l5:y12:syntax-rules;n;l2:l2:y1:_;y1:f;;l3:y5:letcc;y1:k;l2:y1:f;y1:k;;"
"4:%25ccc;;", ";;l2:py1:_;y12:syntax-rules;;py17:%25residual-call/cc;y12:syntax-rules"
";;;l2:y1:_;y17:%25residual-call/cc;;",
0,
"&0{%1k1,.0,.2[21}@!(y17:%25residual-call/cc)",
"call-with-current-continuation", "call-with-current-continuation",
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py7:call/cc;y4:args;;;l2:y1:_;" "l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py7:call/cc;y4:args;;;l2:y1:_;"

13
src/k.sf
View file

@ -977,32 +977,33 @@
(when k (write-char #\] port) (write-serialized-arg k port))] (when k (write-char #\] port) (write-serialized-arg k port))]
[letcc (kid exp) [letcc (kid exp)
(let* ([ids (list kid)] [sets (find-sets exp ids)] (let* ([ids (list kid)] [sets (find-sets exp ids)]
[news (set-union (set-minus s ids) sets)] [news (set-union (set-minus s ids) sets)])
[newl (cons kid l)])
(cond [k ; tail position with k locals on stack to be disposed of (cond [k ; tail position with k locals on stack to be disposed of
(write-char #\k port) (write-serialized-arg k port) (write-char #\k port) (write-serialized-arg k port)
(write-char #\, port) (write-char #\, port)
(when (set-member? kid sets) (when (set-member? kid sets)
(write-char #\# port) (write-char #\0 port)) (write-char #\# port) (write-char #\0 port))
(codegen exp newl f news g (fx+ k 1) port)] ; stack map here: kid on top
(codegen exp (cons kid l) f news g (fx+ k 1) port)]
[else ; non-tail position [else ; non-tail position
(write-char #\$ port) (write-char #\{ port) (write-char #\$ port) (write-char #\{ port)
(write-char #\k port) (write-char #\0 port) (write-char #\k port) (write-char #\0 port)
(write-char #\, port) (write-char #\, port)
(when (set-member? kid sets) (when (set-member? kid sets)
(write-char #\# port) (write-char #\0 port)) (write-char #\# port) (write-char #\0 port))
(codegen exp newl f news g #f port) ; stack map here: kid on top, two-slot frame under it
(codegen exp (cons kid (cons #f (cons #f l))) f news g #f port)
(write-char #\_ port) (write-serialized-arg 3 port) (write-char #\_ port) (write-serialized-arg 3 port)
(write-char #\} port)]))] (write-char #\} port)]))]
[withcc (kexp exp) [withcc (kexp exp)
(cond [(memq (car exp) '(quote ref lambda)) ; exp is a constant, return it (cond [(memq (car exp) '(quote ref lambda)) ; exp is a constant, return it
(codegen exp l f s g #f port) (codegen exp l f s g #f port)
(write-char #\, port) (write-char #\, port) ; stack map after: k on top
(codegen kexp (cons #f l) f s g #f port) (codegen kexp (cons #f l) f s g #f port)
(write-char #\w port) (write-char #\! port)] (write-char #\w port) (write-char #\! port)]
[else ; exp is not a constant, thunk it and call it from k [else ; exp is not a constant, thunk it and call it from k
(codegen (list 'lambda '() exp) l f s g #f port) (codegen (list 'lambda '() exp) l f s g #f port)
(write-char #\, port) (write-char #\, port) ; stack map after: k on top
(codegen kexp (cons #f l) f s g #f port) (codegen kexp (cons #f l) f s g #f port)
(write-char #\w port)])] (write-char #\w port)])]
[call (exp . args) [call (exp . args)

2
src/s.scm
View file

@ -759,7 +759,7 @@
[(_ . args) (%residual-apply . args)] [(_ . args) (%residual-apply . args)]
[_ %residual-apply])) [_ %residual-apply]))
(define-syntax call/cc %ccc) (define-inline (call/cc f) %residual-call/cc (letcc k (f k)))
(define-syntax call-with-current-continuation call/cc) (define-syntax call-with-current-continuation call/cc)

52
t.c
View file

@ -276,32 +276,32 @@ char *t_code[] = {
"2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3:id?)[01}?{.1?{${.2,:0[01}}{f" "2,&1{%3n,.2,.2,,#0:0,.1,.8,&3{%3${.2,@(y3:id?)[01}?{.1?{${.2,:0[01}}{f"
"}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2X0,:1^[33}.0p?{${.2d,:2^[01}?{${.4,.4,." "}?{.2,.1c]3}.2]3}.0V0?{.2,.2,.2X0,:1^[33}.0p?{${.2d,:2^[01}?{${.4,.4,."
"4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^[03},.2,.2a,:1^[33}.2]3}.!0.0^" "4dd,:1^[03},t,.2a,:1^[33}${.4,.4,.4d,:1^[03},.2,.2a,:1^[33}.2]3}.!0.0^"
"_1[33}.!4.4,.2,.4,.3,.(i11),&5{%3.1,.1,.4,:0,:1,:2,:3,:4,&8{%1,#0.1,&1" "_1[33}.!4.4,.2,.4,.3,.(i11),&5{%3k3,.0,,#0.1,&1{%0f,:0[01}.!0n,.5,.5,,"
"{%0f,:0[01}.!0n,:7,:6,,#0.4,.1,:0,:1,:2,:3,:4,:5,&8{%3,#0:7,.4,&2{%1.0" "#0.4,.1,:4,:3,:2,:1,:0,.(i16),&8{%3,#0:7,.4,&2{%1.0?{:0]1}:1^[10}.!0${"
"?{:0]1}:1^[10}.!0${.3,@(y3:id?)[01}?{${.3,:2^[01}?{${.4,@(y3:id?)[01}?" ".3,@(y3:id?)[01}?{${.3,:2^[01}?{${.4,@(y3:id?)[01}?{${.3,:1[01},${.5,:"
"{${.3,:1[01},${.5,:0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{$" "0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{${:7^[00}}_1.3,.3X0,"
"{:7^[00}}_1.3,.3X0,.3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1dd" ".3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1ddg,.3L0?{.3g}{${:7^["
"g,.3L0?{.3g}{${:7^[00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${" "00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${:4^,t,.(i10)a,:5^[0"
":4^,t,.(i10)a,:5^[03},,#0.8,:6,&2{%1@(y13:%25residual-cdr),${n,.4,:1a," "3},,#0.8,:6,&2{%1@(y13:%25residual-cdr),${n,.4,:1a,:0^[03},,#0.2,.1,&2"
":0^[03},,#0.2,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[" "{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[21}.!0${.(i12),.6,."
"21}.!0${.(i12),.6,.(i12)dd,:6^[03},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d" "(i12)dd,:6^[03},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[0"
",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.5c,@(y14:%25residual-list" "1}c]1}n]1}.!0.0^_1[01}_1,.5c,@(y14:%25residual-list)c,@(y13:%25residua"
")c,@(y13:%25residual-map),@(y5:%25appl)[02}L6](i11)}.2p?{${.5,.5d,.5d," "l-map),@(y5:%25appl)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[03},.3a,.3a,:6^"
":6^[03},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[23},@(y4:%25ccc)[31}.!5.7,.2,.6" "[43}:7^[40}.!0.0^_1[63}.!5.7,.2,.6,.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0["
",.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0[01},@(y6:new-id)[01},.1c]1},${${.(" "01},@(y6:new-id)[01},.1c]1},${${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[0"
"i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[03},,#0.4,.1,&2{%1.0p?{${.2d,:0^[01" "3},,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1"
"},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1.!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%" ".!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2"
"1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,.2,.8,:0,&5{%2.0,,#" ".5,.5,,#0.8,.4,.2,.8,:0,&5{%2.0,,#0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3"
"0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:3,.1A3,.0?{.0}{:0,.2A3" ":id?)[01}?{:3,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${."
",.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:2^[01}X1]1}.0p?{${.2d,:6^[01}" "2X0,:2^[01}X1]1}.0p?{${.2d,:6^[01}?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A"
"?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y" "3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y14:%25residual-cons),@(y13:%25residu"
"14:%25residual-cons),@(y13:%25residual-map)[03},:1a,:0^[12}.!1.0^,${.5" "al-map)[03},:1a,:0^[12}.!1.0^,${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${"
",,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,$" ".3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,${.6dd,:2^[01},${.3,.6^c,@(y13:%25res"
"{.6dd,:2^[01},${.3,.6^c,@(y13:%25residual-map),@(y5:%25appl)[02}L6]5}$" "idual-map),@(y5:%25appl)[02}L6]5}${.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}."
"{.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!6.(i10),." "!0.0^_1[21}.!0.0^_1[62}.!6.(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1"
"7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),'(" ".0u?{${:3,'(s14:invalid syntax),'(y9:transform),@(y5:error)[03}}.0a,.0"
"y9:transform),@(y5:error)[03}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,." "a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[2"
"0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i11)}@!(y13:syntax-rules*)", "1}](i11)}@!(y13:syntax-rules*)",
0, 0,
"${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n" "${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n"