... even more builtins as new integrables

This commit is contained in:
ESL 2023-03-20 20:00:18 -04:00
parent b12db72d87
commit 57df6ae121
3 changed files with 173 additions and 629 deletions

112
i.h
View file

@ -348,7 +348,7 @@ 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, "%lcat", 2, INLINED)
declare_instruction(lcat, "L6", 0, "list-cat", '2', AUTOGL)
declare_instruction(memq, "A0", 0, "memq", '2', AUTOGL)
declare_instruction(memv, "A1", 0, "memv", '2', AUTOGL)
declare_instruction(meme, "A2", 0, "meme", '2', AUTOGL)
@ -359,76 +359,74 @@ declare_instruction(ltail, "A6", 0, "list-tail", '2', AUTOGL)
declare_instruction(lpair, "A7", 0, "last-pair", '1', AUTOGL)
declare_instruction(lrev, "A8", 0, "reverse", '1', AUTOGL)
declare_instruction(lrevi, "A9", 0, "reverse!", '1', AUTOGL)
declare_instruction(charp, "C0", 0, "%charp", 1, INLINED)
declare_instruction(cwsp, "C1", 0, "%cwsp", 1, INLINED)
declare_instruction(clcp, "C2", 0, "%clcp", 1, INLINED)
declare_instruction(cucp, "C3", 0, "%cucp", 1, INLINED)
declare_instruction(calp, "C4", 0, "%calp", 1, INLINED)
declare_instruction(cnup, "C5", 0, "%cnup", 1, INLINED)
declare_instruction(cupc, "C6", 0, "%cupc", 1, INLINED)
declare_instruction(cdnc, "C7", 0, "%cdnc", 1, INLINED)
declare_instruction(charp, "C0", 0, "char?", '1', AUTOGL)
declare_instruction(cwsp, "C1", 0, "char-whitespace?", '1', AUTOGL)
declare_instruction(clcp, "C2", 0, "char-lower-case?", '1', AUTOGL)
declare_instruction(cucp, "C3", 0, "char-upper-case?", '1', AUTOGL)
declare_instruction(calp, "C4", 0, "char-alphabetic?", '1', AUTOGL)
declare_instruction(cnup, "C5", 0, "char-numeric?", '1', AUTOGL)
declare_instruction(cupc, "C6", 0, "char-upcase", '1', AUTOGL)
declare_instruction(cdnc, "C7", 0, "char-downcase", '1', AUTOGL)
declare_instruction(ceq, "C=", 0, "char=?", 'c', AUTOGL)
declare_instruction(clt, "C<", 0, "char<?", 'c', AUTOGL)
declare_instruction(cgt, "C>", 0, "char>?", 'c', AUTOGL)
declare_instruction(cle, "C>!", 0, "char<=?", 'c', AUTOGL)
declare_instruction(cge, "C<!", 0, "char>=?", 'c', AUTOGL)
declare_instruction(cieq, "Ci=", 0, "char-ci=?", 'c', AUTOGL)
declare_instruction(cilt, "Ci<", 0, "char-ci<?", 'c', AUTOGL)
declare_instruction(cigt, "Ci>", 0, "char-ci>?", 'c', AUTOGL)
declare_instruction(cile, "Ci>!", 0, "char-ci<=?", 'c', AUTOGL)
declare_instruction(cige, "Ci<!", 0, "char-ci>=?", 'c', AUTOGL)
declare_instruction(ceq, "C=", 0, "%ceq", 2, INLINED)
declare_instruction(clt, "C<", 0, "%clt", 2, INLINED)
declare_instruction(cgt, "C>", 0, "%cgt", 2, INLINED)
declare_instruction(cle, "C>!", 0, "%cle", 2, INLINED)
declare_instruction(cge, "C<!", 0, "%cge", 2, INLINED)
declare_instruction(cieq, "Ci=", 0, "%cieq", 2, INLINED)
declare_instruction(cilt, "Ci<", 0, "%cilt", 2, INLINED)
declare_instruction(cigt, "Ci>", 0, "%cigt", 2, INLINED)
declare_instruction(cile, "Ci>!", 0, "%cile", 2, INLINED)
declare_instruction(cige, "Ci<!", 0, "%cige", 2, INLINED)
declare_instruction(strp, "S0", 0, "%strp", 1, INLINED)
declare_instruction(strp, "S0", 0, "string?", '1', AUTOGL)
declare_instruction(str, "S1", 1, "%str", -1, "%!0.0X3]1")
declare_instruction(smk, "S2", 0, "%smk", 2, INLINED)
declare_instruction(slen, "S3", 0, "%slen", 1, INLINED)
declare_instruction(sget, "S4", 0, "%sget", 2, INLINED)
declare_instruction(sput, "S5", 0, "%sput", 3, INLINED)
declare_instruction(scat, "S6", 0, "%scat", 2, INLINED)
declare_instruction(ssub, "S7", 0, "%ssub", 3, INLINED)
declare_instruction(smk, "S2\0'(c )", 0, "make-string", 'b', AUTOGL)
declare_instruction(slen, "S3", 0, "string-length", '1', AUTOGL)
declare_instruction(sget, "S4", 0, "string-ref", '2', AUTOGL)
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(seq, "S=", 0, "%seq", 2, INLINED)
declare_instruction(slt, "S<", 0, "%slt", 2, INLINED)
declare_instruction(sgt, "S>", 0, "%sgt", 2, INLINED)
declare_instruction(sle, "S>!", 0, "%sle", 2, INLINED)
declare_instruction(sge, "S<!", 0, "%sge", 2, INLINED)
declare_instruction(sieq, "Si=", 0, "%sieq", 2, INLINED)
declare_instruction(silt, "Si<", 0, "%silt", 2, INLINED)
declare_instruction(sigt, "Si>", 0, "%sigt", 2, INLINED)
declare_instruction(sile, "Si>!", 0, "%sile", 2, INLINED)
declare_instruction(sige, "Si<!", 0, "%sige", 2, INLINED)
declare_instruction(seq, "S=", 0, "string=?", 'c', AUTOGL)
declare_instruction(slt, "S<", 0, "string<?", 'c', AUTOGL)
declare_instruction(sgt, "S>", 0, "string>?", 'c', AUTOGL)
declare_instruction(sle, "S>!", 0, "string<=?", 'c', AUTOGL)
declare_instruction(sge, "S<!", 0, "string>=?", 'c', AUTOGL)
declare_instruction(sieq, "Si=", 0, "string-ci=?", 'c', AUTOGL)
declare_instruction(silt, "Si<", 0, "string-ci<?", 'c', AUTOGL)
declare_instruction(sigt, "Si>", 0, "string-ci>?", 'c', AUTOGL)
declare_instruction(sile, "Si>!", 0, "string-ci<=?", 'c', AUTOGL)
declare_instruction(sige, "Si<!", 0, "string-ci>=?", 'c', AUTOGL)
declare_instruction(vecp, "V0", 0, "%vecp", 1, INLINED)
declare_instruction(vecp, "V0", 0, "vector?", '1', AUTOGL)
declare_instruction(vec, "V1", 1, "%vec", -1, "%!0.0X1]1")
declare_instruction(vmk, "V2", 0, "%vmk", 2, INLINED)
declare_instruction(vlen, "V3", 0, "%vlen", 1, INLINED)
declare_instruction(vget, "V4", 0, "%vget", 2, INLINED)
declare_instruction(vput, "V5", 0, "%vput", 3, INLINED)
declare_instruction(vcat, "V6", 0, "%vcat", 2, INLINED)
declare_instruction(vmk, "V2\0f", 0, "make-vector", 'b', AUTOGL)
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(ltov, "X1", 0, "%ltov", 1, INLINED)
declare_instruction(ltov, "X1", 0, "list->vector", '1', AUTOGL)
declare_instruction(stol, "X2", 0, "%stol", 1, INLINED)
declare_instruction(ltos, "X3", 0, "%ltos", 1, INLINED)
declare_instruction(ytos, "X4", 0, "%ytos", 1, INLINED)
declare_instruction(stoy, "X5", 0, "%stoy", 1, INLINED)
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)
declare_instruction(itos, "X6\0'(i10)", 0, "fixnum->string", 'b', AUTOGL)
declare_instruction(stoi, "X7\0'(i10)", 0, "string->fixnum", 'b', AUTOGL)
declare_instruction(ctoi, "X8", 0, "%ctoi", 1, INLINED)
declare_instruction(itoc, "X9", 0, "%itoc", 1, INLINED)
declare_instruction(ctoi, "X8", 0, "char->integer", '1', AUTOGL)
declare_instruction(itoc, "X9", 0, "integer->char", '1', AUTOGL)
declare_instruction(jtos, "E6", 0, "flonum->string", '1', AUTOGL)
declare_instruction(stoj, "E7", 0, "string->flonum", '1', AUTOGL)
declare_instruction(ntos, "E8\0'(i10)", 0, "number->string", 'b', AUTOGL)
declare_instruction(ston, "E9\0'(i10)", 0, "string->number", 'b', AUTOGL)
declare_instruction(ccmp, "O0", 0, "%ccmp", 2, INLINED)
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(ccmp, "O0", 0, "char-cmp", '2', AUTOGL)
declare_instruction(cicmp, "O1", 0, "char-ci-cmp", '2', AUTOGL)
declare_instruction(scmp, "O2", 0, "string-cmp", '2', AUTOGL)
declare_instruction(sicmp, "O3", 0, "string-ci-cmp", '2', AUTOGL)
declare_instruction(symp, "Y0", 0, "symbol?", '1', AUTOGL)
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(funp, "K0", 0, "procedure?", '1', AUTOGL)
declare_instruction(ipp, "P00", 0, "input-port?", '1', AUTOGL)
declare_instruction(opp, "P01", 0, "output-port?", '1', AUTOGL)
declare_instruction(sip, "P10", 0, "current-input-port",'0', AUTOGL)
@ -477,6 +475,8 @@ declare_integrable(NULL, "%nJ0", 0, "inexact?", '1', AUTOGL)
declare_integrable(NULL, "G4", 0, "modulo", '2', AUTOGL)
declare_integrable(NULL, "G5", 0, "quotient", '2', AUTOGL)
declare_integrable(NULL, "G6", 0, "remainder", '2', AUTOGL)
declare_integrable(NULL, "Ij", 0, "exact->inexact", '1', AUTOGL)
declare_integrable(NULL, "Ji", 0, "inexact->exact", '1', AUTOGL)
declare_integrable(NULL, "aaa", 0, "caaar", '1', AUTOGL)
declare_integrable(NULL, "daa", 0, "caadr", '1', AUTOGL)
declare_integrable(NULL, "ada", 0, "cadar", '1', AUTOGL)

501
s.c
View file

@ -8,206 +8,6 @@ char *s_code[] = {
0,
"&0{%2.1,.1G6,.2,.2G5,@(y5:%25sdmv)[22}@!(y9:truncate/)",
"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"
"5:%25residual-char?;;",
0,
"&0{%1.0C0]1}@!(y15:%25residual-char?)",
"char-cmp",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25ccmp;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py18:%25residual-char-cmp;y12:syntax-rules;"
";;l2:y1:_;y18:%25residual-char-cmp;;",
0,
"&0{%2.1,.1O0]2}@!(y18:%25residual-char-cmp)",
"char=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25ceq;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py16:%25residual-char=?;y12:syntax-rules;;;l"
"2:y1:_;y16:%25residual-char=?;;",
0,
"&0{%2.1,.1C=]2}@!(y16:%25residual-char=?)",
"char<?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25clt;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py16:%25residual-char<?;y12:syntax-rules;;;l"
"2:y1:_;y16:%25residual-char<?;;",
0,
"&0{%2.1,.1C<]2}@!(y16:%25residual-char<?)",
"char<=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25cle;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py17:%25residual-char<=?;y12:syntax-rules;;;"
"l2:y1:_;y17:%25residual-char<=?;;",
0,
"&0{%2.1,.1C>!]2}@!(y17:%25residual-char<=?)",
"char>?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25cgt;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py16:%25residual-char>?;y12:syntax-rules;;;l"
"2:y1:_;y16:%25residual-char>?;;",
0,
"&0{%2.1,.1C>]2}@!(y16:%25residual-char>?)",
"char>=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25cge;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py17:%25residual-char>=?;y12:syntax-rules;;;"
"l2:y1:_;y17:%25residual-char>=?;;",
0,
"&0{%2.1,.1C<!]2}@!(y17:%25residual-char>=?)",
"char-ci-cmp",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y6:%25cicmp;y1:x;y1:y;;"
";l2:py1:_;y12:syntax-rules;;py18:%25residual-char-cmp;y12:syntax-rules"
";;;l2:y1:_;y18:%25residual-char-cmp;;",
0,
"&0{%2.1,.1O1]2}@!(y18:%25residual-char-cmp)",
"char-ci=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25cieq;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py19:%25residual-char-ci=?;y12:syntax-rules"
";;;l2:y1:_;y19:%25residual-char-ci=?;;",
0,
"&0{%2.1,.1Ci=]2}@!(y19:%25residual-char-ci=?)",
"char-ci<?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25cilt;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py19:%25residual-char-ci<?;y12:syntax-rules"
";;;l2:y1:_;y19:%25residual-char-ci<?;;",
0,
"&0{%2.1,.1Ci<]2}@!(y19:%25residual-char-ci<?)",
"char-ci<=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25cile;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py20:%25residual-char-ci<=?;y12:syntax-rule"
"s;;;l2:y1:_;y20:%25residual-char-ci<=?;;",
0,
"&0{%2.1,.1Ci>!]2}@!(y20:%25residual-char-ci<=?)",
"char-ci>?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25cigt;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py19:%25residual-char-ci>?;y12:syntax-rules"
";;;l2:y1:_;y19:%25residual-char-ci>?;;",
0,
"&0{%2.1,.1Ci>]2}@!(y19:%25residual-char-ci>?)",
"char-ci>=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25cige;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py20:%25residual-char-ci>=?;y12:syntax-rule"
"s;;;l2:y1:_;y20:%25residual-char-ci>=?;;",
0,
"&0{%2.1,.1Ci<!]2}@!(y20:%25residual-char-ci>=?)",
"char-alphabetic?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25calp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py26:%25residual-char-alphabetic?;y12:syntax-rules;;;"
"l2:y1:_;y26:%25residual-char-alphabetic?;;",
0,
"&0{%1.0C4]1}@!(y26:%25residual-char-alphabetic?)",
"char-numeric?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25cnup;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py23:%25residual-char-numeric?;y12:syntax-rules;;;l2:"
"y1:_;y23:%25residual-char-numeric?;;",
0,
"&0{%1.0C5]1}@!(y23:%25residual-char-numeric?)",
"char-whitespace?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25cwsp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py26:%25residual-char-whitespace?;y12:syntax-rules;;;"
"l2:y1:_;y26:%25residual-char-whitespace?;;",
0,
"&0{%1.0C1]1}@!(y26:%25residual-char-whitespace?)",
"char-upper-case?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25cucp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py26:%25residual-char-upper-case?;y12:syntax-rules;;;"
"l2:y1:_;y26:%25residual-char-upper-case?;;",
0,
"&0{%1.0C3]1}@!(y26:%25residual-char-upper-case?)",
"char-lower-case?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25clcp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py26:%25residual-char-lower-case?;y12:syntax-rules;;;"
"l2:y1:_;y26:%25residual-char-lower-case?;;",
0,
"&0{%1.0C2]1}@!(y26:%25residual-char-lower-case?)",
"char-upcase",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25cupc;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py21:%25residual-char-upcase;y12:syntax-rules;;;l2:y1"
":_;y21:%25residual-char-upcase;;",
0,
"&0{%1.0C6]1}@!(y21:%25residual-char-upcase)",
"char-downcase",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25cdnc;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py23:%25residual-char-downcase;y12:syntax-rules;;;l2:"
"y1:_;y23:%25residual-char-downcase;;",
0,
"&0{%1.0C7]1}@!(y23:%25residual-char-downcase)",
"char->integer",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25ctoi;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py23:%25residual-char->integer;y12:syntax-rules;;;l2:"
"y1:_;y23:%25residual-char->integer;;",
0,
"&0{%1.0X8]1}@!(y23:%25residual-char->integer)",
"integer->char",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25itoc;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py23:%25residual-integer->char;y12:syntax-rules;;;l2:"
"y1:_;y23:%25residual-integer->char;;",
0,
"&0{%1.0X9]1}@!(y23:%25residual-integer->char)",
"symbol?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25symp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py17:%25residual-symbol?;y12:syntax-rules;;;l2:y1:_;y"
"17:%25residual-symbol?;;",
0,
"&0{%1.0Y0]1}@!(y17:%25residual-symbol?)",
"symbol->string",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25ytos;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py24:%25residual-symbol->string;y12:syntax-rules;;;l2"
":y1:_;y24:%25residual-symbol->string;;",
0,
"&0{%1.0X4]1}@!(y24:%25residual-symbol->string)",
"string->symbol",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25stoy;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py24:%25residual-string->symbol;y12:syntax-rules;;;l2"
":y1:_;y24:%25residual-string->symbol;;",
0,
"&0{%1.0X5]1}@!(y24:%25residual-string->symbol)",
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)",
@ -225,9 +25,9 @@ char *s_code[] = {
"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:y5:%25lcat;y1:x;y1:y;;;l2:l5:y1:_;y1:x;y1:"
"y;y1:z;y3:...;;l3:y5:%25lcat;y1:x;l4:y6:append;y1:y;y1:z;y3:...;;;;l2:"
"y1:_;y16:%25residual-append;;",
"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;;",
0,
"&0{%!2.0u?{.2,.2A2]3}.0a,.3,.3,,#0.0,&1{%3.1p?{${.3a,.3,.6[02}?{.1]3}."
@ -251,7 +51,7 @@ char *s_code[] = {
"rules;;;l2:y1:_;y19:%25residual-list-copy;;",
0,
"&0{%1n,.1L6]1}@!(y19:%25residual-list-copy)",
"&0{%1n,.1,@(y5:%25lcat)[12}@!(y19:%25residual-list-copy)",
"list*",
"l7:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;y1:x;;l2:l3:y1:_;y1:x;y1:y;;l3:"
@ -263,68 +63,22 @@ char *s_code[] = {
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py5:list*;y4:args;;;l2:y1:_;y5"
":list*;;",
"vector?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25vecp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py17:%25residual-vector?;y12:syntax-rules;;;l2:y1:_;y"
"17:%25residual-vector?;;",
0,
"&0{%1.0V0]1}@!(y17:%25residual-vector?)",
"vector",
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py4:%25vec;y4:args;;;l2:y1:_;y"
"4:%25vec;;",
"make-vector",
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:n;;l3:y4:%25vmk;y1:n;f;;;l2:l3:y1:"
"_;y1:n;y1:v;;l3:y4:%25vmk;y1:n;y1:v;;;l2:py1:_;y4:args;;py21:%25residu"
"al-make-vector;y4:args;;;l2:y1:_;y21:%25residual-make-vector;;",
"vector-length",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25vlen;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py23:%25residual-vector-length;y12:syntax-rules;;;l2:"
"y1:_;y23:%25residual-vector-length;;",
0,
"&0{%1.0V3]1}@!(y23:%25residual-vector-length)",
"vector-ref",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:i;;l3:y5:%25vget;y1:x;y1:i;;;"
"l2:py1:_;y12:syntax-rules;;py20:%25residual-vector-ref;y12:syntax-rule"
"s;;;l2:y1:_;y20:%25residual-vector-ref;;",
0,
"&0{%2.1,.1V4]2}@!(y20:%25residual-vector-ref)",
"vector-set!",
"l5:y12:syntax-rules;n;l2:l4:y1:_;y1:x;y1:i;y1:v;;l4:y5:%25vput;y1:x;y1"
":i;y1:v;;;l2:py1:_;y12:syntax-rules;;py21:%25residual-vector-set!;y12:"
"syntax-rules;;;l2:y1:_;y21:%25residual-vector-set!;;",
0,
"&0{%3.2,.2,.2V5]3}@!(y21:%25residual-vector-set!)",
"list->vector",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25ltov;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py22:%25residual-list->vector;y12:syntax-rules;;;l2:y"
"1:_;y22:%25residual-list->vector;;",
0,
"&0{%1.0X1]1}@!(y22:%25residual-list->vector)",
0,
"&0{%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2V4c,'1,.2I-,:1^["
"22}.!0.0^_1[32}@!(y15:subvector->list)",
"vector->list",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25vtol;y1:x;;;l2:py1:_;y"
"1:r;;py22:%25residual-vector->list;y1:r;;;l2:y1:_;y22:%25residual-vect"
"or->list;;",
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%%}@!(y22:%25residual-vec"
"tor->list)",
"ctor->list)[23}%x,&0{%1.0X0]1}%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;;",
0,
"&0{%5.1,.1V3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.3,.7,.6,.3,&4{%2:3,.2I<!,"
@ -380,82 +134,30 @@ char *s_code[] = {
0,
"&0{%!0.0,f,${.4,@(y18:vectors-sum-length)[01}V2,@(y18:vectors-copy-int"
"o!)[12}@!(y23:%25residual-vector-append)",
"o!)[12}@!(y14:%25vector-append)",
"vector-append",
"l7:y12:syntax-rules;n;l2:l1:y1:_;;l2:y5:quote;v0:;;;l2:l2:y1:_;y1:x;;l"
"2:y4:%25ckv;y1:x;;;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25vcat;y1:x;y1:y;;;l2:"
"py1:_;y1:r;;py23:%25residual-vector-append;y1:r;;;l2:y1:_;y23:%25resid"
"ual-vector-append;;",
"string?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25strp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py17:%25residual-string?;y12:syntax-rules;;;l2:y1:_;y"
"17:%25residual-string?;;",
0,
"&0{%1.0S0]1}@!(y17:%25residual-string?)",
"2:y4:%25ckv;y1:x;;;l2:l3:y1:_;y1:x;y1:y;;l3:y10:vector-cat;y1:x;y1:y;;"
";l2:py1:_;y1:r;;py14:%25vector-append;y1:r;;;l2:y1:_;y14:%25vector-app"
"end;;",
"string",
"l4:y12:syntax-rules;n;l2:l3:y1:_;y1:c;y3:...;;l3:y4:%25str;y1:c;y3:..."
";;;l2:y1:_;y16:%25residual-string;;",
"make-string",
"l6:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y4:%25smk;y1:x;c ;;;l2:l3:y1"
":_;y1:x;y1:y;;l3:y4:%25smk;y1:x;y1:y;;;l2:py1:_;y4:args;;py21:%25resid"
"ual-make-string;y4:args;;;l2:y1:_;y21:%25residual-make-string;;",
"string-length",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25slen;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py23:%25residual-string-length;y12:syntax-rules;;;l2:"
"y1:_;y23:%25residual-string-length;;",
0,
"&0{%1.0S3]1}@!(y23:%25residual-string-length)",
"string-ref",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:i;;l3:y5:%25sget;y1:x;y1:i;;;"
"l2:py1:_;y12:syntax-rules;;py20:%25residual-string-ref;y12:syntax-rule"
"s;;;l2:y1:_;y20:%25residual-string-ref;;",
0,
"&0{%2.1,.1S4]2}@!(y20:%25residual-string-ref)",
"string-set!",
"l5:y12:syntax-rules;n;l2:l4:y1:_;y1:x;y1:i;y1:v;;l4:y5:%25sput;y1:x;y1"
":i;y1:v;;;l2:py1:_;y12:syntax-rules;;py21:%25residual-string-set!;y12:"
"syntax-rules;;;l2:y1:_;y21:%25residual-string-set!;;",
0,
"&0{%3.2,.2,.2S5]3}@!(y21:%25residual-string-set!)",
"string-append",
"l7:y12:syntax-rules;n;l2:l1:y1:_;;s0:;;l2:l2:y1:_;y1:x;;l2:y4:%25cks;y"
"1:x;;;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25scat;y1:x;y1:y;;;l2:l5:y1:_;y1:x;"
"y1:y;y1:z;y3:...;;l3:y13:string-append;y1:x;l4:y13:string-append;y1:y;"
"y1:z;y3:...;;;;l2:y1:_;y23:%25residual-string-append;;",
"list->string",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25ltos;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py22:%25residual-list->string;y12:syntax-rules;;;l2:y"
"1:_;y22:%25residual-list->string;;",
0,
"&0{%1.0X3]1}@!(y22:%25residual-list->string)",
0,
"&0{%3n,'1,.4I-,,#0.3,.1,.6,&3{%2:0,.1I<?{.1]2}.1,.1,:2S4c,'1,.2I-,:1^["
"22}.!0.0^_1[32}@!(y15:substring->list)",
"string->list",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25stol;y1:x;;;l2:py1:_;y"
"1:r;;py22:%25residual-string->list;y1:r;;;l2:y1:_;y22:%25residual-stri"
"ng->list;;",
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%%}@!(y22:%25residual-str"
"ing->list)",
"ring->list)[23}%x,&0{%1.0X2]1}%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;;",
0,
"&0{%5.1,.1S3I-,.4I+,.5In,.4,.3I>!?{.4,.3,,#0.3,.7,.6,.3,&4{%2:3,.2I<!,"
@ -468,14 +170,6 @@ char *s_code[] = {
",@(y15:substring-copy!)[45}%x,&0{%3.2S3,'0,.4,.4,.4,@(y15:substring-co"
"py!)[35}%x,&3{|30|41|52%%}@!(y12:string-copy!)",
"substring",
"l5:y12:syntax-rules;n;l2:l4:y1:_;y1:x;y1:s;y1:e;;l4:y5:%25ssub;y1:x;y1"
":s;y1:e;;;l2:py1:_;y12:syntax-rules;;py19:%25residual-substring;y12:sy"
"ntax-rules;;;l2:y1:_;y19:%25residual-substring;;",
0,
"&0{%3.2,.2,.2S7]3}@!(y19:%25residual-substring)",
0,
"&0{%3.2,.2,.2S7]3}%x,&0{%2.0S3,.2,.2S7]2}%x,&0{%1.0S3,'0,.2S7]1}%x,&3{"
"|10|21|32%%}@!(y11:string-copy)",
@ -514,117 +208,12 @@ char *s_code[] = {
0,
"&0{%!0.0,'(c ),${.4,@(y18:strings-sum-length)[01}S2,@(y18:strings-copy"
"-into!)[12}@!(y23:%25residual-string-append)",
"-into!)[12}@!(y14:%25string-append)",
"string-append",
"l7:y12:syntax-rules;n;l2:l1:y1:_;;s0:;;l2:l2:y1:_;y1:x;;l2:y4:%25cks;y"
"1:x;;;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25scat;y1:x;y1:y;;;l2:py1:_;y1:r;;p"
"y23:%25residual-string-append;y1:r;;;l2:y1:_;y23:%25residual-string-ap"
"pend;;",
"string-cmp",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25scmp;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py20:%25residual-string-cmp;y12:syntax-rule"
"s;;;l2:y1:_;y20:%25residual-string-cmp;;",
0,
"&0{%2.1,.1O2]2}@!(y20:%25residual-string-cmp)",
"string=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25seq;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py18:%25residual-string<?;y12:syntax-rules;;"
";l2:y1:_;y18:%25residual-string<?;;",
0,
"&0{%2.1,.1S=]2}@!(y18:%25residual-string<?)",
"string<?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25slt;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py18:%25residual-string<?;y12:syntax-rules;;"
";l2:y1:_;y18:%25residual-string<?;;",
0,
"&0{%2.1,.1S<]2}@!(y18:%25residual-string<?)",
"string<=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25sle;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py19:%25residual-string<=?;y12:syntax-rules;"
";;l2:y1:_;y19:%25residual-string<=?;;",
0,
"&0{%2.1,.1S>!]2}@!(y19:%25residual-string<=?)",
"string>?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25sgt;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py18:%25residual-string>?;y12:syntax-rules;;"
";l2:y1:_;y18:%25residual-string>?;;",
0,
"&0{%2.1,.1S>]2}@!(y18:%25residual-string>?)",
"string>=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y4:%25sge;y1:x;y1:y;;;l"
"2:py1:_;y12:syntax-rules;;py19:%25residual-string>=?;y12:syntax-rules;"
";;l2:y1:_;y19:%25residual-string>=?;;",
0,
"&0{%2.1,.1S<!]2}@!(y19:%25residual-string>=?)",
"string-ci-cmp",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y6:%25sicmp;y1:x;y1:y;;"
";l2:py1:_;y12:syntax-rules;;py20:%25residual-string-cmp;y12:syntax-rul"
"es;;;l2:y1:_;y20:%25residual-string-cmp;;",
0,
"&0{%2.1,.1O3]2}@!(y20:%25residual-string-cmp)",
"string-ci=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25sieq;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py18:%25residual-string<?;y12:syntax-rules;"
";;l2:y1:_;y18:%25residual-string<?;;",
0,
"&0{%2.1,.1Si=]2}@!(y18:%25residual-string<?)",
"string-ci<?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25silt;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py18:%25residual-string<?;y12:syntax-rules;"
";;l2:y1:_;y18:%25residual-string<?;;",
0,
"&0{%2.1,.1Si<]2}@!(y18:%25residual-string<?)",
"string-ci<=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25sile;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py19:%25residual-string<=?;y12:syntax-rules"
";;;l2:y1:_;y19:%25residual-string<=?;;",
0,
"&0{%2.1,.1Si>!]2}@!(y19:%25residual-string<=?)",
"string-ci>?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25sigt;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py18:%25residual-string>?;y12:syntax-rules;"
";;l2:y1:_;y18:%25residual-string>?;;",
0,
"&0{%2.1,.1Si>]2}@!(y18:%25residual-string>?)",
"string-ci>=?",
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:y;;l3:y5:%25sige;y1:x;y1:y;;;"
"l2:py1:_;y12:syntax-rules;;py19:%25residual-string>=?;y12:syntax-rules"
";;;l2:y1:_;y19:%25residual-string>=?;;",
0,
"&0{%2.1,.1Si<!]2}@!(y19:%25residual-string>=?)",
"procedure?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25funp;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py20:%25residual-procedure?;y12:syntax-rules;;;l2:y1:"
"_;y20:%25residual-procedure?;;",
0,
"&0{%1.0K0]1}@!(y20:%25residual-procedure?)",
"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;;",
"apply",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:p;y1:l;;l3:y5:%25appl;y1:p;y1:l;;;"
@ -668,31 +257,29 @@ char *s_code[] = {
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}${@(y22:%25residual"
"-string->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:string-map)",
".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)",
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}${@(y22:%25residual-vec"
"tor->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:vector-map)",
"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)",
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}@(y22:%25residual-string->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,@(y18:%25residual-for-each),@(y5:%25appl)[32}@!(y15:string-for-ea"
"ch)",
"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)",
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}@(y22:%25residual-vector->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,@(y18:%25residual-for-each),@(y5:%25appl)[32}@!(y15:vector-for-ea"
"ch)",
"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)",
0,
"&0{%1.0P00,.0?{.0]2}.1P01]2}@!(y5:port?)",
@ -722,12 +309,6 @@ char *s_code[] = {
"&0{%!1.0u?{f,.2,@(y10:%25make-list)[22}.0a,.2,@(y10:%25make-list)[22}@"
"!(y19:%25residual-make-list)",
0,
"&0{%!1.0u?{f,.2V2]2}.0a,.2V2]2}@!(y21:%25residual-make-vector)",
0,
"&0{%!1.0u?{'(c ),.2S2]2}.0a,.2S2]2}@!(y21:%25residual-make-string)",
"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"
@ -762,13 +343,5 @@ char *s_code[] = {
"&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.0,&1{%1.0u?{'(s0:)]1}.0du?{.0a]1}${.2d,:0^[01},.1aS6]1}.!"
"0.0^_1[11}@!(y23:%25residual-string-append)",
0,
"&0{%!0.0,,#0.0,&1{%1.0u?{'(v0:)]1}.0du?{.0a]1}${.2d,:0^[01},.1aV6]1}.!"
"0.0^_1[11}@!(y23:%25residual-vector-append)",
0, 0
};

189
src/s.scm
View file

@ -200,32 +200,32 @@
; Characters
;---------------------------------------------------------------------------------------------
(define-inline (char? x) %residual-char? (%charp x))
; (char? x)
(define-inline (char-cmp x y) %residual-char-cmp (%ccmp x y))
(define-inline (char=? x y) %residual-char=? (%ceq x y))
(define-inline (char<? x y) %residual-char<? (%clt x y))
(define-inline (char<=? x y) %residual-char<=? (%cle x y))
(define-inline (char>? x y) %residual-char>? (%cgt x y))
(define-inline (char>=? x y) %residual-char>=? (%cge x y))
; (char-cmp c1 c2)
; (char=? c1 c2 c ...)
; (char<? c1 c2 c ...)
; (char>? c1 c2 c ...)
; (char<=? c1 c2 c ...)
; (char>=? c1 c2 c ...)
(define-inline (char-ci-cmp x y) %residual-char-cmp (%cicmp x y))
(define-inline (char-ci=? x y) %residual-char-ci=? (%cieq x y))
(define-inline (char-ci<? x y) %residual-char-ci<? (%cilt x y))
(define-inline (char-ci<=? x y) %residual-char-ci<=? (%cile x y))
(define-inline (char-ci>? x y) %residual-char-ci>? (%cigt x y))
(define-inline (char-ci>=? x y) %residual-char-ci>=? (%cige x y))
; (char-ci-cmp c1 c2)
; (char-ci=? c1 c2 c ...)
; (char-ci<? c1 c2 c ...)
; (char-ci>? c1 c2 c ...)
; (char-ci<=? c1 c2 c ...)
; (char-ci>=? c1 c2 c ...)
(define-inline (char-alphabetic? x) %residual-char-alphabetic? (%calp x))
(define-inline (char-numeric? x) %residual-char-numeric? (%cnup x))
(define-inline (char-whitespace? x) %residual-char-whitespace? (%cwsp x))
(define-inline (char-upper-case? x) %residual-char-upper-case? (%cucp x))
(define-inline (char-lower-case? x) %residual-char-lower-case? (%clcp x))
(define-inline (char-upcase x) %residual-char-upcase (%cupc x))
(define-inline (char-downcase x) %residual-char-downcase (%cdnc x))
; (char-alphabetic? c)
; (char-numeric? x)
; (char-whitespace? c)
; (char-upper-case? c)
; (char-lower-case? c)
; (char-upcase c)
; (char-downcase c)
(define-inline (char->integer x) %residual-char->integer (%ctoi x))
(define-inline (integer->char x) %residual-integer->char (%itoc x))
; (char->integer c)
; (integer->char n)
;char-foldcase
;digit-value
@ -235,11 +235,9 @@
; Symbols
;---------------------------------------------------------------------------------------------
(define-inline (symbol? x) %residual-symbol? (%symp x))
(define-inline (symbol->string x) %residual-symbol->string (%ytos x))
(define-inline (string->symbol x) %residual-string->symbol (%stoy x))
; (symbol? x)
; (symbol->string y)
; (string->symbol s)
;---------------------------------------------------------------------------------------------
@ -284,13 +282,14 @@
; (length l)
; (list-ref l i)
; (list-set! l i v)
; (list-set! l i x)
; (list-cat l1 l2)
(define-syntax append
(syntax-rules ()
[(_) '()] [(_ x) x]
[(_ x y) (%lcat x y)]
[(_ x y z ...) (%lcat x (append y z ...))]
[(_ x y) (list-cat x y)]
[(_ x y z ...) (list-cat x (append y z ...))]
[_ %residual-append]))
; (memq v l)
@ -353,41 +352,33 @@
; Vectors
;---------------------------------------------------------------------------------------------
(define-inline (vector? x) %residual-vector? (%vecp x))
; (vector? x)
(define-syntax vector %vec)
(define-syntax make-vector
(syntax-rules ()
[(_ n) (%vmk n #f)]
[(_ n v) (%vmk n v)]
[(_ . args) (%residual-make-vector . args)]
[_ %residual-make-vector]))
(define-inline (vector-length x) %residual-vector-length (%vlen x))
(define-inline (vector-ref x i) %residual-vector-ref (%vget x i))
(define-inline (vector-set! x i v) %residual-vector-set! (%vput x i v))
(define-inline (list->vector x) %residual-list->vector (%ltov x))
; (make-vector n (i #f))
; (vector-length v)
; (vector-ref v i)
; (vector-set! v i x)
; (list->vector x)
; (vector-cat v1 v2)
(define (subvector->list vec start end)
(let loop ([i (fx- end 1)] [l '()])
(if (fx<? i start) l (loop (fx- i 1) (cons (vector-ref vec i) l)))))
(define-syntax vector->list
(syntax-rules ()
[(_ x) (%vtol x)]
[(_ . r) (%residual-vector->list . r)]
[_ %residual-vector->list]))
(define %residual-vector->list
(define %vector->list
(case-lambda
[(vec) (%vtol 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)]
[(_ . r) (%vector->list . r)]
[_ %vector->list]))
(define (subvector-copy! to at from start end)
(let ([limit (fxmin end (fx+ start (fx- (vector-length to) at)))])
(if (fx<=? at start)
@ -452,66 +443,52 @@
(subvector-copy! to i vec 0 len)
(loop vecs (fx+ i len)))))))
(define (%residual-vector-append . vecs)
(define (%vector-append . vecs)
(vectors-copy-into! (make-vector (vectors-sum-length vecs)) vecs))
(define-syntax vector-append
(syntax-rules ()
[(_) '#()] [(_ x) (%ckv x)]
[(_ x y) (%vcat x y)]
[(_ . r) (%residual-vector-append . r)]
[_ %residual-vector-append]))
[(_ x y) (vector-cat x y)]
[(_ . r) (%vector-append . r)]
[_ %vector-append]))
;---------------------------------------------------------------------------------------------
; Strings
;---------------------------------------------------------------------------------------------
(define-inline (string? x) %residual-string? (%strp x))
; (string? x)
(define-syntax string
(syntax-rules ()
[(_ c ...) (%str c ...)]
[_ %residual-string]))
(define-syntax make-string
(syntax-rules ()
[(_ x) (%smk x #\space)]
[(_ x y) (%smk x y)]
[(_ . args) (%residual-make-string . args)]
[_ %residual-make-string]))
(define-inline (string-length x) %residual-string-length (%slen x))
(define-inline (string-ref x i) %residual-string-ref (%sget x i))
(define-inline (string-set! x i v) %residual-string-set! (%sput x i v))
(define-syntax string-append
(syntax-rules ()
[(_) ""] [(_ x) (%cks x)]
[(_ x y) (%scat x y)]
[(_ x y z ...) (string-append x (string-append y z ...))]
[_ %residual-string-append]))
(define-inline (list->string x) %residual-list->string (%ltos x))
; (make-string n (i #\space))
; (string-length s)
; (string-ref x i)
; (string-set! x i v) %residual-string-set! (%sput x i v))
; (list->string l)
; (string-cat s1 s2)
; (substring s from to)
(define (substring->list str start end)
(let loop ([i (fx- end 1)] [l '()])
(if (fx<? i start) l (loop (fx- i 1) (cons (string-ref str i) l)))))
(define-syntax string->list
(syntax-rules ()
[(_ x) (%stol x)]
[(_ . r) (%residual-string->list . r)]
[_ %residual-string->list]))
(define %residual-string->list
(define %string->list
(case-lambda
[(str) (%stol 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)]
[(_ . r) (%string->list . r)]
[_ %string->list]))
(define (substring-copy! to at from start end)
(let ([limit (fxmin end (fx+ start (fx- (string-length to) at)))])
(if (fx<=? at start)
@ -528,8 +505,6 @@
[(to at from start) (substring-copy! to at from start (string-length from))]
[(to at from start end) (substring-copy! to at from start end)]))
(define-inline (substring x s e) %residual-substring (%ssub x s e))
(define string-copy
(case-lambda
[(str) (substring str 0 (string-length str))] ; TODO: %scpy ?
@ -573,28 +548,29 @@
(substring-copy! to i str 0 len)
(loop strs (fx+ i len)))))))
(define (%residual-string-append . strs)
(define (%string-append . strs)
(strings-copy-into! (make-string (strings-sum-length strs)) strs))
(define-syntax string-append
(syntax-rules ()
[(_) ""] [(_ x) (%cks x)]
[(_ x y) (%scat x y)]
[(_ . r) (%residual-string-append . r)]
[_ %residual-string-append]))
[(_ x y) (string-cat x y)]
[(_ . r) (%string-append . r)]
[_ %string-append]))
(define-inline (string-cmp x y) %residual-string-cmp (%scmp x y))
(define-inline (string=? x y) %residual-string<? (%seq x y))
(define-inline (string<? x y) %residual-string<? (%slt x y))
(define-inline (string<=? x y) %residual-string<=? (%sle x y))
(define-inline (string>? x y) %residual-string>? (%sgt x y))
(define-inline (string>=? x y) %residual-string>=? (%sge x y))
(define-inline (string-ci-cmp x y) %residual-string-cmp (%sicmp x y))
(define-inline (string-ci=? x y) %residual-string<? (%sieq x y))
(define-inline (string-ci<? x y) %residual-string<? (%silt x y))
(define-inline (string-ci<=? x y) %residual-string<=? (%sile x y))
(define-inline (string-ci>? x y) %residual-string>? (%sigt x y))
(define-inline (string-ci>=? x y) %residual-string>=? (%sige x y))
; (string-cmp s1 s2)
; (string=? s1 s2 s ...)
; (string<? s1 s2 s ...)
; (string>? s1 s2 s ...)
; (string<=? s1 s2 s ...)
; (string>=? s1 s2 s ...)
; (string-ci-cmp s1 s2)
; (string-ci=? s1 s2 s ...)
; (string-ci<? s1 s2 s ...)
; (string-ci>? s1 s2 s ...)
; (string-ci<=? s1 s2 s ...)
; (string-ci>=? s1 s2 s ...)
;string-upcase
;string-downcase
@ -617,7 +593,7 @@
; Control features
;---------------------------------------------------------------------------------------------
(define-inline (procedure? x) %residual-procedure? (%funp x))
; (procedure? x)
(define-syntax apply
(syntax-rules ()
@ -847,8 +823,6 @@
(define (%residual-list . l) l)
(define %residual-make-list (unary-binary-adaptor make-list))
(define %residual-make-vector (unary-binary-adaptor make-vector))
(define %residual-make-string (unary-binary-adaptor make-string))
(define-syntax minmax-reducer
(syntax-rules ()
@ -916,6 +890,3 @@
[else (f (car args) (loop (cdr args)))])))]))
(define %residual-append (append-reducer append '()))
(define %residual-string-append (append-reducer string-append ""))
(define %residual-vector-append (append-reducer vector-append '#()))