mirror of
https://github.com/false-schemers/skint.git
synced 2025-02-01 07:57:49 +01:00
... more builtins as new integrables
This commit is contained in:
ESL
parent
ad3b6f9844
commit
b12db72d87
4 changed files with 177 additions and 594 deletions
87
i.h
87
i.h
|
|
@ -326,10 +326,10 @@ declare_instruction(eq, "=", 0, "=", 'c', AUTOGL)
|
|||
declare_instruction(ne, "=!", 0, "!=", '2', AUTOGL)
|
||||
declare_instruction(neg, "-!", 0, "neg", '1', AUTOGL)
|
||||
declare_instruction(abs, "G0", 0, "abs", '1', AUTOGL)
|
||||
declare_instruction(mqu, "G3", 0, "modquo", '2', AUTOGL)
|
||||
declare_instruction(mlo, "G4", 0, "modulo", '2', AUTOGL)
|
||||
declare_instruction(quo, "G5", 0, "quotient", '2', AUTOGL)
|
||||
declare_instruction(rem, "G6", 0, "remainder", '2', AUTOGL)
|
||||
declare_instruction(mqu, "G3", 0, "floor-quotient", '2', AUTOGL)
|
||||
declare_instruction(mlo, "G4", 0, "floor-remainder", '2', AUTOGL)
|
||||
declare_instruction(quo, "G5", 0, "truncate-quotient", '2', AUTOGL)
|
||||
declare_instruction(rem, "G6", 0, "truncate-remainder",'2', AUTOGL)
|
||||
declare_instruction(nump, "N0", 0, "number?", '1', AUTOGL)
|
||||
declare_instruction(intp, "N4", 0, "integer?", '1', AUTOGL)
|
||||
declare_instruction(nanp, "N5", 0, "nan?", '1', AUTOGL)
|
||||
|
|
@ -337,28 +337,28 @@ declare_instruction(finp, "N6", 0, "finite?", '1', AUTOGL)
|
|||
declare_instruction(infp, "N7", 0, "infinite?", '1', AUTOGL)
|
||||
declare_instruction(evnp, "N8", 0, "even?", '1', AUTOGL)
|
||||
declare_instruction(oddp, "N9", 0, "odd?", '1', AUTOGL)
|
||||
declare_instruction(ntoi, "M0", 0, "%ntoi", 1, INLINED)
|
||||
declare_instruction(ntoj, "M1", 0, "%ntoj", 1, INLINED)
|
||||
declare_instruction(ntoi, "M0", 0, "exact", '1', AUTOGL)
|
||||
declare_instruction(ntoj, "M1", 0, "inexact", '1', AUTOGL)
|
||||
declare_instruction(min, "M2", 0, "min", 'x', AUTOGL)
|
||||
declare_instruction(max, "M3", 0, "max", 'x', AUTOGL)
|
||||
declare_instruction(listp, "L0", 0, "%listp", 1, INLINED)
|
||||
declare_instruction(listp, "L0", 0, "list?", '1', AUTOGL)
|
||||
declare_instruction(list, "l", 1, "%list", -1, "%!0_!]0")
|
||||
declare_instrshadow(list, "L1", 1, NULL, 0, INLINED)
|
||||
declare_instruction(llen, "g", 0, "%llen", 1, INLINED)
|
||||
declare_instruction(llen, "g", 0, "length", '1', AUTOGL)
|
||||
declare_instrshadow(llen, "L3", 0, NULL, 0, INLINED)
|
||||
declare_instruction(lget, "L4", 0, "%lget", 2, INLINED)
|
||||
declare_instruction(lput, "L5", 0, "%lput", 3, 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(memq, "A0", 0, "%memq", 2, INLINED)
|
||||
declare_instruction(memv, "A1", 0, "%memv", 2, INLINED)
|
||||
declare_instruction(meme, "A2", 0, "%meme", 2, INLINED)
|
||||
declare_instruction(assq, "A3", 0, "%assq", 2, INLINED)
|
||||
declare_instruction(assv, "A4", 0, "%assv", 2, INLINED)
|
||||
declare_instruction(asse, "A5", 0, "%asse", 2, INLINED)
|
||||
declare_instruction(ltail, "A6", 0, "%ltail", 2, INLINED)
|
||||
declare_instruction(lpair, "A7", 0, "%lpair", 1, INLINED)
|
||||
declare_instruction(lrev, "A8", 0, "%lrev", 1, INLINED)
|
||||
declare_instruction(lrevi, "A9", 0, "%lrevi", 1, INLINED)
|
||||
declare_instruction(memq, "A0", 0, "memq", '2', AUTOGL)
|
||||
declare_instruction(memv, "A1", 0, "memv", '2', AUTOGL)
|
||||
declare_instruction(meme, "A2", 0, "meme", '2', AUTOGL)
|
||||
declare_instruction(assq, "A3", 0, "assq", '2', AUTOGL)
|
||||
declare_instruction(assv, "A4", 0, "assv", '2', AUTOGL)
|
||||
declare_instruction(asse, "A5", 0, "asse", '2', AUTOGL)
|
||||
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)
|
||||
|
|
@ -429,25 +429,25 @@ declare_instruction(symp, "Y0", 0, "%symp", 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)
|
||||
declare_instruction(sip, "P10", 0, "%sip", 0, INLINED)
|
||||
declare_instruction(sop, "P11", 0, "%sop", 0, INLINED)
|
||||
declare_instruction(sep, "P12", 0, "%sep", 0, INLINED)
|
||||
declare_instruction(ipop, "P20", 0, "%ipop", 1, INLINED)
|
||||
declare_instruction(opop, "P21", 0, "%opop", 1, INLINED)
|
||||
declare_instruction(otip, "P40", 0, "%otip", 1, INLINED)
|
||||
declare_instruction(otop, "P41", 0, "%otop", 1, INLINED)
|
||||
declare_instruction(ois, "P50", 0, "%ois", 1, INLINED)
|
||||
declare_instruction(oos, "P51", 0, "%oos", 0, INLINED)
|
||||
declare_instruction(cip, "P60", 0, "%cip", 1, INLINED)
|
||||
declare_instruction(cop, "P61", 0, "%cop", 1, INLINED)
|
||||
declare_instruction(gos, "P9", 0, "%gos", 1, INLINED)
|
||||
declare_instruction(rdc, "R0", 0, "%rdc", 1, INLINED)
|
||||
declare_instruction(rdac, "R1", 0, "%rdac", 1, INLINED)
|
||||
declare_instruction(rdcr, "R2", 0, "%rdcr", 1, INLINED)
|
||||
declare_instruction(eofp, "R8", 0, "%eofp", 1, INLINED)
|
||||
declare_instruction(eof, "R9", 0, "%eof", 0, INLINED)
|
||||
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)
|
||||
declare_instruction(sop, "P11", 0, "current-output-port",'0', AUTOGL)
|
||||
declare_instruction(sep, "P12", 0, "current-error-port",'0', AUTOGL)
|
||||
declare_instruction(ipop, "P20", 0, "input-port-open?", '1', AUTOGL)
|
||||
declare_instruction(opop, "P21", 0, "output-port-open?", '1', AUTOGL)
|
||||
declare_instruction(otip, "P40", 0, "open-input-file", '1', AUTOGL)
|
||||
declare_instruction(otop, "P41", 0, "open-output-file", '1', AUTOGL)
|
||||
declare_instruction(ois, "P50", 0, "open-input-string", '1', AUTOGL)
|
||||
declare_instruction(oos, "P51", 0, "open-output-string",'0', AUTOGL)
|
||||
declare_instruction(cip, "P60", 0, "close-input-port", '1', AUTOGL)
|
||||
declare_instruction(cop, "P61", 0, "close-output-port", '1', AUTOGL)
|
||||
declare_instruction(gos, "P9", 0, "get-output-string", '1', AUTOGL)
|
||||
declare_instruction(rdc, "R0\0P10", 0, "read-char", 'u', AUTOGL)
|
||||
declare_instruction(rdac, "R1\0P10", 0, "peek-char", 'u', AUTOGL)
|
||||
declare_instruction(rdcr, "R2\0P10", 0, "char-ready?", 'u', AUTOGL)
|
||||
declare_instruction(eofp, "R8", 0, "eof-object?", '1', AUTOGL)
|
||||
declare_instruction(eof, "R9", 0, "eof-object", '0', AUTOGL)
|
||||
declare_instruction(wrc, "W0\0P11", 0, "write-char", 'b', AUTOGL)
|
||||
declare_instruction(wrs, "W1\0P11", 0, "write-string", 'b', AUTOGL)
|
||||
declare_instruction(wrcd, "W4\0P11", 0, "display", 'b', AUTOGL)
|
||||
|
|
@ -468,6 +468,15 @@ declare_instruction(iggl, "U7", 0, "integrable-global", '1', AUTOGL)
|
|||
declare_instruction(igco, "U8", 0, "integrable-code", '2', AUTOGL)
|
||||
|
||||
/* inlined integrables (no custom instructions) */
|
||||
declare_integrable(NULL, "N0", 0, "complex?", '1', AUTOGL)
|
||||
declare_integrable(NULL, "N0", 0, "real?", '1', AUTOGL)
|
||||
declare_integrable(NULL, "N0", 0, "rational?", '1', AUTOGL)
|
||||
declare_integrable(NULL, "I0", 0, "exact-integer?", '1', AUTOGL)
|
||||
declare_integrable(NULL, "%nI0", 0, "exact?", '1', AUTOGL)
|
||||
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, "aaa", 0, "caaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daa", 0, "caadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ada", 0, "cadar", '1', AUTOGL)
|
||||
|
|
|
|||
338
s.c
338
s.c
|
|
@ -2,54 +2,6 @@
|
|||
|
||||
char *s_code[] = {
|
||||
|
||||
"complex?",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py7:number?;y4:args;;;l2:y1:_;"
|
||||
"y7:number?;;",
|
||||
|
||||
"real?",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py7:number?;y4:args;;;l2:y1:_;"
|
||||
"y7:number?;;",
|
||||
|
||||
"rational?",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py8:integer?;y4:args;;;l2:y1:_"
|
||||
";y8:integer?;;",
|
||||
|
||||
"exact-integer?",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py7:fixnum?;y4:args;;;l2:y1:_;"
|
||||
"y7:fixnum?;;",
|
||||
|
||||
"exact?",
|
||||
"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?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0%nI0]1}@!(y16:%25residual-exact?)",
|
||||
|
||||
"inexact?",
|
||||
"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?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0%nJ0]1}@!(y18:%25residual-inexact?)",
|
||||
|
||||
"truncate-quotient",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py8:quotient;y4:args;;;l2:y1:_"
|
||||
";y8:quotient;;",
|
||||
|
||||
"truncate-remainder",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py9:remainder;y4:args;;;l2:y1:"
|
||||
"_;y9:remainder;;",
|
||||
|
||||
"floor-quotient",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py6:modquo;y4:args;;;l2:y1:_;y"
|
||||
"6:modquo;;",
|
||||
|
||||
"floor-remainder",
|
||||
"l4:y12:syntax-rules;n;l2:py1:_;y4:args;;py6:modulo;y4:args;;;l2:y1:_;y"
|
||||
"6:modulo;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1G4,.2,.2G3,@(y5:%25sdmv)[22}@!(y6:floor/)",
|
||||
|
||||
|
|
@ -256,14 +208,6 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%1.0X5]1}@!(y24:%25residual-string->symbol)",
|
||||
|
||||
"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"
|
||||
"5:%25residual-list?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0L0]1}@!(y15:%25residual-list?)",
|
||||
|
||||
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)",
|
||||
|
|
@ -279,87 +223,27 @@ char *s_code[] = {
|
|||
"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"
|
||||
"12:syntax-rules;;py16:%25residual-length;y12:syntax-rules;;;l2:y1:_;y1"
|
||||
"6:%25residual-length;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0g]1}@!(y16:%25residual-length)",
|
||||
|
||||
"list-ref",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:i;;l3:y5:%25lget;y1:x;y1:i;;;"
|
||||
"l2:py1:_;y12:syntax-rules;;py18:%25residual-list-ref;y12:syntax-rules;"
|
||||
";;l2:y1:_;y18:%25residual-list-ref;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1L4]2}@!(y18:%25residual-list-ref)",
|
||||
|
||||
"list-set!",
|
||||
"l5:y12:syntax-rules;n;l2:l4:y1:_;y1:x;y1:i;y1:v;;l4:y5:%25lput;y1:x;y1"
|
||||
":i;y1:v;;;l2:py1:_;y12:syntax-rules;;py19:%25residual-list-set!;y12:sy"
|
||||
"ntax-rules;;;l2:y1:_;y19:%25residual-list-set!;;",
|
||||
|
||||
0,
|
||||
"&0{%3.2,.2,.2L5]3}@!(y19:%25residual-list-set!)",
|
||||
|
||||
"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;;",
|
||||
|
||||
"memq",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y1:y;;l3:y5:%25memq;y1:v;y1:y;;;"
|
||||
"l2:py1:_;y12:syntax-rules;;py14:%25residual-memq;y12:syntax-rules;;;l2"
|
||||
":y1:_;y14:%25residual-memq;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1A0]2}@!(y14:%25residual-memq)",
|
||||
|
||||
"memv",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y1:y;;l3:y5:%25memv;y1:v;l2:y4:%"
|
||||
"25ckl;y1:y;;;;l2:py1:_;y12:syntax-rules;;py14:%25residual-memv;y12:syn"
|
||||
"tax-rules;;;l2:y1:_;y14:%25residual-memv;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1%l,.1A1]2}@!(y14:%25residual-memv)",
|
||||
|
||||
0,
|
||||
"&0{%3.1p?{${.3a,.3,.6[02}?{.1]3}.2,.2d,.2,@(y7:%25member)[33}f]3}@!(y7"
|
||||
":%25member)",
|
||||
"&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)",
|
||||
|
||||
"member",
|
||||
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y1:y;;l3:y5:%25meme;y1:v;l2:y4:%"
|
||||
"25ckl;y1:y;;;;l2:l4:y1:_;y1:v;y1:y;y2:eq;;l4:y7:%25member;y1:v;y1:y;y2"
|
||||
":eq;;;l2:py1:_;y4:args;;py16:%25residual-member;y4:args;;;l2:y1:_;y16:"
|
||||
"%25residual-member;;",
|
||||
|
||||
"assq",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y1:y;;l3:y5:%25assq;y1:v;y1:y;;;"
|
||||
"l2:py1:_;y12:syntax-rules;;py14:%25residual-assq;y12:syntax-rules;;;l2"
|
||||
":y1:_;y14:%25residual-assq;;",
|
||||
"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.1,.1A3]2}@!(y14:%25residual-assq)",
|
||||
|
||||
"assv",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y1:y;;l3:y5:%25assv;y1:v;l2:y4:%"
|
||||
"25ckl;y1:y;;;;l2:py1:_;y12:syntax-rules;;py14:%25residual-assv;y12:syn"
|
||||
"tax-rules;;;l2:y1:_;y14:%25residual-assv;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1%l,.1A4]2}@!(y14:%25residual-assv)",
|
||||
|
||||
0,
|
||||
"&0{%3.1p?{${.3aa,.3,.6[02}?{.1a]3}.2,.2d,.2,@(y6:%25assoc)[33}f]3}@!(y"
|
||||
"6:%25assoc)",
|
||||
"&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)",
|
||||
|
||||
"assoc",
|
||||
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y2:al;;l3:y5:%25asse;y1:v;l2:y4:"
|
||||
"%25ckl;y2:al;;;;l2:l4:y1:_;y1:v;y2:al;y2:eq;;l4:y6:%25assoc;y1:v;y2:al"
|
||||
";y2:eq;;;l2:py1:_;y4:args;;py15:%25residual-assoc;y4:args;;;l2:y1:_;y1"
|
||||
"5:%25residual-assoc;;",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y2:al;;l3:y4:asse;y1:v;y2:al;;;l"
|
||||
"2:py1:_;y4:args;;py6:%25assoc;y4:args;;;l2:y1:_;y6:%25assoc;;",
|
||||
|
||||
"list-copy",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l3:y5:%25lcat;y1:x;l2:y5:quote;"
|
||||
|
|
@ -369,38 +253,6 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%1n,.1L6]1}@!(y19:%25residual-list-copy)",
|
||||
|
||||
"list-tail",
|
||||
"l5:y12:syntax-rules;n;l2:l3:y1:_;y1:x;y1:i;;l3:y6:%25ltail;y1:x;y1:i;;"
|
||||
";l2:py1:_;y12:syntax-rules;;py19:%25residual-list-tail;y12:syntax-rule"
|
||||
"s;;;l2:y1:_;y19:%25residual-list-tail;;",
|
||||
|
||||
0,
|
||||
"&0{%2.1,.1A6]2}@!(y19:%25residual-list-tail)",
|
||||
|
||||
"last-pair",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25lpair;y1:x;;;l2:py1:_;"
|
||||
"y12:syntax-rules;;py19:%25residual-last-pair;y12:syntax-rules;;;l2:y1:"
|
||||
"_;y19:%25residual-last-pair;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0A7]1}@!(y19:%25residual-last-pair)",
|
||||
|
||||
"reverse",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25lrev;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py17:%25residual-reverse;y12:syntax-rules;;;l2:y1:_;y"
|
||||
"17:%25residual-reverse;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0A8]1}@!(y17:%25residual-reverse)",
|
||||
|
||||
"reverse!",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y6:%25lrevi;y1:x;;;l2:py1:_;"
|
||||
"y12:syntax-rules;;py18:%25residual-reverse!;y12:syntax-rules;;;l2:y1:_"
|
||||
";y18:%25residual-reverse!;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0A9]1}@!(y18:%25residual-reverse!)",
|
||||
|
||||
"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;"
|
||||
|
|
@ -842,118 +694,6 @@ char *s_code[] = {
|
|||
",.2c,@(y18:%25residual-for-each),@(y5:%25appl)[32}@!(y15:vector-for-ea"
|
||||
"ch)",
|
||||
|
||||
"input-port?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25ipp;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py21:%25residual-input-port?;y12:syntax-rules;;;l2:y1:"
|
||||
"_;y21:%25residual-input-port?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P00]1}@!(y21:%25residual-input-port?)",
|
||||
|
||||
"output-port?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25opp;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py22:%25residual-output-port?;y12:syntax-rules;;;l2:y1"
|
||||
":_;y22:%25residual-output-port?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P01]1}@!(y22:%25residual-output-port?)",
|
||||
|
||||
"input-port-open?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25ipop;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py26:%25residual-input-port-open?;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y26:%25residual-input-port-open?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P20]1}@!(y26:%25residual-input-port-open?)",
|
||||
|
||||
"output-port-open?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25opop;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py27:%25residual-output-port-open?;y12:syntax-rules;;"
|
||||
";l2:y1:_;y27:%25residual-output-port-open?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P21]1}@!(y27:%25residual-output-port-open?)",
|
||||
|
||||
"current-input-port",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l1:y4:%25sip;;;l2:py1:_;y12:syntax-r"
|
||||
"ules;;py28:%25residual-current-input-port;y12:syntax-rules;;;l2:y1:_;y"
|
||||
"28:%25residual-current-input-port;;",
|
||||
|
||||
0,
|
||||
"&0{%0P10]0}@!(y28:%25residual-current-input-port)",
|
||||
|
||||
"current-output-port",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l1:y4:%25sop;;;l2:py1:_;y12:syntax-r"
|
||||
"ules;;py29:%25residual-current-output-port;y12:syntax-rules;;;l2:y1:_;"
|
||||
"y29:%25residual-current-output-port;;",
|
||||
|
||||
0,
|
||||
"&0{%0P11]0}@!(y29:%25residual-current-output-port)",
|
||||
|
||||
"current-error-port",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l1:y4:%25sep;;;l2:py1:_;y12:syntax-r"
|
||||
"ules;;py28:%25residual-current-error-port;y12:syntax-rules;;;l2:y1:_;y"
|
||||
"28:%25residual-current-error-port;;",
|
||||
|
||||
0,
|
||||
"&0{%0P12]0}@!(y28:%25residual-current-error-port)",
|
||||
|
||||
"open-output-string",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l1:y4:%25oos;;;l2:py1:_;y12:syntax-r"
|
||||
"ules;;py28:%25residual-open-output-string;y12:syntax-rules;;;l2:y1:_;y"
|
||||
"28:%25residual-open-output-string;;",
|
||||
|
||||
0,
|
||||
"&0{%0P51]0}@!(y28:%25residual-open-output-string)",
|
||||
|
||||
"open-input-file",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25otip;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py25:%25residual-open-input-file;y12:syntax-rules;;;l"
|
||||
"2:y1:_;y25:%25residual-open-input-file;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P40]1}@!(y25:%25residual-open-input-file)",
|
||||
|
||||
"open-output-file",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25otop;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py26:%25residual-open-output-file;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y26:%25residual-open-output-file;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P41]1}@!(y26:%25residual-open-output-file)",
|
||||
|
||||
"open-input-string",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25ois;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py27:%25residual-open-input-string;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y27:%25residual-open-input-string;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P50]1}@!(y27:%25residual-open-input-string)",
|
||||
|
||||
"close-input-port",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25cip;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py26:%25residual-close-input-port;y12:syntax-rules;;;l"
|
||||
"2:y1:_;y26:%25residual-close-input-port;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P60]1}@!(y26:%25residual-close-input-port)",
|
||||
|
||||
"close-output-port",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25cop;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py27:%25residual-close-output-port;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y27:%25residual-close-output-port;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P61]1}@!(y27:%25residual-close-output-port)",
|
||||
|
||||
"get-output-string",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y4:%25gos;y1:x;;;l2:py1:_;y1"
|
||||
"2:syntax-rules;;py27:%25residual-get-output-string;y12:syntax-rules;;;"
|
||||
"l2:y1:_;y27:%25residual-get-output-string;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0P9]1}@!(y27:%25residual-get-output-string)",
|
||||
|
||||
0,
|
||||
"&0{%1.0P00,.0?{.0]2}.1P01]2}@!(y5:port?)",
|
||||
|
||||
|
|
@ -970,45 +710,10 @@ char *s_code[] = {
|
|||
0,
|
||||
"&0{%2.1,.1P41,@(y14:call-with-port)[22}@!(y21:call-with-output-file)",
|
||||
|
||||
"read-char",
|
||||
"l6:y12:syntax-rules;n;l2:l1:y1:_;;l2:y4:%25rdc;l1:y4:%25sip;;;;l2:l2:y"
|
||||
"1:_;y1:p;;l2:y4:%25rdc;y1:p;;;l2:py1:_;y4:args;;py19:%25residual-read-"
|
||||
"char;y4:args;;;l2:y1:_;y19:%25residual-read-char;;",
|
||||
|
||||
"peek-char",
|
||||
"l6:y12:syntax-rules;n;l2:l1:y1:_;;l2:y5:%25rdac;l1:y4:%25sip;;;;l2:l2:"
|
||||
"y1:_;y1:p;;l2:y5:%25rdac;y1:p;;;l2:py1:_;y4:args;;py19:%25residual-pee"
|
||||
"k-char;y4:args;;;l2:y1:_;y19:%25residual-peek-char;;",
|
||||
|
||||
"char-ready?",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l2:y5:%25rdcr;l1:y4:%25sip;;;;l2:l2:"
|
||||
"y1:_;y1:p;;l2:y5:%25rdcr;y1:p;;;l2:y1:_;y21:%25residual-char-ready?;;",
|
||||
|
||||
0,
|
||||
"&0{%1P51,t,,#0.3,.3,.2,&3{%1:2R0,.0R8,.0?{.0}{'(c%0a),.2C=}_1?{.0R8?{."
|
||||
"1}{f}?{.0]2}:1P9,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}${:1,.3,@(y4:%25wrc)"
|
||||
"[02}f,:0^[21}.!0.0^_1[21}@!(y10:%25read-line)",
|
||||
|
||||
"read-line",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l2:y10:%25read-line;l1:y4:%25sip;;;;"
|
||||
"l2:l2:y1:_;y1:p;;l2:y10:%25read-line;y1:p;;;l2:y1:_;y19:%25residual-re"
|
||||
"ad-line;;",
|
||||
|
||||
"eof-object?",
|
||||
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25eofp;y1:x;;;l2:py1:_;y"
|
||||
"12:syntax-rules;;py21:%25residual-eof-object?;y12:syntax-rules;;;l2:y1"
|
||||
":_;y21:%25residual-eof-object?;;",
|
||||
|
||||
0,
|
||||
"&0{%1.0R8]1}@!(y21:%25residual-eof-object?)",
|
||||
|
||||
"eof-object",
|
||||
"l5:y12:syntax-rules;n;l2:l1:y1:_;;l1:y4:%25eof;;;l2:py1:_;y12:syntax-r"
|
||||
"ules;;py20:%25residual-eof-object;y12:syntax-rules;;;l2:y1:_;y20:%25re"
|
||||
"sidual-eof-object;;",
|
||||
|
||||
0,
|
||||
"&0{%0R9]0}@!(y20:%25residual-eof-object)",
|
||||
"&0{%!0P51,.1u?{P10}{.1a},t,,#0.2,.4,.2,&3{%1:2R0,.0R8,.0?{.0}{'(c%0a),"
|
||||
".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{%!0.0]1}@!(y14:%25residual-list)",
|
||||
|
|
@ -1029,14 +734,6 @@ char *s_code[] = {
|
|||
"ll?;y4:args;;y1:x;l3:y4:loop;l3:y1:f;y1:x;l2:y3:car;y4:args;;;l2:y3:cd"
|
||||
"r;y4:args;;;;;;;",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%l,.2A2]3}.0a,.3,.3,@(y7:%25member)[33}@!(y16:%25residual"
|
||||
"-member)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2%l,.2A5]3}.0a,.3,.3,@(y6:%25assoc)[33}@!(y15:%25residual-"
|
||||
"assoc)",
|
||||
|
||||
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*)",
|
||||
|
|
@ -1073,18 +770,5 @@ char *s_code[] = {
|
|||
"&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{%!0.0u?{P10R0]1}.0aR0]1}@!(y19:%25residual-read-char)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0u?{P10R1]1}.0aR1]1}@!(y19:%25residual-peek-char)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0u?{P10R2]1}.0aR2]1}@!(y21:%25residual-char-ready?)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0u?{P10,@(y10:%25read-line)[11}.0a,@(y10:%25read-line)[11}@!(y1"
|
||||
"9:%25residual-read-line)",
|
||||
|
||||
0, 0
|
||||
};
|
||||
|
|
|
|||
296
src/s.scm
296
src/s.scm
|
|
@ -84,8 +84,8 @@
|
|||
; (fxremainder x y)
|
||||
; (fxmodquo x y)
|
||||
; (fxmodulo x y)
|
||||
; (fxeucquo x y) a.k.a. euclidean-quotient
|
||||
; (fxeucrem x y) a.k.a. euclidean-remainder
|
||||
; (fxeucquo x y) a.k.a. euclidean-quotient, R6RS div
|
||||
; (fxeucrem x y) a.k.a. euclidean-remainder, R6RS mod
|
||||
; (fxneg x)
|
||||
; (fxabs x)
|
||||
; (fx<? x y z ...)
|
||||
|
|
@ -140,18 +140,13 @@
|
|||
;
|
||||
; (number? x)
|
||||
; (integer? x)
|
||||
; (complex? x) == number? what about inf and nan?
|
||||
; (real? x) == number? what about inf and nan?
|
||||
; (rational? x) == number? what about inf and nan?
|
||||
; (exact-integer? x) == fixnum?
|
||||
|
||||
(define-syntax complex? number?)
|
||||
|
||||
(define-syntax real? number?)
|
||||
|
||||
(define-syntax rational? integer?)
|
||||
|
||||
(define-syntax exact-integer? fixnum?)
|
||||
|
||||
(define-inline (exact? x) %residual-exact? (fixnum? (%ckn x)))
|
||||
|
||||
(define-inline (inexact? x) %residual-inexact? (flonum? (%ckn x)))
|
||||
; (exact? x)
|
||||
; (inexact? x)
|
||||
|
||||
; (finite? x)
|
||||
; (infinite? x)
|
||||
|
|
@ -175,17 +170,14 @@
|
|||
|
||||
; (abs x)
|
||||
|
||||
; (quotient x y)
|
||||
; (remainder x y)
|
||||
; (truncate-quotient x y)
|
||||
; (truncate-remainder x y)
|
||||
; (quotient x y) == truncate-quotient
|
||||
; (remainder x y) == truncate-remainder
|
||||
|
||||
(define-syntax truncate-quotient quotient)
|
||||
(define-syntax truncate-remainder remainder)
|
||||
|
||||
; (modquo x y) %residual-modquo (%mqu x y))
|
||||
; (modulo x y) %residual-modulo (%mlo x y))
|
||||
|
||||
(define-syntax floor-quotient modquo)
|
||||
(define-syntax floor-remainder modulo)
|
||||
; (floor-quotient x y)
|
||||
; (floor-remainder x y)
|
||||
; (modulo x y) = floor-remainder
|
||||
|
||||
(define (floor/ x y)
|
||||
(%sdmv (floor-quotient x y) (floor-remainder x y)))
|
||||
|
|
@ -270,7 +262,7 @@
|
|||
; Lists
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
(define-inline (list? x) %residual-list? (%listp x))
|
||||
; (list? x)
|
||||
|
||||
(define (%make-list n i)
|
||||
(let loop ([n (%ckk n)] [l '()])
|
||||
|
|
@ -290,11 +282,9 @@
|
|||
[(_ x ...) (%list x ...)]
|
||||
[_ %residual-list]))
|
||||
|
||||
(define-inline (length x) %residual-length (%llen x))
|
||||
|
||||
(define-inline (list-ref x i) %residual-list-ref (%lget x i))
|
||||
|
||||
(define-inline (list-set! x i v) %residual-list-set! (%lput x i v))
|
||||
; (length l)
|
||||
; (list-ref l i)
|
||||
; (list-set! l i v)
|
||||
|
||||
(define-syntax append
|
||||
(syntax-rules ()
|
||||
|
|
@ -303,43 +293,50 @@
|
|||
[(_ x y z ...) (%lcat x (append y z ...))]
|
||||
[_ %residual-append]))
|
||||
|
||||
(define-inline (memq v y) %residual-memq (%memq v y))
|
||||
; (memq v l)
|
||||
; (memv v l) ; TODO: make sure memv checks list
|
||||
; (meme v l) ; TODO: make sure meme checks list
|
||||
|
||||
(define-inline (memv v y) %residual-memv (%memv v (%ckl y))) ; TODO: make sure memv checks list
|
||||
|
||||
(define (%member x l eq)
|
||||
(and (pair? l) (if (eq x (car l)) l (%member x (cdr l) eq))))
|
||||
(define (%member v l . ?eq)
|
||||
(if (null? ?eq)
|
||||
(meme v l)
|
||||
(let loop ([v v] [l l] [eq (car ?eq)])
|
||||
(and (pair? l)
|
||||
(if (eq v (car l))
|
||||
l
|
||||
(loop v (cdr l) eq))))))
|
||||
|
||||
(define-syntax member
|
||||
(syntax-rules ()
|
||||
[(_ v y) (%meme v (%ckl y))] ; TODO: make sure meme checks list
|
||||
[(_ v y eq) (%member v y eq)]
|
||||
[(_ . args) (%residual-member . args)]
|
||||
[_ %residual-member]))
|
||||
[(_ v l) (meme v l)]
|
||||
[(_ . args) (%member . args)]
|
||||
[_ %member]))
|
||||
|
||||
(define-inline (assq v y) %residual-assq (%assq v y))
|
||||
; (assq v y)
|
||||
; (assv v y) ; TODO: make sure assv checks list
|
||||
; (asse v y) ; TODO: make sure asse checks list
|
||||
|
||||
(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 (caar al)) (car al) (%assoc v (cdr al) eq))))
|
||||
(define (%assoc v al . ?eq)
|
||||
(if (null? ?eq)
|
||||
(asse v al)
|
||||
(let loop ([v v] [al al] [eq (car ?eq)])
|
||||
(and (pair? al)
|
||||
(if (eq v (caar al))
|
||||
(car al)
|
||||
(loop v (cdr al) eq))))))
|
||||
|
||||
(define-syntax assoc
|
||||
(syntax-rules ()
|
||||
[(_ v al) (%asse v (%ckl al))] ; TODO: make sure asse checks list
|
||||
[(_ v al eq) (%assoc v al eq)]
|
||||
[(_ . args) (%residual-assoc . args)]
|
||||
[_ %residual-assoc]))
|
||||
[(_ v al) (asse v al)]
|
||||
[(_ . args) (%assoc . args)]
|
||||
[_ %assoc]))
|
||||
|
||||
(define-inline (list-copy x) %residual-list-copy (%lcat x '()))
|
||||
|
||||
(define-inline (list-tail x i) %residual-list-tail (%ltail x i))
|
||||
|
||||
(define-inline (last-pair x) %residual-last-pair (%lpair x))
|
||||
|
||||
(define-inline (reverse x) %residual-reverse (%lrev x))
|
||||
|
||||
(define-inline (reverse! x) %residual-reverse! (%lrevi x))
|
||||
; (list-tail l i)
|
||||
; (last-pair l)
|
||||
; (reverse l)
|
||||
; (reverse! l)
|
||||
|
||||
(define-syntax list*
|
||||
(syntax-rules ()
|
||||
|
|
@ -609,25 +606,12 @@
|
|||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
; (fixnum->string x (r 10))
|
||||
; (string->fixnum x (r 10))
|
||||
; (string->fixnum s (r 10))
|
||||
; (flonum->string x)
|
||||
; (string->flonum x)
|
||||
; (string->flonum s)
|
||||
; (number->string x (r 10))
|
||||
; (string->number s (r 10))
|
||||
|
||||
#|
|
||||
(define-syntax number->string
|
||||
(syntax-rules ()
|
||||
[(_ x r) (%ntos x r)]
|
||||
[(_ x) (%ntos x 10)]
|
||||
[(_ . args) (%residual-number->string . args)]
|
||||
[_ %residual-number->string]))
|
||||
|
||||
(define-syntax string->number
|
||||
(syntax-rules ()
|
||||
[(_ x r) (%ston x r)]
|
||||
[(_ x) (%ston x 10)]
|
||||
[(_ . args) (%residual-string->number . args)]
|
||||
[_ %residual-string->number]))
|
||||
|#
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Control features
|
||||
|
|
@ -699,33 +683,20 @@
|
|||
; I/O Ports
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
(define-inline (input-port? x) %residual-input-port? (%ipp x))
|
||||
|
||||
(define-inline (output-port? x) %residual-output-port? (%opp x))
|
||||
|
||||
(define-inline (input-port-open? x) %residual-input-port-open? (%ipop x))
|
||||
|
||||
(define-inline (output-port-open? x) %residual-output-port-open? (%opop x))
|
||||
|
||||
(define-inline (current-input-port) %residual-current-input-port (%sip))
|
||||
|
||||
(define-inline (current-output-port) %residual-current-output-port (%sop))
|
||||
|
||||
(define-inline (current-error-port) %residual-current-error-port (%sep))
|
||||
|
||||
(define-inline (open-output-string) %residual-open-output-string (%oos))
|
||||
|
||||
(define-inline (open-input-file x) %residual-open-input-file (%otip x))
|
||||
|
||||
(define-inline (open-output-file x) %residual-open-output-file (%otop x))
|
||||
|
||||
(define-inline (open-input-string x) %residual-open-input-string (%ois x))
|
||||
|
||||
(define-inline (close-input-port x) %residual-close-input-port (%cip x))
|
||||
|
||||
(define-inline (close-output-port x) %residual-close-output-port (%cop x))
|
||||
|
||||
(define-inline (get-output-string x) %residual-get-output-string (%gos x))
|
||||
; (input-port? x)
|
||||
; (output-port? x)
|
||||
; (input-port-open? p)
|
||||
; (output-port-open? p)
|
||||
; (current-input-port)
|
||||
; (current-output-port)
|
||||
; (current-error-port)
|
||||
; (open-output-string)
|
||||
; (open-input-file s)
|
||||
; (open-output-file x)
|
||||
; (open-input-string x)
|
||||
; (close-input-port x)
|
||||
; (close-output-port x)
|
||||
; (get-output-string x)
|
||||
|
||||
(define (port? x) (or (input-port? x) (output-port? x)))
|
||||
|
||||
|
|
@ -756,44 +727,27 @@
|
|||
; Input
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
(define-syntax read-char
|
||||
(syntax-rules ()
|
||||
[(_) (%rdc (%sip))]
|
||||
[(_ p) (%rdc p)]
|
||||
[(_ . args) (%residual-read-char . args)]
|
||||
[_ %residual-read-char]))
|
||||
|
||||
(define-syntax peek-char
|
||||
(syntax-rules ()
|
||||
[(_) (%rdac (%sip))]
|
||||
[(_ p) (%rdac p)]
|
||||
[(_ . args) (%residual-peek-char . args)]
|
||||
[_ %residual-peek-char]))
|
||||
; (read-char (p (current-input-port)))
|
||||
; (peek-char (p (current-input-port)))
|
||||
; (char-ready? (p (current-input-port)))
|
||||
|
||||
(define-syntax char-ready?
|
||||
(syntax-rules ()
|
||||
[(_) (%rdcr (%sip))]
|
||||
[(_ p) (%rdcr p)]
|
||||
[_ %residual-char-ready?]))
|
||||
|
||||
(define (%read-line p)
|
||||
(let ([op (%oos)])
|
||||
(define (read-line . ?p)
|
||||
(let ([p (if (null? ?p) (current-input-port) (car ?p))]
|
||||
[op (open-output-string)])
|
||||
(let loop ([read-nothing? #t])
|
||||
(let ([c (%rdc p)])
|
||||
(cond [(or (%eofp c) (char=? c #\newline))
|
||||
(if (and (%eofp c) read-nothing?) c
|
||||
(let ([s (%gos op)]) (%cop op) s))]
|
||||
(let ([c (read-char p)])
|
||||
(cond [(or (eof-object? c) (char=? c #\newline))
|
||||
(if (and (eof-object? c) read-nothing?)
|
||||
c
|
||||
(let ([s (get-output-string op)])
|
||||
(close-output-port op)
|
||||
s))]
|
||||
[(char=? c #\return) (loop #f)]
|
||||
[else (%wrc c op) (loop #f)])))))
|
||||
[else (write-char c op) (loop #f)])))))
|
||||
|
||||
(define-syntax read-line
|
||||
(syntax-rules ()
|
||||
[(_) (%read-line (%sip))]
|
||||
[(_ p) (%read-line p)]
|
||||
[_ %residual-read-line]))
|
||||
|
||||
(define-inline (eof-object? x) %residual-eof-object? (%eofp x))
|
||||
(define-inline (eof-object) %residual-eof-object (%eof))
|
||||
; (eof-object? x)
|
||||
; (eof-object)
|
||||
|
||||
;read
|
||||
;read-string
|
||||
|
|
@ -809,56 +763,14 @@
|
|||
; Output
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
(define-syntax write-char
|
||||
(syntax-rules ()
|
||||
[(_ x) (%wrc x (%sop))]
|
||||
[(_ x p) (%wrc x p)]
|
||||
[(_ . args) (%residual-write-char . args)]
|
||||
[_ %residual-write-char]))
|
||||
|
||||
(define-syntax write-string
|
||||
(syntax-rules ()
|
||||
[(_ x) (%wrs x (%sop))]
|
||||
[(_ x p) (%wrs x p)]
|
||||
[(_ . args) (%residual-write-string . args)]
|
||||
[_ %residual-write-string]))
|
||||
|
||||
(define-syntax display
|
||||
(syntax-rules ()
|
||||
[(_ x) (%wrcd x (%sop))]
|
||||
[(_ x p) (%wrcd x p)]
|
||||
[(_ . args) (%residual-display . args)]
|
||||
[_ %residual-display]))
|
||||
|
||||
(define-syntax write
|
||||
(syntax-rules ()
|
||||
[(_ x) (%wrcw x (%sop))]
|
||||
[(_ x p) (%wrcw x p)]
|
||||
[(_ . args) (%residual-write . args)]
|
||||
[_ %residual-write]))
|
||||
|
||||
(define-syntax newline
|
||||
(syntax-rules ()
|
||||
[(_) (%wrnl (%sop))]
|
||||
[(_ p) (%wrnl p)]
|
||||
[(_ . args) (%residual-newline . args)]
|
||||
[_ %residual-newline]))
|
||||
|
||||
(define-syntax write-shared
|
||||
(syntax-rules ()
|
||||
[(_ x) (%wrhw x (%sop))]
|
||||
[(_ x p) (%wrhw x p)]
|
||||
[(_ . args) (%residual-write-shared . args)]
|
||||
[_ %residual-write-shared]))
|
||||
|
||||
(define-syntax write-simple
|
||||
(syntax-rules ()
|
||||
[(_ x) (%wriw x (%sop))]
|
||||
[(_ x p) (%wriw x p)]
|
||||
[(_ . args) (%residual-write-simple . args)]
|
||||
[_ %residual-write-simple]))
|
||||
|#
|
||||
|
||||
; (write-char c (p (current-output-port)))
|
||||
; (write-string s (p (current-output-port)))
|
||||
; (display x (p (current-output-port)))
|
||||
; (write x (p (current-output-port)))
|
||||
; (newline (p (current-output-port)))
|
||||
; (write-shared x (p (current-output-port)))
|
||||
; (write-simple x (p (current-output-port)))
|
||||
|
||||
;flush-output-port
|
||||
|
||||
|
|
@ -969,9 +881,6 @@
|
|||
x
|
||||
(loop (f x (car args)) (cdr args))))))]))
|
||||
|
||||
(define %residual-member (binary-ternary-adaptor member))
|
||||
(define %residual-assoc (binary-ternary-adaptor assoc))
|
||||
|
||||
(define (%residual-list* x . l)
|
||||
(let loop ([x x] [l l])
|
||||
(if (null? l) x (cons x (loop (car l) (cdr l))))))
|
||||
|
|
@ -1010,22 +919,3 @@
|
|||
(define %residual-string-append (append-reducer string-append ""))
|
||||
(define %residual-vector-append (append-reducer vector-append '#()))
|
||||
|
||||
#|
|
||||
(define %residual-number->string (unary-binary-adaptor number->string))
|
||||
(define %residual-string->number (unary-binary-adaptor string->number))
|
||||
|#
|
||||
|
||||
(define %residual-read-char (nullary-unary-adaptor read-char))
|
||||
(define %residual-peek-char (nullary-unary-adaptor peek-char))
|
||||
(define %residual-char-ready? (nullary-unary-adaptor char-ready?))
|
||||
(define %residual-read-line (nullary-unary-adaptor read-line))
|
||||
|
||||
#|
|
||||
(define %residual-write-char (unary-binary-adaptor write-char))
|
||||
(define %residual-write-string (unary-binary-adaptor write-string))
|
||||
(define %residual-newline (nullary-unary-adaptor newline))
|
||||
(define %residual-display (unary-binary-adaptor display))
|
||||
(define %residual-write (unary-binary-adaptor write))
|
||||
(define %residual-write-simple (unary-binary-adaptor write-simple))
|
||||
(define %residual-write-shared (unary-binary-adaptor write-shared))
|
||||
|#
|
||||
|
|
|
|||
50
t.c
50
t.c
|
|
@ -105,7 +105,7 @@ char *t_code[] = {
|
|||
"@(y8:set-cdr!)@!(y16:binding-set-val!)",
|
||||
|
||||
0,
|
||||
"@(y14:%25residual-assq)@!(y16:find-top-binding)",
|
||||
"@(y4:assq)@!(y16:find-top-binding)",
|
||||
|
||||
0,
|
||||
"&0{%1,#0n,.2c.!0.0,&1{%0:0^]0}]2}@!(y6:new-id)",
|
||||
|
|
@ -140,17 +140,17 @@ char *t_code[] = {
|
|||
0,
|
||||
"&0{%3${.3,@(y3:id?)[01}?{${.4,.4,@(y9:xform-ref)[02},.0K0?{.1~}{f}?{.3"
|
||||
",${.6,.6,.5[02},.3,@(y5:xform)[43}.0]4}.1p~?{.2,.2,@(y11:xform-quote)["
|
||||
"32}.1a,.2d,${.6,.4,t,@(y5:xform)[03},.0,'(l1:y6:syntax;)%l,.1A1?{.2a]7"
|
||||
"}'(l1:y5:quote;)%l,.1A1?{.6,.3a,@(y11:xform-quote)[72}'(l1:y4:set!;)%l"
|
||||
",.1A1?{.6,.3da,.4a,@(y10:xform-set!)[73}'(l1:y5:begin;)%l,.1A1?{.6,.3,"
|
||||
"@(y11:xform-begin)[72}'(l1:y2:if;)%l,.1A1?{.6,.3,@(y8:xform-if)[72}'(l"
|
||||
"1:y6:lambda;)%l,.1A1?{.6,.3,@(y12:xform-lambda)[72}'(l1:y7:lambda*;)%l"
|
||||
",.1A1?{.6,.3,@(y13:xform-lambda*)[72}'(l1:y5:letcc;)%l,.1A1?{.6,.3,@(y"
|
||||
"11:xform-letcc)[72}'(l1:y6:withcc;)%l,.1A1?{.6,.3,@(y12:xform-withcc)["
|
||||
"72}'(l1:y4:body;)%l,.1A1?{.6,.3,@(y10:xform-body)[72}'(l1:y6:define;)%"
|
||||
"l,.1A1?{.6,.3da,.4a,@(y12:xform-define)[73}'(l1:y13:define-syntax;)%l,"
|
||||
".1A1?{.6,.3da,.4a,@(y19:xform-define-syntax)[73}t?{.1K0?{.6,${.9,.9,.6"
|
||||
"[02},.6,@(y5:xform)[73}.6,.3,.3,@(y10:xform-call)[73}f]7}@!(y5:xform)",
|
||||
"32}.1a,.2d,${.6,.4,t,@(y5:xform)[03},.0,'(l1:y6:syntax;),.1A1?{.2a]7}'"
|
||||
"(l1:y5:quote;),.1A1?{.6,.3a,@(y11:xform-quote)[72}'(l1:y4:set!;),.1A1?"
|
||||
"{.6,.3da,.4a,@(y10:xform-set!)[73}'(l1:y5:begin;),.1A1?{.6,.3,@(y11:xf"
|
||||
"orm-begin)[72}'(l1:y2:if;),.1A1?{.6,.3,@(y8:xform-if)[72}'(l1:y6:lambd"
|
||||
"a;),.1A1?{.6,.3,@(y12:xform-lambda)[72}'(l1:y7:lambda*;),.1A1?{.6,.3,@"
|
||||
"(y13:xform-lambda*)[72}'(l1:y5:letcc;),.1A1?{.6,.3,@(y11:xform-letcc)["
|
||||
"72}'(l1:y6:withcc;),.1A1?{.6,.3,@(y12:xform-withcc)[72}'(l1:y4:body;),"
|
||||
".1A1?{.6,.3,@(y10:xform-body)[72}'(l1:y6:define;),.1A1?{.6,.3da,.4a,@("
|
||||
"y12:xform-define)[73}'(l1:y13:define-syntax;),.1A1?{.6,.3da,.4a,@(y19:"
|
||||
"xform-define-syntax)[73}t?{.1K0?{.6,${.9,.9,.6[02},.6,@(y5:xform)[73}."
|
||||
"6,.3,.3,@(y10:xform-call)[73}f]7}@!(y5:xform)",
|
||||
|
||||
0,
|
||||
"&0{%2${.2,,#0.0,&1{%1${.2,@(y3:id?)[01}?{.0,@(y7:id->sym)[11}.0p?{${.2"
|
||||
|
|
@ -177,10 +177,10 @@ char *t_code[] = {
|
|||
|
||||
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;)%l,.1A1?{'("
|
||||
"l1:l1:y5:begin;;),.2L6,'(y2:if)c]4}'(l1:i3;)%l,.1A1?{.1,'(y2:if)c]4}t?"
|
||||
"{'(s17:malformed if form),'(y9:transform),@(y5:error)[42}f]4}'(s16:imp"
|
||||
"roper if form),'(y9:transform),@(y5:error)[22}@!(y8:xform-if)",
|
||||
"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,
|
||||
"&0{%3.1L0?{.2,&1{%1:0,.1,f,@(y5:xform)[13},${.4,,#0.4,.1,&2{%1.0p?{${."
|
||||
|
|
@ -216,15 +216,15 @@ char *t_code[] = {
|
|||
|
||||
0,
|
||||
"&0{%2.0u?{n,'(y5:begin)c]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;)%l,.1A1?{.4,.4dL6,."
|
||||
"9,.9,.9,.9,:0^[(i10)5}'(l1:y6:define;)%l,.1A1?{.3da,.4dda,${${.5,@(y7:"
|
||||
"id->sym)[01},@(y6:gensym)[01},${.(i10),.3,.6,@(y7:add-var)[03},.8,.(i1"
|
||||
"3),.3c,.(i13),.5c,.(i13),.7c,.4,:0^[(i14)5}'(l1:y13:define-syntax;)%l,"
|
||||
".1A1?{.3da,.4dda,${.9,'(l1:y9:undefined;),.5,@(y11:add-binding)[03},.7"
|
||||
",.(i12),tc,.(i12),.4c,.(i12),.6c,.4,:0^[(i13)5}t?{.1K0?{.4,${.8,.7,.6["
|
||||
"02}c,.9,.9,.9,.9,:0^[(i10)5}.5,.(i10),.(i10)A8,.(i10)A8,.(i10)A8,@(y12"
|
||||
":xform-labels)[(i10)5}f](i10)}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels)"
|
||||
"[55}.!0.0^_1[25}@!(y10:xform-body)",
|
||||
"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),."
|
||||
"3c,.(i13),.5c,.(i13),.7c,.4,:0^[(i14)5}'(l1:y13:define-syntax;),.1A1?{"
|
||||
".3da,.4dda,${.9,'(l1:y9:undefined;),.5,@(y11:add-binding)[03},.7,.(i12"
|
||||
"),tc,.(i12),.4c,.(i12),.6c,.4,:0^[(i13)5}t?{.1K0?{.4,${.8,.7,.6[02}c,."
|
||||
"9,.9,.9,.9,:0^[(i10)5}.5,.(i10),.(i10)A8,.(i10)A8,.(i10)A8,@(y12:xform"
|
||||
"-labels)[(i10)5}f](i10)}.0,.5,.5A8,.5A8,.5A8,@(y12:xform-labels)[55}.!"
|
||||
"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"
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue