mirror of
https://github.com/false-schemers/skint.git
synced 2025-02-01 07:57:49 +01:00
new integrable model, part IV (list ops &c.)
This commit is contained in:
ESL
parent
94dc0fb0c1
commit
328046cf4a
6 changed files with 995 additions and 1275 deletions
4
i.c
4
i.c
|
|
@ -3263,10 +3263,10 @@ static obj *rds_global_loc(obj *r, obj *sp, obj *hp)
|
|||
if (issymbol(ra)) {
|
||||
obj p = isassv(ra, cx__2Aglobals_2A);
|
||||
if (ispair(p)) ra = cdr(p);
|
||||
else { /* prepend (sym . #&undefined) to *globals* */
|
||||
else { /* prepend (sym . #&sym) to *globals* */
|
||||
obj box;
|
||||
hreserve(hbsz(2)*1+hbsz(3)*2, sp-r);
|
||||
*--hp = mksymbol(internsym("undefined"));
|
||||
*--hp = ra; /* mksymbol(internsym("undefined")); */
|
||||
*--hp = obj_from_size(BOX_BTAG); box = hendblk(2);
|
||||
*--hp = box; *--hp = ra;
|
||||
*--hp = obj_from_size(PAIR_BTAG); ra = hendblk(3);
|
||||
|
|
|
|||
100
i.h
100
i.h
|
|
@ -223,24 +223,24 @@ 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, "%isq", 2, INLINED)
|
||||
declare_instruction(isv, "v", 0, "%isv", 2, INLINED)
|
||||
declare_instruction(ise, "e", 0, "%ise", 2, INLINED)
|
||||
declare_instruction(box, "b", 0, "%box", 1, INLINED)
|
||||
declare_instruction(unbox, "z", 0, "%unbox", 1, INLINED)
|
||||
declare_instruction(setbox, "z!", 0, "%setbox", 2, INLINED)
|
||||
declare_instruction(car, "a", 0, "%car", 1, INLINED)
|
||||
declare_instruction(setcar, "a!", 0, "%setcar", 2, INLINED)
|
||||
declare_instruction(cdr, "d", 0, "%cdr", 1, INLINED)
|
||||
declare_instruction(setcdr, "d!", 0, "%setcdr", 2, INLINED)
|
||||
declare_instruction(caar, "aa", 0, "%caar", 1, INLINED)
|
||||
declare_instruction(cadr, "da", 0, "%cadr", 1, INLINED)
|
||||
declare_instruction(cdar, "ad", 0, "%cdar", 1, INLINED)
|
||||
declare_instruction(cddr, "dd", 0, "%cddr", 1, INLINED)
|
||||
declare_instruction(nullp, "u", 0, "%nullp", 1, INLINED)
|
||||
declare_instruction(pairp, "p", 0, "%pairp", 1, INLINED)
|
||||
declare_instruction(cons, "c", 0, "%cons", 2, INLINED)
|
||||
declare_instruction(not, "~", 0, "%not", 1, INLINED)
|
||||
declare_instruction(isq, "q", 0, "eq?", '2', AUTOGL)
|
||||
declare_instruction(isv, "v", 0, "eqv?", '2', AUTOGL)
|
||||
declare_instruction(ise, "e", 0, "equal?", '2', AUTOGL)
|
||||
declare_instruction(box, "b", 0, "box", '1', AUTOGL)
|
||||
declare_instruction(unbox, "z", 0, "unbox", '1', AUTOGL)
|
||||
declare_instruction(setbox, "z!", 0, "set-box!", '2', AUTOGL)
|
||||
declare_instruction(car, "a", 0, "car", '1', AUTOGL)
|
||||
declare_instruction(setcar, "a!", 0, "set-car!", '2', AUTOGL)
|
||||
declare_instruction(cdr, "d", 0, "cdr", '1', AUTOGL)
|
||||
declare_instruction(setcdr, "d!", 0, "set-cdr!", '2', AUTOGL)
|
||||
declare_instruction(caar, "aa", 0, "caar", '1', AUTOGL)
|
||||
declare_instruction(cadr, "da", 0, "cadr", '1', AUTOGL)
|
||||
declare_instruction(cdar, "ad", 0, "cdar", '1', AUTOGL)
|
||||
declare_instruction(cddr, "dd", 0, "cddr", '1', AUTOGL)
|
||||
declare_instruction(nullp, "u", 0, "null?", '1', AUTOGL)
|
||||
declare_instruction(pairp, "p", 0, "pair?", '1', AUTOGL)
|
||||
declare_instruction(cons, "c", 0, "cons", '2', AUTOGL)
|
||||
declare_instruction(not, "~", 0, "not", '1', AUTOGL)
|
||||
declare_instruction(izerop, "I=0", 0, "fxzero?", '1', AUTOGL)
|
||||
declare_instruction(iposp, "I>0", 0, "fxpositive?", '1', AUTOGL)
|
||||
declare_instruction(inegp, "I<0", 0, "fxnegative?", '1', AUTOGL)
|
||||
|
|
@ -425,8 +425,8 @@ declare_instruction(cicmp, "O1", 0, "%cicmp", 2, INLINED)
|
|||
declare_instruction(scmp, "O2", 0, "%scmp", 2, INLINED)
|
||||
declare_instruction(sicmp, "O3", 0, "%sicmp", 2, INLINED)
|
||||
declare_instruction(symp, "Y0", 0, "%symp", 1, INLINED)
|
||||
declare_instruction(boolp, "Y1", 0, "%boolp", 1, INLINED)
|
||||
declare_instruction(boxp, "Y2", 0, "%boxp", 1, INLINED)
|
||||
declare_instruction(boolp, "Y1", 0, "boolean?", '1', AUTOGL)
|
||||
declare_instruction(boxp, "Y2", 0, "box?", '1', AUTOGL)
|
||||
declare_instruction(funp, "K0", 0, "%funp", 1, INLINED)
|
||||
declare_instruction(ipp, "P00", 0, "%ipp", 1, INLINED)
|
||||
declare_instruction(opp, "P01", 0, "%opp", 1, INLINED)
|
||||
|
|
@ -456,41 +456,41 @@ declare_instruction(wrhw, "W7", 0, "%wrhw", 2, INLINED)
|
|||
declare_instruction(wriw, "W8", 0, "%wriw", 2, INLINED)
|
||||
|
||||
/* serialization and deserialization instructions */
|
||||
declare_instruction(igp, "U0", 0, "integrable?", '1', AUTOGL)
|
||||
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(igty, "U6", 0, "integrable-type", '1', AUTOGL)
|
||||
declare_instruction(iggl, "U7", 0, "integrable-global", '1', AUTOGL)
|
||||
declare_instruction(igco, "U8", 0, "integrable-code", '2', AUTOGL)
|
||||
declare_instruction(igco, "U8", 0, "integrable-code", '2', AUTOGL)
|
||||
|
||||
/* inlined integrables (no custom instructions) */
|
||||
declare_integrable(NULL, "aaa", 0, "%caaar", 1, INLINED)
|
||||
declare_integrable(NULL, "daa", 0, "%caadr", 1, INLINED)
|
||||
declare_integrable(NULL, "ada", 0, "%cadar", 1, INLINED)
|
||||
declare_integrable(NULL, "dda", 0, "%caddr", 1, INLINED)
|
||||
declare_integrable(NULL, "aad", 0, "%cdaar", 1, INLINED)
|
||||
declare_integrable(NULL, "dad", 0, "%cdadr", 1, INLINED)
|
||||
declare_integrable(NULL, "add", 0, "%cddar", 1, INLINED)
|
||||
declare_integrable(NULL, "ddd", 0, "%cdddr", 1, INLINED)
|
||||
declare_integrable(NULL, "aaaa", 0, "%caaaar", 1, INLINED)
|
||||
declare_integrable(NULL, "daaa", 0, "%caaadr", 1, INLINED)
|
||||
declare_integrable(NULL, "adaa", 0, "%caadar", 1, INLINED)
|
||||
declare_integrable(NULL, "ddaa", 0, "%caaddr", 1, INLINED)
|
||||
declare_integrable(NULL, "aada", 0, "%cadaar", 1, INLINED)
|
||||
declare_integrable(NULL, "dada", 0, "%cadadr", 1, INLINED)
|
||||
declare_integrable(NULL, "adda", 0, "%caddar", 1, INLINED)
|
||||
declare_integrable(NULL, "ddda", 0, "%cadddr", 1, INLINED)
|
||||
declare_integrable(NULL, "aaad", 0, "%cdaaar", 1, INLINED)
|
||||
declare_integrable(NULL, "daad", 0, "%cdaadr", 1, INLINED)
|
||||
declare_integrable(NULL, "adad", 0, "%cdadar", 1, INLINED)
|
||||
declare_integrable(NULL, "ddad", 0, "%cdaddr", 1, INLINED)
|
||||
declare_integrable(NULL, "aadd", 0, "%cddaar", 1, INLINED)
|
||||
declare_integrable(NULL, "dadd", 0, "%cddadr", 1, INLINED)
|
||||
declare_integrable(NULL, "addd", 0, "%cdddar", 1, INLINED)
|
||||
declare_integrable(NULL, "dddd", 0, "%cddddr", 1, INLINED)
|
||||
declare_integrable(NULL, "aaa", 0, "caaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daa", 0, "caadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ada", 0, "cadar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dda", 0, "caddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aad", 0, "cdaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dad", 0, "cdadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "add", 0, "cddar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddd", 0, "cdddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aaaa", 0, "caaaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daaa", 0, "caaadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "adaa", 0, "caadar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddaa", 0, "caaddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aada", 0, "cadaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dada", 0, "cadadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "adda", 0, "caddar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddda", 0, "cadddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aaad", 0, "cdaaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daad", 0, "cdaadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "adad", 0, "cdadar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddad", 0, "cdaddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aadd", 0, "cddaar", '1', AUTOGL)
|
||||
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")
|
||||
|
|
|
|||
372
s.c
372
s.c
|
|
@ -2,61 +2,29 @@
|
|||
|
||||
char *s_code[] = {
|
||||
|
||||
"eq?",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25isq;y1:x;y1:y;;;l"
|
||||
"2:py1:_;y12:syntax-rules;;py13:%25residual-eq?;y12:syntax-rules;;;l2:y"
|
||||
"1:_;y13:%25residual-eq?;;",
|
||||
0,
|
||||
"@(y4:cons)@!(y14:%25residual-cons)",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1q]2}@!(y13:%25residual-eq?)",
|
||||
|
||||
"eqv?",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25isv;y1:x;y1:y;;;l"
|
||||
"2:py1:_;y12:syntax-rules;;py14:%25residual-eqv?;y12:syntax-rules;;;l2:"
|
||||
"y1:_;y14:%25residual-eqv?;;",
|
||||
"@(y5:pair?)@!(y15:%25residual-pair?)",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1v]2}@!(y14:%25residual-eqv?)",
|
||||
|
||||
"equal?",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25ise;y1:x;y1:y;;;l"
|
||||
"2:py1:_;y12:syntax-rules;;py16:%25residual-equal?;y12:syntax-rules;;;l"
|
||||
"2:y1:_;y16:%25residual-equal?;;",
|
||||
"@(y3:car)@!(y13:%25residual-car)",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1e]2}@!(y16:%25residual-equal?)",
|
||||
|
||||
"box?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25boxp;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py14:%25residual-box?;y12:syntax-rules;;;l2:y1:_;y14:"
|
||||
"%25residual-box?;;",
|
||||
"@(y3:car)@!(y4:%25car)",
|
||||
|
||||
0,
|
||||
"&0{%1.0Y2]1}@!(y14:%25residual-box?)",
|
||||
|
||||
"box",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25box;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py13:%25residual-box;y12:syntax-rules;;;l2:y1:_;y13:%2"
|
||||
"5residual-box;;",
|
||||
"@(y3:cdr)@!(y13:%25residual-cdr)",
|
||||
|
||||
0,
|
||||
"&0{%1.0b]1}@!(y13:%25residual-box)",
|
||||
|
||||
"unbox",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25unbox;y1:x;;;l2:py1:_;"
|
||||
"y12:syntax-rules;;py15:%25residual-unbox;y12:syntax-rules;;;l2:y1:_;y1"
|
||||
"5:%25residual-unbox;;",
|
||||
"@(y3:cdr)@!(y4:%25cdr)",
|
||||
|
||||
0,
|
||||
"&0{%1.0z]1}@!(y15:%25residual-unbox)",
|
||||
|
||||
"set-box!",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y7:%25setbox;y1:x;y1:y;"
|
||||
";;l2:py1:_;y12:syntax-rules;;py18:%25residual-set-box!;y12:syntax-rule"
|
||||
"s;;;l2:y1:_;y18:%25residual-set-box!;;",
|
||||
"@(y8:set-car!)@!(y18:%25residual-set-car!)",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1z!]2}@!(y18:%25residual-set-box!)",
|
||||
"@(y8:set-cdr!)@!(y18:%25residual-set-cdr!)",
|
||||
|
||||
"number?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25nump;y1:x;;;l2:py1:_;y"
|
||||
|
|
@ -91,7 +59,7 @@ char *s_code[] = {
|
|||
"y7:fixnum?;;",
|
||||
|
||||
"exact?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25fixp;l2:y4:%25ckn;y1:x"
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y7:fixnum?;l2:y4:%25ckn;y1:x"
|
||||
";;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-exact?;y12:syntax-rule"
|
||||
"s;;;l2:y1:_;y16:%25residual-exact?;;",
|
||||
|
||||
|
|
@ -99,7 +67,7 @@ char *s_code[] = {
|
|||
"&0{%1.0%nI0]1}@!(y16:%25residual-exact?)",
|
||||
|
||||
"inexact?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25flop;l2:y4:%25ckn;y1:x"
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y7:flonum?;l2:y4:%25ckn;y1:x"
|
||||
";;;;l2:py1:_;y12:syntax-rules;;py18:%25residual-inexact?;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y18:%25residual-inexact?;;",
|
||||
|
||||
|
|
@ -298,22 +266,6 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%2.1,.1G6,.2,.2G5,@(y5:%25sdmv)[22}@!(y9:truncate/)",
|
||||
|
||||
"boolean?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25boolp;y1:x;;;l2:py1:_;"
|
||||
"y12:syntax-rules;;py18:%25residual-boolean?;y12:syntax-rules;;;l2:y1:_"
|
||||
";y18:%25residual-boolean?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0Y1]1}@!(y18:%25residual-boolean?)",
|
||||
|
||||
"not",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25not;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py13:%25residual-not;y12:syntax-rules;;;l2:y1:_;y13:%2"
|
||||
"5residual-not;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0~]1}@!(y13:%25residual-not)",
|
||||
|
||||
"char?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25charp;y1:x;;;l2:py1:_;"
|
||||
"y12:syntax-rules;;py15:%25residual-char?;y12:syntax-rules;;;l2:y1:_;y1"
|
||||
|
|
@ -514,292 +466,12 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%1.0X5]1}@!(y24:%25residual-string->symbol)",
|
||||
|
||||
"null?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25nullp;y1:x;;;l2:py1:_;"
|
||||
"y12:syntax-rules;;py15:%25residual-null?;y12:syntax-rules;;;l2:y1:_;y1"
|
||||
"5:%25residual-null?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0u]1}@!(y15:%25residual-null?)",
|
||||
|
||||
"pair?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25pairp;y1:x;;;l2:py1:_;"
|
||||
"y12:syntax-rules;;py15:%25residual-pair?;y12:syntax-rules;;;l2:y1:_;y1"
|
||||
"5:%25residual-pair?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0p]1}@!(y15:%25residual-pair?)",
|
||||
|
||||
"car",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25car;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py13:%25residual-car;y12:syntax-rules;;;l2:y1:_;y13:%2"
|
||||
"5residual-car;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0a]1}@!(y13:%25residual-car)",
|
||||
|
||||
"set-car!",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:v;;l3:y7:%25setcar;y1:x;y1:v;"
|
||||
";;l2:py1:_;y12:syntax-rules;;py18:%25residual-set-car!;y12:syntax-rule"
|
||||
"s;;;l2:y1:_;y18:%25residual-set-car!;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1a!]2}@!(y18:%25residual-set-car!)",
|
||||
|
||||
"cdr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25cdr;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py13:%25residual-cdr;y12:syntax-rules;;;l2:y1:_;y13:%2"
|
||||
"5residual-cdr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0d]1}@!(y13:%25residual-cdr)",
|
||||
|
||||
"set-cdr!",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:v;;l3:y7:%25setcdr;y1:x;y1:v;"
|
||||
";;l2:py1:_;y12:syntax-rules;;py18:%25residual-set-cdr!;y12:syntax-rule"
|
||||
"s;;;l2:y1:_;y18:%25residual-set-cdr!;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1d!]2}@!(y18:%25residual-set-cdr!)",
|
||||
|
||||
"c?r",
|
||||
"l5:y12:syntax-rules;l2:y1:a;y1:d;;l2:l2:y3:c?r;y1:x;;y1:x;;l2:l5:y3:c?"
|
||||
"r;y1:a;y1:?;y3:...;y1:x;;l2:y3:car;l4:y3:c?r;y1:?;y3:...;y1:x;;;;l2:l5"
|
||||
":y3:c?r;y1:d;y1:?;y3:...;y1:x;;l2:y3:cdr;l4:y3:c?r;y1:?;y3:...;y1:x;;;"
|
||||
";",
|
||||
|
||||
"caar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l4:y3:c?r;y1:a;y1:a;y1:x;;;l2:p"
|
||||
"y1:_;y12:syntax-rules;;py14:%25residual-caar;y12:syntax-rules;;;l2:y1:"
|
||||
"_;y14:%25residual-caar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0aa]1}@!(y14:%25residual-caar)",
|
||||
|
||||
"cadr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l4:y3:c?r;y1:a;y1:d;y1:x;;;l2:p"
|
||||
"y1:_;y12:syntax-rules;;py14:%25residual-cadr;y12:syntax-rules;;;l2:y1:"
|
||||
"_;y14:%25residual-cadr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0da]1}@!(y14:%25residual-cadr)",
|
||||
|
||||
"cdar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l4:y3:c?r;y1:d;y1:a;y1:x;;;l2:p"
|
||||
"y1:_;y12:syntax-rules;;py14:%25residual-cdar;y12:syntax-rules;;;l2:y1:"
|
||||
"_;y14:%25residual-cdar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0ad]1}@!(y14:%25residual-cdar)",
|
||||
|
||||
"cddr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l4:y3:c?r;y1:d;y1:d;y1:x;;;l2:p"
|
||||
"y1:_;y12:syntax-rules;;py14:%25residual-cddr;y12:syntax-rules;;;l2:y1:"
|
||||
"_;y14:%25residual-cddr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0dd]1}@!(y14:%25residual-cddr)",
|
||||
|
||||
"caaar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l5:y3:c?r;y1:a;y1:a;y1:a;y1:x;;"
|
||||
";l2:py1:_;y12:syntax-rules;;py15:%25residual-caaar;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y15:%25residual-caaar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0aaa]1}@!(y15:%25residual-caaar)",
|
||||
|
||||
"caadr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l5:y3:c?r;y1:a;y1:a;y1:d;y1:x;;"
|
||||
";l2:py1:_;y12:syntax-rules;;py15:%25residual-caadr;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y15:%25residual-caadr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0daa]1}@!(y15:%25residual-caadr)",
|
||||
|
||||
"cadar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l5:y3:c?r;y1:a;y1:d;y1:a;y1:x;;"
|
||||
";l2:py1:_;y12:syntax-rules;;py15:%25residual-cadar;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y15:%25residual-cadar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0ada]1}@!(y15:%25residual-cadar)",
|
||||
|
||||
"caddr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l5:y3:c?r;y1:a;y1:d;y1:d;y1:x;;"
|
||||
";l2:py1:_;y12:syntax-rules;;py15:%25residual-caddr;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y15:%25residual-caddr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0dda]1}@!(y15:%25residual-caddr)",
|
||||
|
||||
"cdaar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l5:y3:c?r;y1:d;y1:a;y1:a;y1:x;;"
|
||||
";l2:py1:_;y12:syntax-rules;;py15:%25residual-cdaar;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y15:%25residual-cdaar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0aad]1}@!(y15:%25residual-cdaar)",
|
||||
|
||||
"cdadr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l5:y3:c?r;y1:d;y1:a;y1:d;y1:x;;"
|
||||
";l2:py1:_;y12:syntax-rules;;py15:%25residual-cdadr;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y15:%25residual-cdadr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0dad]1}@!(y15:%25residual-cdadr)",
|
||||
|
||||
"cddar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l5:y3:c?r;y1:d;y1:d;y1:a;y1:x;;"
|
||||
";l2:py1:_;y12:syntax-rules;;py15:%25residual-cddar;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y15:%25residual-cddar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0add]1}@!(y15:%25residual-cddar)",
|
||||
|
||||
"cdddr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l5:y3:c?r;y1:d;y1:d;y1:d;y1:x;;"
|
||||
";l2:py1:_;y12:syntax-rules;;py15:%25residual-cdddr;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y15:%25residual-cdddr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0ddd]1}@!(y15:%25residual-cdddr)",
|
||||
|
||||
"caaaar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:a;y1:a;y1:a;y1:a;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-caaaar;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-caaaar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0aaaa]1}@!(y16:%25residual-caaaar)",
|
||||
|
||||
"caaadr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:a;y1:a;y1:a;y1:d;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-caaadr;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-caaadr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0daaa]1}@!(y16:%25residual-caaadr)",
|
||||
|
||||
"caadar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:a;y1:a;y1:d;y1:a;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-caadar;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-caadar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0adaa]1}@!(y16:%25residual-caadar)",
|
||||
|
||||
"caaddr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:a;y1:a;y1:d;y1:d;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-caaddr;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-caaddr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0ddaa]1}@!(y16:%25residual-caaddr)",
|
||||
|
||||
"cadaar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:a;y1:d;y1:a;y1:a;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cadaar;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cadaar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0aada]1}@!(y16:%25residual-cadaar)",
|
||||
|
||||
"cadadr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:a;y1:d;y1:a;y1:d;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cadadr;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cadadr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0dada]1}@!(y16:%25residual-cadadr)",
|
||||
|
||||
"caddar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:a;y1:d;y1:d;y1:a;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-caddar;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-caddar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0adda]1}@!(y16:%25residual-caddar)",
|
||||
|
||||
"cadddr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:a;y1:d;y1:d;y1:d;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cadddr;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cadddr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0ddda]1}@!(y16:%25residual-cadddr)",
|
||||
|
||||
"cdaaar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:d;y1:a;y1:a;y1:a;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cdaaar;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cdaaar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0aaad]1}@!(y16:%25residual-cdaaar)",
|
||||
|
||||
"cdaadr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:d;y1:a;y1:a;y1:d;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cdaadr;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cdaadr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0daad]1}@!(y16:%25residual-cdaadr)",
|
||||
|
||||
"cdadar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:d;y1:a;y1:d;y1:a;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cdadar;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cdadar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0adad]1}@!(y16:%25residual-cdadar)",
|
||||
|
||||
"cdaddr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:d;y1:a;y1:d;y1:d;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cdaddr;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cdaddr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0ddad]1}@!(y16:%25residual-cdaddr)",
|
||||
|
||||
"cddaar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:d;y1:d;y1:a;y1:a;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cddaar;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cddaar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0aadd]1}@!(y16:%25residual-cddaar)",
|
||||
|
||||
"cddadr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:d;y1:d;y1:a;y1:d;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cddadr;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cddadr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0dadd]1}@!(y16:%25residual-cddadr)",
|
||||
|
||||
"cdddar",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:d;y1:d;y1:d;y1:a;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cdddar;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cdddar;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0addd]1}@!(y16:%25residual-cdddar)",
|
||||
|
||||
"cddddr",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l6:y3:c?r;y1:d;y1:d;y1:d;y1:d;y"
|
||||
"1:x;;;l2:py1:_;y12:syntax-rules;;py16:%25residual-cddddr;y12:syntax-ru"
|
||||
"les;;;l2:y1:_;y16:%25residual-cddddr;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0dddd]1}@!(y16:%25residual-cddddr)",
|
||||
|
||||
"cons",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25cons;y1:x;y1:y;;;"
|
||||
"l2:py1:_;y12:syntax-rules;;py14:%25residual-cons;y12:syntax-rules;;;l2"
|
||||
":y1:_;y14:%25residual-cons;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1c]2}@!(y14:%25residual-cons)",
|
||||
|
||||
"list?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25listp;y1:x;;;l2:py1:_;"
|
||||
"y12:syntax-rules;;py15:%25residual-list?;y12:syntax-rules;;;l2:y1:_;y1"
|
||||
|
|
@ -820,8 +492,8 @@ char *s_code[] = {
|
|||
|
||||
"list",
|
||||
"l6:y12:syntax-rules;n;l2:l1:y1:_;;l2:y5:quote;n;;;l2:l2:y1:_;y1:x;;l3:"
|
||||
"y5:%25cons;y1:x;l2:y5:quote;n;;;;l2:l3:y1:_;y1:x;y3:...;;l3:y5:%25list"
|
||||
";y1:x;y3:...;;;l2:y1:_;y14:%25residual-list;;",
|
||||
"y4:cons;y1:x;l2:y5:quote;n;;;;l2:l3:y1:_;y1:x;y3:...;;l3:y5:%25list;y1"
|
||||
":x;y3:...;;;l2:y1:_;y14:%25residual-list;;",
|
||||
|
||||
"length",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25llen;y1:x;;;l2:py1:_;y"
|
||||
|
|
@ -947,9 +619,9 @@ char *s_code[] = {
|
|||
|
||||
"list*",
|
||||
"l7:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;y1:x;;l2:l3:y1:_;y1:x;y1:y;;l3:"
|
||||
"y5:%25cons;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1:y;y1:z;y3:...;;l3:y5:%25cons"
|
||||
";y1:x;l4:y5:list*;y1:y;y1:z;y3:...;;;;l2:py1:_;y4:args;;py15:%25residu"
|
||||
"al-list*;y4:args;;;l2:y1:_;y15:%25residual-list*;;",
|
||||
"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*;;",
|
||||
|
||||
"cons*",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py5:list*;y4:args;;;l2:y1:_;y5"
|
||||
|
|
@ -1391,16 +1063,16 @@ char *s_code[] = {
|
|||
"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:y4:%25car;y1:l;;;l2:y4:loop;l2:y4:%25cdr;y1:l"
|
||||
";;;;l2:y5:quote;n;;;;;;l2:py1:_;y4:args;;py13:%25residual-map;y4:args;"
|
||||
";;l2:y1:_;y13:%25residual-map;;",
|
||||
"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;;",
|
||||
|
||||
"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:y4:%25car;y1:l;;;l2:y4:loop;l2:y4:%25cdr;y1:"
|
||||
"l;;;;;;;;l2:py1:_;y4:args;;py18:%25residual-for-each;y4:args;;;l2:y1:_"
|
||||
";y18:%25residual-for-each;;",
|
||||
"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;;",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2S3,'(c ),.1S2,'0,,#0.0,.3,.8,.8,.7,&5{%1:0,.1I<!?{:3]1}${"
|
||||
|
|
|
|||
3
src/k.sf
3
src/k.sf
|
|
@ -1101,7 +1101,8 @@
|
|||
(codegen (car args) l f s g #f port)
|
||||
(unless (null? (cdr args)) (write-char #\, port)))
|
||||
(write-string igc0 port)]
|
||||
[else (error 'codegen "NYI: unsupported integrable type" igty)]))]
|
||||
[else (error 'codegen "NYI: unsupported integrable type" igty)]))
|
||||
(when k (write-char #\] port) (write-serialized-arg k port))]
|
||||
[call (exp . args)
|
||||
(cond [(and (eq? (car exp) 'lambda) (list? (cadr exp))
|
||||
(fx=? (length args) (length (cadr exp))))
|
||||
|
|
|
|||
34
src/s.scm
34
src/s.scm
|
|
@ -46,18 +46,19 @@
|
|||
;---------------------------------------------------------------------------------------------
|
||||
; Equivalence predicates
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
(define-inline (eq? x y) %residual-eq? (%isq x y))
|
||||
|
||||
(define-inline (eqv? x y) %residual-eqv? (%isv x y))
|
||||
|
||||
(define-inline (equal? x y) %residual-equal? (%ise x y))
|
||||
|
||||
|#
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Boxes, aka cells
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
(define-inline (box? x) %residual-box? (%boxp x))
|
||||
|
||||
(define-inline (box x) %residual-box (%box x))
|
||||
|
|
@ -65,7 +66,7 @@
|
|||
(define-inline (unbox x) %residual-unbox (%unbox x))
|
||||
|
||||
(define-inline (set-box! x y) %residual-set-box! (%setbox x y))
|
||||
|
||||
|#
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Exact integer numbers (fixnums)
|
||||
|
|
@ -195,9 +196,9 @@
|
|||
|
||||
(define-syntax exact-integer? fixnum?)
|
||||
|
||||
(define-inline (exact? x) %residual-exact? (%fixp (%ckn x)))
|
||||
(define-inline (exact? x) %residual-exact? (fixnum? (%ckn x)))
|
||||
|
||||
(define-inline (inexact? x) %residual-inexact? (%flop (%ckn x)))
|
||||
(define-inline (inexact? x) %residual-inexact? (flonum? (%ckn x)))
|
||||
|
||||
(define-inline (finite? x) %residual-finite? (%finp x))
|
||||
|
||||
|
|
@ -323,10 +324,13 @@
|
|||
; Booleans
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
|
||||
(define-inline (boolean? x) %residual-boolean? (%boolp x))
|
||||
|
||||
(define-inline (not x) %residual-not (%not x))
|
||||
|
||||
|#
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Characters
|
||||
|
|
@ -378,6 +382,7 @@
|
|||
; Null and Pairs
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
(define-inline (null? x) %residual-null? (%nullp x))
|
||||
|
||||
(define-inline (pair? x) %residual-pair? (%pairp x))
|
||||
|
|
@ -389,6 +394,7 @@
|
|||
(define-inline (cdr x) %residual-cdr (%cdr x))
|
||||
|
||||
(define-inline (set-cdr! x v) %residual-set-cdr! (%setcdr x v))
|
||||
|#
|
||||
|
||||
(define-syntax c?r
|
||||
(syntax-rules (a d)
|
||||
|
|
@ -396,6 +402,7 @@
|
|||
[(c?r a ? ... x) (car (c?r ? ... x))]
|
||||
[(c?r d ? ... x) (cdr (c?r ? ... x))]))
|
||||
|
||||
#|
|
||||
(define-inline (caar x) %residual-caar (c?r a a x))
|
||||
(define-inline (cadr x) %residual-cadr (c?r a d x))
|
||||
(define-inline (cdar x) %residual-cdar (c?r d a x))
|
||||
|
|
@ -424,8 +431,11 @@
|
|||
(define-inline (cddadr x) %residual-cddadr (c?r d d a d x))
|
||||
(define-inline (cdddar x) %residual-cdddar (c?r d d d a x))
|
||||
(define-inline (cddddr x) %residual-cddddr (c?r d d d d x))
|
||||
|#
|
||||
|
||||
#|
|
||||
(define-inline (cons x y) %residual-cons (%cons x y))
|
||||
|#
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -436,7 +446,7 @@
|
|||
|
||||
(define (%make-list n i)
|
||||
(let loop ([n (%ckk n)] [l '()])
|
||||
(if (%ile n 0) l (loop (%isub n 1) (cons i l)))))
|
||||
(if (fx<=? n 0) l (loop (fx- n 1) (cons i l)))))
|
||||
|
||||
(define-syntax make-list
|
||||
(syntax-rules ()
|
||||
|
|
@ -448,7 +458,7 @@
|
|||
(define-syntax list
|
||||
(syntax-rules ()
|
||||
[(_) '()]
|
||||
[(_ x) (%cons x '())]
|
||||
[(_ x) (cons x '())]
|
||||
[(_ x ...) (%list x ...)]
|
||||
[_ %residual-list]))
|
||||
|
||||
|
|
@ -484,7 +494,7 @@
|
|||
(define-inline (assv v y) %residual-assv (%assv v (%ckl y))) ; TODO: make sure assv checks list
|
||||
|
||||
(define (%assoc v al eq)
|
||||
(and (pair? al) (if (eq v (car (%car al))) (%car al) (%assoc v (%cdr al) eq))))
|
||||
(and (pair? al) (if (eq v (caar al)) (car al) (%assoc v (cdr al) eq))))
|
||||
|
||||
(define-syntax assoc
|
||||
(syntax-rules ()
|
||||
|
|
@ -506,8 +516,8 @@
|
|||
(define-syntax list*
|
||||
(syntax-rules ()
|
||||
[(_ x) x]
|
||||
[(_ x y) (%cons x y)]
|
||||
[(_ x y z ...) (%cons x (list* y z ...))]
|
||||
[(_ x y) (cons x y)]
|
||||
[(_ x y z ...) (cons x (list* y z ...))]
|
||||
[(_ . args) (%residual-list* . args)]
|
||||
[_ %residual-list*]))
|
||||
|
||||
|
|
@ -819,7 +829,7 @@
|
|||
[(_ fun lst)
|
||||
(let ([f fun])
|
||||
(let loop ([l lst])
|
||||
(if (pair? l) (cons (f (%car l)) (loop (%cdr l))) '())))]
|
||||
(if (pair? l) (cons (f (car l)) (loop (cdr l))) '())))]
|
||||
[(_ . args) (%residual-map . args)]
|
||||
[_ %residual-map]))
|
||||
|
||||
|
|
@ -828,7 +838,7 @@
|
|||
[(_ fun lst)
|
||||
(let ([f fun])
|
||||
(let loop ([l lst])
|
||||
(if (pair? l) (begin (f (%car l)) (loop (%cdr l))))))]
|
||||
(if (pair? l) (begin (f (car l)) (loop (cdr l))))))]
|
||||
[(_ . args) (%residual-for-each . args)]
|
||||
[_ %residual-for-each]))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue