new integrable model, part VI (before switch)

This commit is contained in:
ESL 2023-03-21 13:43:26 -04:00
parent c90e1abcf2
commit 0cf6470e1b
7 changed files with 947 additions and 926 deletions

21
i.c
View file

@ -918,6 +918,21 @@ define_instruction(list) {
gonexti();
}
define_instruction(lmk) {
int i, n; obj v; ckk(ac);
n = fixnum_from_obj(ac);
hp_reserve(hbsz(2+1)*n); v = sref(0);
ac = mknull();
for (i = 0; i < n; ++i) {
*--hp = ac; /* cdr */
*--hp = v; /* car */
*--hp = obj_from_size(PAIR_BTAG);
ac = hendblk(2+1);
}
sdrop(1);
gonexti();
}
define_instruction(llen) {
int n = 0;
while (ispair(ac)) { ac = cdr(ac); ++n; }
@ -1102,8 +1117,8 @@ define_instruction(vec) {
define_instruction(vmk) {
int i, n; obj v; ckk(ac);
n = fixnum_from_obj(ac); v = sref(0);
hp_reserve(hbsz(n+1));
n = fixnum_from_obj(ac);
hp_reserve(hbsz(n+1)); v = sref(0);
for (i = 0; i < n; ++i) *--hp = v;
*--hp = obj_from_size(VECTOR_BTAG);
ac = hendblk(n+1);
@ -3606,6 +3621,8 @@ static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
} break;
case '#': /* must have explicit lcode */
assert(0);
case '@': /* must have explicit lcode */
assert(0);
default:
assert(0);
}

52
i.h
View file

@ -207,21 +207,21 @@ declare_instruction(atest4, "%4", 0, NULL, 0, NULL)
declare_instruction(brnotlt, "<?", 'b', NULL, 0, NULL)
declare_instruction(pushsub, "-,", 0, NULL, 0, NULL)
/* type checks */
declare_instruction(ckp, "%p", 0, "%ckp", 1, INLINED)
declare_instruction(ckl, "%l", 0, "%ckl", 1, INLINED)
declare_instruction(ckv, "%v", 0, "%ckv", 1, INLINED)
declare_instruction(ckc, "%c", 0, "%ckc", 1, INLINED)
declare_instruction(cks, "%s", 0, "%cks", 1, INLINED)
declare_instruction(cki, "%i", 0, "%cki", 1, INLINED)
declare_instruction(ckj, "%j", 0, "%ckj", 1, INLINED)
declare_instruction(ckn, "%n", 0, "%ckn", 1, INLINED)
declare_instruction(ckk, "%k", 0, "%ckk", 1, INLINED)
declare_instruction(cky, "%y", 0, "%cky", 1, INLINED)
declare_instruction(ckr, "%r", 0, "%ckr", 1, INLINED)
declare_instruction(ckw, "%w", 0, "%ckw", 1, INLINED)
declare_instruction(ckx, "%x", 0, "%ckx", 1, INLINED)
declare_instruction(ckz, "%z", 0, "%ckz", 1, INLINED)
/* type checks, integra */
declare_instruction(ckp, "%p", 0, "%ckp", '1', INLINED)
declare_instruction(ckl, "%l", 0, "%ckl", '1', INLINED)
declare_instruction(ckv, "%v", 0, "%ckv", '1', INLINED)
declare_instruction(ckc, "%c", 0, "%ckc", '1', INLINED)
declare_instruction(cks, "%s", 0, "%cks", '1', INLINED)
declare_instruction(cki, "%i", 0, "%cki", '1', INLINED)
declare_instruction(ckj, "%j", 0, "%ckj", '1', INLINED)
declare_instruction(ckn, "%n", 0, "%ckn", '1', INLINED)
declare_instruction(ckk, "%k", 0, "%ckk", '1', INLINED)
declare_instruction(cky, "%y", 0, "%cky", '1', INLINED)
declare_instruction(ckr, "%r", 0, "%ckr", '1', INLINED)
declare_instruction(ckw, "%w", 0, "%ckw", '1', INLINED)
declare_instruction(ckx, "%x", 0, "%ckx", '1', INLINED)
declare_instruction(ckz, "%z", 0, "%ckz", '1', INLINED)
/* intrinsics (no arg checks), integrables and globals */
declare_instruction(isq, "q", 0, "eq?", '2', AUTOGL)
@ -343,9 +343,8 @@ declare_instruction(min, "M2", 0, "min", 'x', AUTOGL)
declare_instruction(max, "M3", 0, "max", 'x', AUTOGL)
declare_instruction(listp, "L0", 0, "list?", '1', AUTOGL)
declare_instruction(list, "l", 1, "list", '#', "%!0_!]0")
//declare_instrshadow(list, "L1", 1, NULL, 0, INLINED)
declare_instruction(lmk, "L2\0f", 0, "make-list", 'b', AUTOGL)
declare_instruction(llen, "g", 0, "length", '1', AUTOGL)
//declare_instrshadow(llen, "L3", 0, NULL, 0, INLINED)
declare_instruction(lget, "L4", 0, "list-ref", '2', AUTOGL)
declare_instruction(lput, "L5", 0, "list-set!", '3', AUTOGL)
declare_instruction(lcat, "L6", 0, "list-cat", '2', AUTOGL)
@ -405,9 +404,9 @@ declare_instruction(vlen, "V3", 0, "vector-length", '1', AUTOGL)
declare_instruction(vget, "V4", 0, "vector-ref", '2', AUTOGL)
declare_instruction(vput, "V5", 0, "vector-set!", '3', AUTOGL)
declare_instruction(vcat, "V6", 0, "vector-cat", '2', AUTOGL)
declare_instruction(vtol, "X0", 0, "%vtol", 1, INLINED)
declare_instruction(vtol, "X0", 0, "%vector->list1", '1', AUTOGL)
declare_instruction(ltov, "X1", 0, "list->vector", '1', AUTOGL)
declare_instruction(stol, "X2", 0, "%stol", 1, INLINED)
declare_instruction(stol, "X2", 0, "%string->list1", '1', AUTOGL)
declare_instruction(ltos, "X3", 0, "list->string", '1', AUTOGL)
declare_instruction(ytos, "X4", 0, "symbol->string", '1', AUTOGL)
declare_instruction(stoy, "X5", 0, "string->symbol", '1', AUTOGL)
@ -457,9 +456,9 @@ declare_instruction(wriw, "W8\0P11", 0, "write-simple", 'b', AUTOGL)
/* serialization and deserialization instructions */
declare_instruction(igp, "U0", 0, "integrable?", '1', AUTOGL)
declare_instruction(fenc, "U1", 0, "find-integrable-encoding", 2, AUTOGL)
declare_instruction(wrsi, "U2", 0, "encode-integrable", 3, AUTOGL)
declare_instruction(rdsx, "U3", 0, "deserialize-sexp", 1, AUTOGL)
declare_instruction(rdsc, "U4", 0, "deserialize-code", 1, AUTOGL)
declare_instruction(wrsi, "U2", 0, "encode-integrable", 3, AUTOGL)
declare_instruction(rdsx, "U3", 0, "deserialize-sexp", '1', AUTOGL)
declare_instruction(rdsc, "U4", 0, "deserialize-code", '1', AUTOGL)
declare_instruction(iglk, "U5", 0, "lookup-integrable", '1', AUTOGL)
declare_instruction(igty, "U6", 0, "integrable-type", '1', AUTOGL)
declare_instruction(iggl, "U7", 0, "integrable-global", '1', AUTOGL)
@ -502,10 +501,11 @@ declare_integrable(NULL, "dadd", 0, "cddadr", '1', AUTOGL)
declare_integrable(NULL, "addd", 0, "cdddar", '1', AUTOGL)
declare_integrable(NULL, "dddd", 0, "cddddr", '1', AUTOGL)
/* globals */
declare_integrable(NULL, NULL, 0, "%appl", 2, "%2_!K3")
declare_integrable(NULL, NULL, 0, "%cwmv", 2, "%2_!K4")
declare_integrable(NULL, NULL, 0, "%sdmv", -1, "K6")
/* non-integrable global definitions */
declare_integrable(NULL, NULL, 0, "apply-to-list", '@', "%2_!K3")
declare_integrable(NULL, NULL, 0, "call-with-values", '@', "%2_!K4")
declare_integrable(NULL, NULL, 0, "values", '@', "K6")
declare_integrable(NULL, NULL, 0, "%call/cc", '@', "%1k1,.0,.2[21")
#undef declare_instruction
#undef declare_instrshadow

1366
k.c

File diff suppressed because it is too large Load diff

182
s.c
View file

@ -9,32 +9,26 @@ char *s_code[] = {
"&0{%2.1,.1G6,.2,.2G5,@(y5:%25sdmv)[22}@!(y9:truncate/)",
0,
"&0{%2n,.1%k,,#0.4,.1,&2{%2'0,.1I>!?{.1]2}.1,:1c,'1,.2I-,:0^[22}.!0.0^_"
"1[22}@!(y10:%25make-list)",
"make-list",
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:n;;l3:y10:%25make-list;y1:n;f;;;l2"
":l3:y1:_;y1:n;y1:i;;l3:y10:%25make-list;y1:n;y1:i;;;l2:py1:_;y4:args;;"
"py19:%25residual-make-list;y4:args;;;l2:y1:_;y19:%25residual-make-list"
";;",
"&0{%!0.0,,#0.0,&1{%1.0u?{n]1}.0du?{.0a]1}${.2d,:0^[01},.1a,@(y8:list-c"
"at)[12}.!0.0^_1[11}@!(y7:%25append)",
"append",
"l7:y12:syntax-rules;n;l2:l1:y1:_;;l2:y5:quote;n;;;l2:l2:y1:_;y1:x;;y1:"
"x;;l2:l3:y1:_;y1:x;y1:y;;l3:y8:list-cat;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1"
":y;y1:z;y3:...;;l3:y8:list-cat;y1:x;l4:y6:append;y1:y;y1:z;y3:...;;;;l"
"2:y1:_;y16:%25residual-append;;",
"2:y1:_;y7:%25append;;",
0,
"&0{%!2.0u?{.2,.2A2]3}.0a,.3,.3,,#0.0,&1{%3.1p?{${.3a,.3,.6[02}?{.1]3}."
"2,.2d,.2,:0^[33}f]3}.!0.0^_1[33}@!(y7:%25member)",
"&0{%!2.0u?{.2,.2,@(y4:meme)[32}.0a,.3,.3,,#0.0,&1{%3.1p?{${.3a,.3,.6[0"
"2}?{.1]3}.2,.2d,.2,:0^[33}f]3}.!0.0^_1[33}@!(y7:%25member)",
"member",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y1:l;;l3:y4:meme;y1:v;y1:l;;;l2:"
"py1:_;y4:args;;py7:%25member;y4:args;;;l2:y1:_;y7:%25member;;",
0,
"&0{%!2.0u?{.2,.2A5]3}.0a,.3,.3,,#0.0,&1{%3.1p?{${.3aa,.3,.6[02}?{.1a]3"
"}.2,.2d,.2,:0^[33}f]3}.!0.0^_1[33}@!(y6:%25assoc)",
"&0{%!2.0u?{.2,.2,@(y4:asse)[32}.0a,.3,.3,,#0.0,&1{%3.1p?{${.3aa,.3,.6["
"02}?{.1a]3}.2,.2d,.2,:0^[33}f]3}.!0.0^_1[33}@!(y6:%25assoc)",
"assoc",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y2:al;;l3:y4:asse;y1:v;y2:al;;;l"
@ -46,13 +40,17 @@ char *s_code[] = {
"rules;;;l2:y1:_;y19:%25residual-list-copy;;",
0,
"&0{%1n,.1,@(y5:%25lcat)[12}@!(y19:%25residual-list-copy)",
"&0{%1n,.1L6]1}@!(y19:%25residual-list-copy)",
0,
"&0{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[22}@"
"!(y6:%25list*)",
"list*",
"l7:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;y1:x;;l2:l3:y1:_;y1:x;y1:y;;l3:"
"y4:cons;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l3:y4:cons;y1:x;"
"l4:y5:list*;y1:y;y1:z;y3:...;;;;l2:py1:_;y4:args;;py15:%25residual-lis"
"t*;y4:args;;;l2:y1:_;y15:%25residual-list*;;",
"l4:y5:list*;y1:y;y1:z;y3:...;;;;l2:py1:_;y4:args;;py6:%25list*;y4:args"
";;;l2:y1:_;y6:%25list*;;",
"cons*",
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py5:list*;y4:args;;;l2:y1:_;y5"
@ -64,12 +62,13 @@ char *s_code[] = {
0,
"&0{%3.2,.2,.2,@(y15:subvector->list)[33}%x,&0{%2.0V3,.2,.2,@(y15:subve"
"ctor->list)[23}%x,&0{%1.0X0]1}%x,&3{|10|21|32%%}@!(y13:%25vector->list"
")",
"ctor->list)[23}%x,&0{%1.0,@(y14:%25vector->list1)[11}%x,&3{|10|21|32%%"
"}@!(y13:%25vector->list)",
"vector->list",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25vtol;y1:x;;;l2:py1:_;y"
"1:r;;py13:%25vector->list;y1:r;;;l2:y1:_;y13:%25vector->list;;",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y14:%25vector->list1;y1:x;;;"
"l2:py1:_;y1:r;;py13:%25vector->list;y1:r;;;l2:y1:_;y13:%25vector->list"
";;",
0,
"&0{%5.1,.1V3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.3,.7,.6,.3,&4{%2:3,.2I<!,"
@ -139,12 +138,13 @@ char *s_code[] = {
0,
"&0{%3.2,.2,.2,@(y15:substring->list)[33}%x,&0{%2.0S3,.2,.2,@(y15:subst"
"ring->list)[23}%x,&0{%1.0X2]1}%x,&3{|10|21|32%%}@!(y13:%25string->list"
")",
"ring->list)[23}%x,&0{%1.0,@(y14:%25string->list1)[11}%x,&3{|10|21|32%%"
"}@!(y13:%25string->list)",
"string->list",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25stol;y1:x;;;l2:py1:_;y"
"1:r;;py13:%25string->list;y1:r;;;l2:y1:_;y13:%25string->list;;",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y14:%25string->list1;y1:x;;;"
"l2:py1:_;y1:r;;py13:%25string->list;y1:r;;;l2:y1:_;y13:%25string->list"
";;",
0,
"&0{%5.1,.1S3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.3,.7,.6,.3,&4{%2:3,.2I<!,"
@ -202,71 +202,88 @@ char *s_code[] = {
"1:x;;;l2:l3:y1:_;y1:x;y1:y;;l3:y10:string-cat;y1:x;y1:y;;;l2:py1:_;y1:"
"r;;py14:%25string-append;y1:r;;;l2:y1:_;y14:%25string-append;;",
0,
"&0{%!2${.2,.5,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[02"
"},.2,@(y13:apply-to-list)[32}@!(y6:%25apply)",
"apply",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:p;y1:l;;l3:y5:%25appl;y1:p;y1:l;;;"
"l2:l6:y1:_;y1:p;y1:a;y1:b;y3:...;y1:l;;l3:y5:%25appl;y1:p;l5:y5:list*;"
"y1:a;y1:b;y3:...;y1:l;;;;l2:py1:_;y4:args;;py15:%25residual-apply;y4:a"
"rgs;;;l2:y1:_;y15:%25residual-apply;;",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:p;y1:l;;l3:y13:apply-to-list;y1:p;"
"y1:l;;;l2:l6:y1:_;y1:p;y1:a;y1:b;y3:...;y1:l;;l3:y13:apply-to-list;y1:"
"p;l5:y5:list*;y1:a;y1:b;y3:...;y1:l;;;;l2:py1:_;y4:args;;py6:%25apply;"
"y4:args;;;l2:y1:_;y6:%25apply;;",
"call/cc",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:f;;l3:y5:letcc;y1:k;l2:y1:f;y1:k;;"
";;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)",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:p;;l3:y5:letcc;y1:k;l2:y1:p;y1:k;;"
";;l2:py1:_;y4:args;;py8:%25call/cc;y4:args;;;l2:y1:_;y8:%25call/cc;;",
"call-with-current-continuation",
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py7:call/cc;y4:args;;;l2:y1:_;"
"y7:call/cc;;",
"values",
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py5:%25sdmv;y4:args;;;l2:y1:_;"
"y5:%25sdmv;;",
0,
"&0{%2n,.2,,#0.0,.4,&2{%2.0p?{.1,${.3a,:0[01}c,.1d,:1^[22}.1A9]2}.!0.0^"
"_1[22}@!(y5:%25map1)",
"call-with-values",
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py5:%25cwmv;y4:args;;;l2:y1:_;"
"y5:%25cwmv;;",
0,
"&0{%3n,.3,.3,,#0.0,.5,&2{%3.0p?{.1p}{f}?{.2,${.4a,.4a,:0[02}c,.2d,.2d,"
":1^[33}.2A9]3}.!0.0^_1[33}@!(y5:%25map2)",
0,
"&0{%!2.0u?{.2,.2,@(y5:%25map1)[32}.0du?{.0a,.3,.3,@(y5:%25map2)[33}n,."
"1,.4c,,#0.0,.5,&2{%2${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{.1d,:0^[21}f]2}"
".!0.0^_1[01}?{.1,${${.5,@(y13:%25residual-car),@(y5:%25map1)[02},:0,@("
"y13:apply-to-list)[02}c,${.3,@(y13:%25residual-cdr),@(y5:%25map1)[02},"
":1^[22}.1A9]2}.!0.0^_1[32}@!(y4:%25map)",
"map",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y3:fun;y3:lst;;l3:y3:let;l1:l2:y1:f;y"
"3:fun;;;l4:y3:let;y4:loop;l1:l2:y1:l;y3:lst;;;l4:y2:if;l2:y5:pair?;y1:"
"l;;l3:y4:cons;l2:y1:f;l2:y3:car;y1:l;;;l2:y4:loop;l2:y3:cdr;y1:l;;;;l2"
":y5:quote;n;;;;;;l2:py1:_;y4:args;;py13:%25residual-map;y4:args;;;l2:y"
"1:_;y13:%25residual-map;;",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:p;y1:l;;l3:y5:%25map1;y1:p;y1:l;;;"
"l2:l4:y1:_;y1:p;y2:l1;y2:l2;;l4:y5:%25map2;y1:p;y2:l1;y2:l2;;;l2:py1:_"
";y4:args;;py4:%25map;y4:args;;;l2:y1:_;y4:%25map;;",
0,
"&0{%2.1,,#0.2,.1,&2{%1.0p?{${.2a,:1[01}.0d,:0^[11}]1}.!0.0^_1[21}@!(y1"
"0:%25for-each1)",
0,
"&0{%3.2,.2,,#0.3,.1,&2{%2.0p?{.1p}{f}?{${.3a,.3a,:1[02}.1d,.1d,:0^[22}"
"]2}.!0.0^_1[32}@!(y10:%25for-each2)",
0,
"&0{%!2.0u?{.2,.2,@(y10:%25for-each1)[32}.0du?{.0a,.3,.3,@(y10:%25for-e"
"ach2)[33}.0,.3c,,#0.3,.1,&2{%1${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{.1d,:"
"0^[21}f]2}.!0.0^_1[01}?{${${.4,@(y13:%25residual-car),@(y5:%25map1)[02"
"},:1,@(y13:apply-to-list)[02}${.2,@(y13:%25residual-cdr),@(y5:%25map1)"
"[02},:0^[11}]1}.!0.0^_1[31}@!(y9:%25for-each)",
"for-each",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y3:fun;y3:lst;;l3:y3:let;l1:l2:y1:f;y"
"3:fun;;;l4:y3:let;y4:loop;l1:l2:y1:l;y3:lst;;;l3:y2:if;l2:y5:pair?;y1:"
"l;;l3:y5:begin;l2:y1:f;l2:y3:car;y1:l;;;l2:y4:loop;l2:y3:cdr;y1:l;;;;;"
";;;l2:py1:_;y4:args;;py18:%25residual-for-each;y4:args;;;l2:y1:_;y18:%"
"25residual-for-each;;",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:p;y1:l;;l3:y10:%25for-each1;y1:p;y"
"1:l;;;l2:l4:y1:_;y1:p;y2:l1;y2:l2;;l4:y10:%25for-each2;y1:p;y2:l1;y2:l"
"2;;;l2:py1:_;y4:args;;py9:%25for-each;y4:args;;;l2:y1:_;y9:%25for-each"
";;",
0,
"&0{%!2.0u?{.2S3,'(c ),.1S2,'0,,#0.0,.3,.8,.8,.7,&5{%1:0,.1I<!?{:3]1}${"
".2,:2S4,:1[01},.1,:3S5.0'1,.1I+,:4^[11}.!0.0^_1[51}${@(y13:%25string->"
"list),${.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!"
"0.0^_1[01}_1,.4c,@(y13:%25residual-map),@(y5:%25appl)[02}X3]3}@!(y10:s"
"tring-map)",
".2,:2S4,:1[01},.1,:3S5.0'1,.1I+,:4^[11}.!0.0^_1[51}${${.4,.7c,@(y13:%2"
"5string->list),@(y5:%25map1)[02},.4c,@(y4:%25map),@(y13:apply-to-list)"
"[02}X3]3}@!(y10:string-map)",
0,
"&0{%!2.0u?{.2V3,f,.1V2,'0,,#0.0,.3,.8,.8,.7,&5{%1:0,.1I<!?{:3]1}${.2,:"
"2V4,:1[01},.1,:3V5.0'1,.1I+,:4^[11}.!0.0^_1[51}${@(y13:%25vector->list"
"),${.5,.8c,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^"
"_1[01}_1,.4c,@(y13:%25residual-map),@(y5:%25appl)[02}X1]3}@!(y10:vecto"
"r-map)",
"2V4,:1[01},.1,:3V5.0'1,.1I+,:4^[11}.!0.0^_1[51}${${.4,.7c,@(y13:%25vec"
"tor->list),@(y5:%25map1)[02},.4c,@(y4:%25map),@(y13:apply-to-list)[02}"
"X1]3}@!(y10:vector-map)",
0,
"&0{%!2.0u?{.2S3,'0,,#0.2,.6,.6,.3,&4{%1:3,.1I<!,.0?{.0]2}${.3,:2S4,:1["
"01}.1'1,.2I+,:0^[21}.!0.0^_1[41}@(y13:%25string->list),${.3,.6c,,#0.4,"
".1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.2c,@(y1"
"8:%25residual-for-each),@(y5:%25appl)[32}@!(y15:string-for-each)",
"01}.1'1,.2I+,:0^[21}.!0.0^_1[41}${.2,.5c,@(y13:%25string->list),@(y5:%"
"25map1)[02},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32}@!(y15:strin"
"g-for-each)",
0,
"&0{%!2.0u?{.2V3,'0,,#0.2,.6,.6,.3,&4{%1:3,.1I<!,.0?{.0]2}${.3,:2V4,:1["
"01}.1'1,.2I+,:0^[21}.!0.0^_1[41}@(y13:%25vector->list),${.3,.6c,,#0.4,"
".1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.2c,@(y1"
"8:%25residual-for-each),@(y5:%25appl)[32}@!(y15:vector-for-each)",
"01}.1'1,.2I+,:0^[21}.!0.0^_1[41}${.2,.5c,@(y13:%25vector->list),@(y5:%"
"25map1)[02},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32}@!(y15:vecto"
"r-for-each)",
0,
"&0{%1.0P00,.0?{.0]2}.1P01]2}@!(y5:port?)",
@ -275,8 +292,9 @@ char *s_code[] = {
"&0{%1.0P00?{.0P60}.0P01?{.0P61]1}]1}@!(y10:close-port)",
0,
"&0{%2.0,&1{%!0${:0,@(y10:close-port)[01}.0,@(y5:%25sdmv),@(y5:%25appl)"
"[12},.1,.3,&2{%0:1,:0[01},@(y5:%25cwmv)[22}@!(y14:call-with-port)",
"&0{%2.0,&1{%!0${:0,@(y10:close-port)[01}.0,@(y5:%25sdmv),@(y13:apply-t"
"o-list)[12},.1,.3,&2{%0:1,:0[01},@(y5:%25cwmv)[22}@!(y14:call-with-por"
"t)",
0,
"&0{%2.1,.1P40,@(y14:call-with-port)[22}@!(y20:call-with-input-file)",
@ -289,10 +307,6 @@ char *s_code[] = {
".2C=}_1?{.0R8?{.1}{f}?{.0]2}:1P9,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}:1,."
"1W0f,:0^[21}.!0.0^_1[31}@!(y9:read-line)",
0,
"&0{%!1.0u?{f,.2,@(y10:%25make-list)[22}.0a,.2,@(y10:%25make-list)[22}@"
"!(y19:%25residual-make-list)",
"minmax-reducer",
"l3:y12:syntax-rules;n;l2:l2:y1:_;y1:f;;l3:y6:lambda;py1:x;y4:args;;l4:"
"y3:let;y4:loop;l2:l2:y1:x;y1:x;;l2:y4:args;y4:args;;;l4:y2:if;l2:y5:nu"
@ -300,32 +314,8 @@ char *s_code[] = {
"r;y4:args;;;;;;;",
0,
"&0{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[22}@"
"!(y15:%25residual-list*)",
0,
"&0{%!2${.2,.5,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[02"
"},.2,@(y5:%25appl)[32}@!(y15:%25residual-apply)",
0,
"&0{%!2.0u?{n,.3,,#0.0,.5,&2{%2.0p?{.1,${.3a,:0[01}c,.1d,:1^[22}.1A9]2}"
".!0.0^_1[32}n,.1,.4c,,#0.0,.5,&2{%2${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{"
".1d,:0^[21}f]2}.!0.0^_1[01}?{.1,${@(y3:car),${.6,,#0.4,.1,&2{%1.0p?{${"
".2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:0,@(y5:%25appl)[02}c,@"
"(y3:cdr),${.4,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0"
".0^_1[01}_1,:1^[22}.1A9]2}.!0.0^_1[32}@!(y13:%25residual-map)",
0,
"&0{%!2.0u?{.2,,#0.3,.1,&2{%1.0p?{${.2a,:1[01}.0d,:0^[11}]1}.!0.0^_1[31"
"}.0,.3c,,#0.3,.1,&2{%1${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{.1d,:0^[21}f]"
"2}.!0.0^_1[01}?{${@(y3:car),${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3"
"a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:1,@(y5:%25appl)[02}@(y3:cdr),${.3,,#0."
"4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:0^[11"
"}]1}.!0.0^_1[31}@!(y18:%25residual-for-each)",
0,
"&0{%!0.0,,#0.0,&1{%1.0u?{n]1}.0du?{.0a]1}${.2d,:0^[01},.1aL6]1}.!0.0^_"
"1[11}@!(y16:%25residual-append)",
"&0{%!0.0,,#0.0,&1{%1.0u?{n]1}.0du?{.0a]1}${.2d,:0^[01},.1a,@(y8:list-c"
"at)[12}.!0.0^_1[11}@!(y16:%25residual-append)",
0, 0
};

View file

@ -359,7 +359,7 @@
[(#\0) (= n 0)] [(#\1) (= n 1)] [(#\2) (= n 2)] [(#\3) (= n 3)]
[(#\p) (>= n 0)] [(#\m) (>= n 1)] [(#\c) (>= n 2)] [(#\x) (>= n 1)]
[(#\u) (<= 0 n 1)] [(#\b) (<= 1 n 2)]
[(#\#) (>= n 0)]
[(#\#) (>= n 0)] [(#\@) #f]
[else #f]))
(define (xform-integrable ig tail env)

155
src/s.scm
View file

@ -180,10 +180,10 @@
; (modulo x y) = floor-remainder
(define (floor/ x y)
(%sdmv (floor-quotient x y) (floor-remainder x y)))
(values (floor-quotient x y) (floor-remainder x y)))
(define (truncate/ x y)
(%sdmv (truncate-quotient x y) (truncate-remainder x y)))
(values (truncate-quotient x y) (truncate-remainder x y)))
;---------------------------------------------------------------------------------------------
@ -261,30 +261,25 @@
;---------------------------------------------------------------------------------------------
; (list? x)
(define (%make-list n i)
(let loop ([n (%ckk n)] [l '()])
(if (fx<=? n 0) l (loop (fx- n 1) (cons i l)))))
(define-syntax make-list
(syntax-rules ()
[(_ n) (%make-list n #f)] ; #f > (void)
[(_ n i) (%make-list n i)]
[(_ . args) (%residual-make-list . args)]
[_ %residual-make-list]))
; (list x ...)
; (make-list n (i #f))
; (length l)
; (list-ref l i)
; (list-set! l i x)
; (list-cat l1 l2)
(define (%append . args)
(let loop ([args args])
(cond [(null? args) '()]
[(null? (cdr args)) (car args)]
[else (list-cat (car args) (loop (cdr args)))])))
(define-syntax append
(syntax-rules ()
[(_) '()] [(_ x) x]
[(_ x y) (list-cat x y)]
[(_ x y z ...) (list-cat x (append y z ...))]
[_ %residual-append]))
[_ %append]))
; (memq v l)
; (memv v l) ; TODO: make sure memv checks list
@ -331,13 +326,17 @@
; (reverse l)
; (reverse! l)
(define (%list* x . l)
(let loop ([x x] [l l])
(if (null? l) x (cons x (loop (car l) (cdr l))))))
(define-syntax list*
(syntax-rules ()
[(_ x) x]
[(_ x y) (cons x y)]
[(_ x y z ...) (cons x (list* y z ...))]
[(_ . args) (%residual-list* . args)]
[_ %residual-list*]))
[(_ . args) (%list* . args)]
[_ %list*]))
(define-syntax cons* list*)
@ -361,13 +360,13 @@
(define %vector->list
(case-lambda
[(vec) (%vtol vec)]
[(vec) (%vector->list1 vec)]
[(vec start) (subvector->list vec start (vector-length vec))]
[(vec start end) (subvector->list vec start end)]))
(define-syntax vector->list
(syntax-rules ()
[(_ x) (%vtol x)]
[(_ x) (%vector->list1 x)]
[(_ . r) (%vector->list . r)]
[_ %vector->list]))
@ -466,13 +465,13 @@
(define %string->list
(case-lambda
[(str) (%stol str)]
[(str) (%string->list1 str)]
[(str start) (substring->list str start (string-length str))]
[(str start end) (substring->list str start end)]))
(define-syntax string->list
(syntax-rules ()
[(_ x) (%stol x)]
[(_ x) (%string->list1 x)]
[(_ . r) (%string->list . r)]
[_ %string->list]))
@ -582,38 +581,87 @@
; (procedure? x)
(define (%apply p x . l)
(apply-to-list p
(let loop ([x x] [l l])
(if (null? l) x (cons x (loop (car l) (cdr l)))))))
(define-syntax apply
(syntax-rules ()
[(_ p l) (%appl p l)]
[(_ p a b ... l) (%appl p (list* a b ... l))]
[(_ . args) (%residual-apply . args)]
[_ %residual-apply]))
[(_ p l) (apply-to-list p l)]
[(_ p a b ... l) (apply-to-list p (list* a b ... l))]
[(_ . args) (%apply . args)]
[_ %apply]))
(define-inline (call/cc f) %residual-call/cc (letcc k (f k)))
; (%call/cc p)
(define-syntax call/cc
(syntax-rules ()
[(_ p) (letcc k (p k))]
[(_ . args) (%call/cc . args)]
[_ %call/cc]))
(define-syntax call-with-current-continuation call/cc)
(define-syntax values %sdmv)
; (values x ...)
; (call-with-values thunk receiver)
(define-syntax call-with-values %cwmv)
(define (%map1 p l)
(let loop ([l l] [r '()])
(if (pair? l)
(loop (cdr l) (cons (p (car l)) r))
(reverse! r))))
(define (%map2 p l1 l2)
(let loop ([l1 l1] [l2 l2] [r '()])
(if (and (pair? l1) (pair? l2))
(loop (cdr l1) (cdr l2) (cons (p (car l1) (car l2)) r))
(reverse! r))))
(define (%map p l . l*)
(cond [(null? l*) (%map1 p l)]
[(null? (cdr l*)) (%map2 p l (car l*))]
[else
(let loop ([l* (cons l l*)] [r '()])
(if (let lp ([l* l*])
(or (null? l*) (and (pair? (car l*)) (lp (cdr l*)))))
(loop (%map1 cdr l*) (cons (apply p (%map1 car l*)) r))
(reverse! r)))]))
(define-syntax map
(syntax-rules ()
[(_ fun lst)
(let ([f fun])
(let loop ([l lst])
(if (pair? l) (cons (f (car l)) (loop (cdr l))) '())))]
[(_ . args) (%residual-map . args)]
[_ %residual-map]))
[(_ p l) (%map1 p l)]
[(_ p l1 l2) (%map2 p l1 l2)]
[(_ . args) (%map . args)]
[_ %map]))
(define (%for-each1 p l)
(let loop ([l l])
(if (pair? l)
(begin (p (car l))
(loop (cdr l))))))
(define (%for-each2 p l1 l2)
(let loop ([l1 l1] [l2 l2])
(if (and (pair? l1) (pair? l2))
(begin (p (car l1) (car l2))
(loop (cdr l1) (cdr l2))))))
(define (%for-each p l . l*)
(cond [(null? l*) (%for-each1 p l)]
[(null? (cdr l*)) (%for-each2 p l (car l*))]
[else
(let loop ([l* (cons l l*)])
(if (let lp ([l* l*])
(or (null? l*) (and (pair? (car l*)) (lp (cdr l*)))))
(begin (apply p (map car l*)) (loop (map cdr l*)))))]))
(define-syntax for-each
(syntax-rules ()
[(_ fun lst)
(let ([f fun])
(let loop ([l lst])
(if (pair? l) (begin (f (car l)) (loop (cdr l))))))]
[(_ . args) (%residual-for-each . args)]
[_ %residual-for-each]))
[(_ p l) (%for-each1 p l)]
[(_ p l1 l2) (%for-each2 p l1 l2)]
[(_ . args) (%for-each . args)]
[_ %for-each]))
(define (string-map p s . s*)
(if (null? s*)
@ -807,8 +855,6 @@
(let ([y (car args)])
(and (f x y) (loop y (cdr args))))))))]))
(define %residual-make-list (unary-binary-adaptor make-list))
(define-syntax minmax-reducer
(syntax-rules ()
[(_ f)
@ -840,31 +886,6 @@
x
(loop (f x (car args)) (cdr args))))))]))
(define (%residual-list* x . l)
(let loop ([x x] [l l])
(if (null? l) x (cons x (loop (car l) (cdr l))))))
(define (%residual-apply f x . l)
(apply f
(let loop ([x x] [l l])
(if (null? l) x (cons x (loop (car l) (cdr l)))))))
(define (%residual-map p l . l*)
(if (null? l*)
(let loop ([l l] [r '()])
(if (pair? l) (loop (cdr l) (cons (p (car l)) r)) (reverse! r)))
(let loop ([l* (cons l l*)] [r '()])
(if (let lp ([l* l*]) (or (null? l*) (and (pair? (car l*)) (lp (cdr l*)))))
(loop (map cdr l*) (cons (apply p (map car l*)) r))
(reverse! r)))))
(define (%residual-for-each p l . l*)
(if (null? l*)
(let loop ([l l]) (if (pair? l) (begin (p (car l)) (loop (cdr l)))))
(let loop ([l* (cons l l*)])
(if (let lp ([l* l*]) (or (null? l*) (and (pair? (car l*)) (lp (cdr l*)))))
(begin (apply p (map car l*)) (loop (map cdr l*)))))))
(define-syntax append-reducer
(syntax-rules ()
[(_ f s)

95
t.c
View file

@ -108,7 +108,7 @@ char *t_code[] = {
"@(y4:assq)@!(y16:find-top-binding)",
0,
"&0{%1,#0n,.2c.!0.0,&1{%0:0^]0}]2}@!(y6:new-id)",
"&0{%1,#0.1,l1.!0.0,&1{%0:0^]0}]2}@!(y6:new-id)",
0,
"&0{%1${.2[00}a]1}@!(y7:old-den)",
@ -154,9 +154,8 @@ char *t_code[] = {
0,
"&0{%2${.2,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@(y7:id->sym)[11}.0p?{${.2"
"d,:0^[01},${.3a,:0^[01}c]1}.0V0?{:0^,${.3X0,,#0.4,.1,&2{%1.0p?{${.2d,:"
"0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1X1]1}.0]1}.!0.0^_1[01},'(y5:q"
"uote),l2]2}@!(y11:xform-quote)",
"d,:0^[01},${.3a,:0^[01}c]1}.0V0?{${.2X0,:0^,@(y5:%25map1)[02}X1]1}.0]1"
"}.!0.0^_1[01},'(y5:quote),l2]2}@!(y11:xform-quote)",
0,
"&0{%2${.2,.4[01},.0Y0?{.0,'(y3:ref),l2]3}.0,@(y11:binding-val)[31}@!(y"
@ -170,23 +169,22 @@ char *t_code[] = {
"5:error)[62}@!(y10:xform-set!)",
0,
"&0{%2.0L0?{.1,&1{%1:0,.1,f,@(y5:xform)[13},${.3,,#0.4,.1,&2{%1.0p?{${."
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.0p?{.0du}{f}?{.0a]3}.0,"
"'(y5:begin)c]3}'(s19:improper begin form),'(y9:transform),@(y5:error)["
"22}@!(y11:xform-begin)",
"&0{%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0p?"
"{.0du}{f}?{.0a]3}.0,'(y5:begin)c]3}'(s19:improper begin form),'(y9:tra"
"nsform),@(y5:error)[22}@!(y11:xform-begin)",
0,
"&0{%2.0L0?{.1,&1{%1:0,.1,f,@(y5:xform)[13},${.3,,#0.4,.1,&2{%1.0p?{${."
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.0g,'(l1:i2;),.1A1?{'(l1"
":l1:y5:begin;;),.2L6,'(y2:if)c]4}'(l1:i3;),.1A1?{.1,'(y2:if)c]4}t?{'(s"
"17:malformed if form),'(y9:transform),@(y5:error)[42}f]4}'(s16:imprope"
"r if form),'(y9:transform),@(y5:error)[22}@!(y8:xform-if)",
"&0{%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0g,"
"'(l1:i2;),.1A1?{'(l1:l1:y5:begin;;),.2L6,'(y2:if)c]4}'(l1:i3;),.1A1?{."
"1,'(y2:if)c]4}t?{'(s17:malformed if form),'(y9:transform),@(y5:error)["
"42}f]4}'(s16:improper if form),'(y9:transform),@(y5:error)[22}@!(y8:xf"
"orm-if)",
0,
"&0{%3.1L0?{.2,&1{%1:0,.1,f,@(y5:xform)[13},${.4,,#0.4,.1,&2{%1.0p?{${."
"2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,.0u?{'(y6:lambda),.2aq?{"
".1dau}{f}}{f}?{.1dda]4}.0,.2,'(y4:call),@(y5:pair*)[43}'(s20:improper "
"application),'(y9:transform),@(y5:error)[32}@!(y10:xform-call)",
"&0{%3.1L0?{${.3,.5,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0u?"
"{'(y6:lambda),.2aq?{.1dau}{f}}{f}?{.1dda]4}.0,.2,'(y4:call),@(y5:pair*"
")[43}'(s20:improper application),'(y9:transform),@(y5:error)[32}@!(y10"
":xform-call)",
0,
"&0{%2.0L0?{n,.2,.2a,,#0.4,.1,&2{%3.0p?{.0a,${${.4,@(y7:id->sym)[01},@("
@ -197,11 +195,11 @@ char *t_code[] = {
" lambda body),'(y9:transform),@(y5:error)[22}@!(y12:xform-lambda)",
0,
"&0{%2.0L0?{.1,&1{%1${.2,@(y6:list2?)[01}?{${:0,.3da,f,@(y5:xform)[03},"
"${.3a,@(y15:normalize-arity)[01},l2]1}'(s23:improper lambda* clause),'"
"(y9:transform),@(y5:error)[12},${.3,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},$"
"{.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,'(y7:lambda*)c]2}'(s21:improper lamb"
"da* form),'(y9:transform),@(y5:error)[22}@!(y13:xform-lambda*)",
"&0{%2.0L0?{${.2,.4,&1{%1${.2,@(y6:list2?)[01}?{${:0,.3da,f,@(y5:xform)"
"[03},${.3a,@(y15:normalize-arity)[01},l2]1}'(s23:improper lambda* clau"
"se),'(y9:transform),@(y5:error)[12},@(y5:%25map1)[02},'(y7:lambda*)c]2"
"}'(s21:improper lambda* form),'(y9:transform),@(y5:error)[22}@!(y13:xf"
"orm-lambda*)",
0,
"&0{%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?)[01}}{f}?{.0a,${${.4,@(y7:"
@ -215,7 +213,7 @@ char *t_code[] = {
"ansform),@(y5:error)[22}@!(y12:xform-withcc)",
0,
"&0{%2.0u?{n,'(y5:begin)c]2}.0,n,n,n,.5,,#0.0,&1{%5.4p?{.4ap}{f}?{.4d,."
"&0{%2.0u?{'(y5:begin),l1]2}.0,n,n,n,.5,,#0.0,&1{%5.4p?{.4ap}{f}?{.4d,."
"5a,.0a,${.5,.3,t,@(y5:xform)[03},.0,'(l1:y5:begin;),.1A1?{.4,.4dL6,.9,"
".9,.9,.9,:0^[(i10)5}'(l1:y6:define;),.1A1?{.3da,.4dda,${${.5,@(y7:id->"
"sym)[01},@(y6:gensym)[01},${.(i10),.3,.6,@(y7:add-var)[03},.8,.(i13),."
@ -227,14 +225,13 @@ char *t_code[] = {
"0.0^_1[25}@!(y10:xform-body)",
0,
"&0{%5n,n,.4,.4,.4,,#0.0,.(i11),.(i11),&3{%5.0u?{:1,&1{%1:0,.1,f,@(y5:x"
"form)[13},${:0,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!"
"0.0^_1[01}_1,.4A8L6,.0p?{.0du}{f}?{.0a}{.0,'(y5:begin)c},.6u?{.0]7}&0{"
"%1'(l1:y5:begin;)]1},${.9,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01"
"}c]1}n]1}.!0.0^_1[01}_1,.1,.8A8,'(y6:lambda),l3,'(y4:call),@(y5:pair*)"
"[73}.2aY0?{.4,.3ac,.4,${:1,.6a,.6a,@(y10:xform-set!)[03}c,.4d,.4d,.4d,"
":2^[55}${${:1,.6a,t,@(y5:xform)[03},${.5a,:1[01},@(y16:binding-set-val"
"!)[02}.4,.4,.4d,.4d,.4d,:2^[55}.!0.0^_1[55}@!(y12:xform-labels)",
"&0{%5n,n,.4,.4,.4,,#0.0,.(i11),.(i11),&3{%5.0u?{${:0,:1,&1{%1:0,.1,f,@"
"(y5:xform)[13},@(y5:%25map1)[02},.4A8L6,.0p?{.0du}{f}?{.0a}{.0,'(y5:be"
"gin)c},.6u?{.0]7}${.8,&0{%1'(l1:y5:begin;)]1},@(y5:%25map1)[02},.1,.8A"
"8,'(y6:lambda),l3,'(y4:call),@(y5:pair*)[73}.2aY0?{.4,.3ac,.4,${:1,.6a"
",.6a,@(y10:xform-set!)[03}c,.4d,.4d,.4d,:2^[55}${${:1,.6a,t,@(y5:xform"
")[03},${.5a,:1[01},@(y16:binding-set-val!)[02}.4,.4,.4d,.4d,.4d,:2^[55"
"}.!0.0^_1[55}@!(y12:xform-labels)",
0,
"&0{%3${.2,@(y3:id?)[01}?{${.4,.4,f,@(y5:xform)[03},${.3,@(y7:id->sym)["
@ -295,26 +292,22 @@ char *t_code[] = {
"0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{${:7^[00}}_1.3,.3X0,"
".3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1ddg,.3L0?{.3g}{${:7^["
"00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${:4^,t,.(i10)a,:5^[0"
"3},,#0.8,:6,&2{%1@(y3:cdr),${n,.4,:1a,:0^[03},,#0.2,.1,&2{%1.0p?{${.2d"
",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[21}.!0${.(i12),.6,.(i12)dd,:6^[0"
"3},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0"
".0^_1[01}_1,.5c,@(y14:%25residual-list)c,@(y13:%25residual-map),@(y5:%"
"25appl)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[03},.3a,.3a,:6^[43}:7^[40}.!"
"0.0^_1[63}.!5.7,.2,.6,.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0[01},@(y6:new-"
"id)[01},.1c]1},${${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[03},,#0.4,.1,&"
"2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1.!0${:2^,f,.7"
",:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,."
"4,.2,.8,:0,&5{%2.0,,#0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:3"
",.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:2^[01}X1"
"]1}.0p?{${.2d,:6^[01}?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A3d]1}.!0.2,.4"
",:4,&3{%!0${.2,:2,@(y4:cons),@(y13:%25residual-map)[03},:1a,:0^[12}.!1"
".0^,${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1"
"[01}_1,${.6dd,:2^[01},${.3,.6^c,@(y13:%25residual-map),@(y5:%25appl)[0"
"2}L6]5}${.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!6"
".(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid sy"
"ntax),'(y9:transform),@(y5:error)[03}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},"
".0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i11)}@!(y13:syntax-rul"
"es*)",
"3},,#0:6,.9,&2{%1${n,.3,:0a,:1^[03},@(y3:cdr),@(y5:%25map1)[12}.!0${.("
"i12),.6,.(i12)dd,:6^[03},${${.7,.6^,@(y5:%25map1)[02},.5c,@(y4:list)c,"
"@(y4:%25map),@(y13:apply-to-list)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[03"
"},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[63}.!5.7,.2,.6,.5,&4{%3,,,#0#1#2${${."
"9,&1{%1:0,.1A3~]1},t,.(i10),:1^[03},:3,&1{%1${${.4,:0[01},@(y6:new-id)"
"[01},.1c]1},@(y5:%25map1)[02}.!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%1:1,&1{"
"%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,.2,.8,:0,&5{%2.0,,#0:0,:1,"
":2,.6,.4,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:3,.1A3,.0?{.0}{:0,.2A3,.0?{.0"
"}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:2^[01}X1]1}.0p?{${.2d,:6^[01}?{${.2a"
",:5^[01},,,#0#1:3,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y4:cons)"
",@(y5:%25map2)[03},:1a,:0^[12}.!1${.4,.3^,@(y5:%25map1)[02},${.6dd,:2^"
"[01},${.3,.6^c,@(y4:%25map),@(y13:apply-to-list)[02}L6]5}${.2d,:2^[01}"
",${.3a,:2^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!6.(i10),.7,.7,&3{%2:2"
",,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid syntax),'(y9:transform"
"),@(y5:error)[03}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^["
"63}.4d,:0^[51}.!0.0^_1[21}](i11)}@!(y13:syntax-rules*)",
0,
"${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n"