new integrable model, part V (fl+, fl-, 'p','m'))

This commit is contained in:
ESL 2023-03-19 23:31:28 -04:00
parent 328046cf4a
commit d820f510b3
7 changed files with 1663 additions and 1258 deletions

168
i.c
View file

@ -440,19 +440,42 @@ define_instrhelper(cxi_failactype) {
{ ac = _x; spush((obj)"integrable entry"); musttail return cxi_failactype(IARGS); } } while (0) { ac = _x; spush((obj)"integrable entry"); musttail return cxi_failactype(IARGS); } } while (0)
define_instruction(halt) { unwindi(0); } define_instruction(halt) {
unwindi(0);
}
define_instruction(lit) { ac = *ip++; gonexti(); } define_instruction(lit) {
ac = *ip++;
gonexti();
}
define_instruction(sref) { int i = fixnum_from_obj(*ip++); ac = sref(i); gonexti(); } define_instruction(sref) {
int i = fixnum_from_obj(*ip++);
ac = sref(i);
gonexti();
}
define_instruction(dref) { int i = fixnum_from_obj(*ip++); ac = dref(i); gonexti(); } define_instruction(dref) {
int i = fixnum_from_obj(*ip++);
ac = dref(i);
gonexti();
}
define_instruction(gref) { obj p = *ip++; ac = gref(p); gonexti(); } define_instruction(gref) {
obj p = *ip++;
ac = gref(p);
gonexti();
}
define_instruction(iref) { ac = boxref(ac); gonexti(); } define_instruction(iref) {
ac = boxref(ac);
gonexti();
}
define_instruction(iset) { boxref(ac) = spop(); gonexti(); } define_instruction(iset) {
boxref(ac) = spop();
gonexti();
}
define_instruction(dclose) { define_instruction(dclose) {
int i, n = fixnum_from_obj(*ip++), c = n+1; int i, n = fixnum_from_obj(*ip++), c = n+1;
@ -473,11 +496,33 @@ define_instruction(sbox) {
gonexti(); gonexti();
} }
define_instruction(br) { int dx = fixnum_from_obj(*ip++); ip += dx; gonexti(); } define_instruction(br) {
int dx = fixnum_from_obj(*ip++);
ip += dx;
gonexti();
}
define_instruction(brt) { int dx = fixnum_from_obj(*ip++); if (ac) ip += dx; gonexti(); } define_instruction(brt) {
int dx = fixnum_from_obj(*ip++);
if (ac) ip += dx;
gonexti();
}
define_instruction(brnot) { int dx = fixnum_from_obj(*ip++); if (!ac) ip += dx; gonexti(); } define_instruction(brnot) {
int dx = fixnum_from_obj(*ip++);
if (!ac) ip += dx;
gonexti();
}
define_instruction(andbo) {
if (ac) { /* go to next binary instruction w/2 args */
ac = spop();
} else { /* skip the next instruction, drop its args */
sdrop(2);
ip += 1;
}
gonexti();
}
define_instruction(sseti) { define_instruction(sseti) {
int i = fixnum_from_obj(*ip++); int i = fixnum_from_obj(*ip++);
@ -723,7 +768,10 @@ define_instruction(adrop) {
gonexti(); gonexti();
} }
define_instruction(pop) { ac = spop(); gonexti(); } define_instruction(pop) {
ac = spop();
gonexti();
}
define_instruction(atest) { define_instruction(atest) {
obj no = *ip++; obj no = *ip++;
@ -751,7 +799,7 @@ define_instruction(shrarg) {
sdrop(c-n); sdrop(c-n);
spush(l); spush(l);
} }
/* ac = obj_from_fixnum(n+1); */ ac = obj_from_fixnum(n+1);
gonexti(); gonexti();
} }
@ -760,8 +808,17 @@ define_instruction(aerr) {
gonexti(); gonexti();
} }
define_instruction(shlit) { spush(ac); ac = *ip++; gonexti(); } define_instruction(shlit) {
define_instruction(shi0) { spush(ac); ac = obj_from_fixnum(0); gonexti(); } spush(ac);
ac = *ip++;
gonexti();
}
define_instruction(shi0) {
spush(ac);
ac = obj_from_fixnum(0);
gonexti();
}
/* type checks */ /* type checks */
@ -2649,11 +2706,30 @@ define_instruction(sreturn4) {
retfromi(); retfromi();
} }
define_instruction(atest0) { if (unlikely(ac != obj_from_fixnum(0))) fail("argument count error on entry"); gonexti(); } define_instruction(atest0) {
define_instruction(atest1) { if (unlikely(ac != obj_from_fixnum(1))) fail("argument count error on entry"); gonexti(); } if (unlikely(ac != obj_from_fixnum(0))) fail("argument count error on entry");
define_instruction(atest2) { if (unlikely(ac != obj_from_fixnum(2))) fail("argument count error on entry"); gonexti(); } gonexti();
define_instruction(atest3) { if (unlikely(ac != obj_from_fixnum(3))) fail("argument count error on entry"); gonexti(); } }
define_instruction(atest4) { if (unlikely(ac != obj_from_fixnum(4))) fail("argument count error on entry"); gonexti(); }
define_instruction(atest1) {
if (unlikely(ac != obj_from_fixnum(1))) fail("argument count error on entry");
gonexti();
}
define_instruction(atest2) {
if (unlikely(ac != obj_from_fixnum(2))) fail("argument count error on entry");
gonexti();
}
define_instruction(atest3) {
if (unlikely(ac != obj_from_fixnum(3))) fail("argument count error on entry");
gonexti();
}
define_instruction(atest4) {
if (unlikely(ac != obj_from_fixnum(4))) fail("argument count error on entry");
gonexti();
}
define_instruction(scall1) { define_instruction(scall1) {
int m = 1, n = fixnum_from_obj(*ip++); int m = 1, n = fixnum_from_obj(*ip++);
@ -2948,23 +3024,14 @@ static const char *integrable_global(struct intgtab_entry *pi)
static const char *integrable_code(struct intgtab_entry *pi, int n) static const char *integrable_code(struct intgtab_entry *pi, int n)
{ {
static char buf[60]; char *ps, *code = NULL; char *ps, *code = NULL; int it = pi->igtype;
int it = pi->igtype;
if (it >= ' ') { if (it >= ' ') {
ps = pi->enc; ps = pi->enc; assert(ps);
while (ps && n-- > 0) { while (ps && n-- > 0) {
ps = strchr(ps, '\t'); ps += strlen(ps) + 1; /* \0 terminates each field */
if (ps) ps += 1; assert(*ps);
}
if (ps) {
code = ps; ps = strchr(ps, '\t');
if (ps) {
assert(ps-code < sizeof(buf));
strncpy(buf, code, ps-code);
buf[ps-code] = 0;
code = buf;
}
} }
code = ps;
} }
return code; return code;
} }
@ -3371,6 +3438,19 @@ more:
*--hp = obj_from_size(PAIR_BTAG); sref(0) = hendblk(3); *--hp = obj_from_size(PAIR_BTAG); sref(0) = hendblk(3);
goto more; goto more;
} break; } break;
case 'a': { /* andbo */
hreserve(hbsz(3), sp-r);
*--hp = sref(0); *--hp = pbr->g;
*--hp = obj_from_size(PAIR_BTAG); sref(0) = hendblk(3);
c = iportpeekc(sref(1));
if (c == EOF || c == '}') { ra = mkeof(); goto out; }
pbr = rds_prefix(sref(1));
if (pbr->g == 0 || pbr->etyp != 0) { ra = mkeof(); goto out; }
hreserve(hbsz(3), sp-r);
*--hp = sref(0); *--hp = pbr->g;
*--hp = obj_from_size(PAIR_BTAG); sref(0) = hendblk(3);
goto more;
} break;
case 's': { /* save */ case 's': { /* save */
fixnum_t n; fixnum_t n;
ra = sref(1); hp = rds_block(r, sp, hp); ra = sref(1); hp = rds_block(r, sp, hp);
@ -3390,9 +3470,7 @@ more:
case 'd': { /* dclose */ case 'd': { /* dclose */
fixnum_t n; fixnum_t n;
ra = sref(1); hp = rds_arg(r, sp, hp); ra = sref(1); hp = rds_arg(r, sp, hp);
if (!is_fixnum_obj(ra)) { if (!is_fixnum_obj(ra)) { ra = mkeof(); goto out; }
ra = mkeof(); goto out;
}
n = fixnum_from_obj(ra); n = fixnum_from_obj(ra);
ra = sref(1); hp = rds_block(r, sp, hp); ra = sref(1); hp = rds_block(r, sp, hp);
if (iseof(ra)) goto out; if (iseof(ra)) goto out;
@ -3475,7 +3553,7 @@ static obj *rds_stoc(obj *r, obj *sp, obj *hp)
static obj *rds_intgtab(obj *r, obj *sp, obj *hp) static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
{ {
int i, n = sizeof(intgtab)/sizeof(intgtab[0]); int i, n = sizeof(intgtab)/sizeof(intgtab[0]);
char lbuf[60], *lcode; char lbuf[200], *lcode, *pe0, *pe1;
if (!intgtab_sorted) sort_intgtab(n); if (!intgtab_sorted) sort_intgtab(n);
for (i = 0; i < n; ++i) { for (i = 0; i < n; ++i) {
struct intgtab_entry *pe = &intgtab[i]; struct intgtab_entry *pe = &intgtab[i];
@ -3488,16 +3566,26 @@ static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
break; break;
case 1: case '1': case 1: case '1':
lcode = lbuf; assert(pe->enc); lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%1_!%s]0", pe->enc); // "%%1.0%s]1" sprintf(lbuf, "%%1_!%s]0", pe->enc);
break; break;
case 2: case '2': case 2: case '2':
lcode = lbuf; assert(pe->enc); lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%2_!%s]0", pe->enc); // %%2.1,.1%s]2 sprintf(lbuf, "%%2_!%s]0", pe->enc);
break; break;
case 3: case '3': case 3: case '3':
lcode = lbuf; assert(pe->enc); lcode = lbuf; assert(pe->enc);
sprintf(lbuf, "%%3_!%s]0", pe->enc); // %%3.2,.2,.2%s]3 sprintf(lbuf, "%%3_!%s]0", pe->enc);
break; break;
case 'p': {
lcode = lbuf; assert(pe->enc);
pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
sprintf(lbuf, "%%!0.0u?{%s]1}.0d,.1a,,#0.0,&1{%%2.1u?{.0]2}.1d,.2a,.2%s,:0^[22}.!0.0^_1[12", pe1, pe0);
} break;
case 'm': {
lcode = lbuf; assert(pe->enc);
pe0 = pe->enc; pe1 = pe0 + strlen(pe0) + 1; assert(*pe1);
sprintf(lbuf, "%%!1.0u?{.1%s]2}.0,.2,,#0.0,&1{%%2.1u?{.0]2}.1d,.2a,.2%s,:0^[22}.!0.0^_1[22", pe1, pe0);
} break;
default: assert(0); default: assert(0);
} }
if (!lcode || *lcode == 0) continue; if (!lcode || *lcode == 0) continue;

5
i.h
View file

@ -52,6 +52,7 @@ declare_instruction(sbox, "#", 1, NULL, 0, NULL)
declare_instruction(br, NULL, 'b', NULL, 0, NULL) declare_instruction(br, NULL, 'b', NULL, 0, NULL)
declare_instruction(brnot, "?", 'b', NULL, 0, NULL) declare_instruction(brnot, "?", 'b', NULL, 0, NULL)
declare_instruction(brt, "~?", 'b', NULL, 0, NULL) declare_instruction(brt, "~?", 'b', NULL, 0, NULL)
declare_instruction(andbo, ";", 'a', NULL, 0, NULL)
declare_instruction(sseti, ".!", 1, NULL, 0, NULL) declare_instruction(sseti, ".!", 1, NULL, 0, NULL)
declare_instruction(dseti, ":!", 1, NULL, 0, NULL) declare_instruction(dseti, ":!", 1, NULL, 0, NULL)
declare_instruction(gloc, "`", 'g', NULL, 0, NULL) declare_instruction(gloc, "`", 'g', NULL, 0, NULL)
@ -286,8 +287,8 @@ declare_instruction(jintp, "Jw", 0, "flinteger?", '1', AUTOGL)
declare_instruction(jnanp, "Ju", 0, "flnan?", '1', AUTOGL) declare_instruction(jnanp, "Ju", 0, "flnan?", '1', AUTOGL)
declare_instruction(jfinp, "Jf", 0, "flfinite?", '1', AUTOGL) declare_instruction(jfinp, "Jf", 0, "flfinite?", '1', AUTOGL)
declare_instruction(jinfp, "Jh", 0, "flinfinite?", '1', AUTOGL) declare_instruction(jinfp, "Jh", 0, "flinfinite?", '1', AUTOGL)
declare_instruction(jadd, "J+", 0, "fl+", '2', AUTOGL) declare_instruction(jadd, "J+\0'(j0)", 0, "fl+", 'p', AUTOGL)
declare_instruction(jsub, "J-", 0, "fl-", '2', AUTOGL) declare_instruction(jsub, "J-\0J-!", 0, "fl-", 'm', AUTOGL)
declare_instruction(jmul, "J*", 0, "fl*", '2', AUTOGL) declare_instruction(jmul, "J*", 0, "fl*", '2', AUTOGL)
declare_instruction(jdiv, "J/", 0, "fl/", '2', AUTOGL) declare_instruction(jdiv, "J/", 0, "fl/", '2', AUTOGL)
declare_instruction(jquo, "Jq", 0, "flquotient", '2', AUTOGL) declare_instruction(jquo, "Jq", 0, "flquotient", '2', AUTOGL)

2376
k.c

File diff suppressed because it is too large Load diff

45
s.c
View file

@ -2,30 +2,6 @@
char *s_code[] = { char *s_code[] = {
0,
"@(y4:cons)@!(y14:%25residual-cons)",
0,
"@(y5:pair?)@!(y15:%25residual-pair?)",
0,
"@(y3:car)@!(y13:%25residual-car)",
0,
"@(y3:car)@!(y4:%25car)",
0,
"@(y3:cdr)@!(y13:%25residual-cdr)",
0,
"@(y3:cdr)@!(y4:%25cdr)",
0,
"@(y8:set-car!)@!(y18:%25residual-set-car!)",
0,
"@(y8:set-cdr!)@!(y18:%25residual-set-cdr!)",
"number?", "number?",
"l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25nump;y1:x;;;l2:py1:_;y" "l5:y12:syntax-rules;n;l2:l2:y1:_;y1:x;;l2:y5:%25nump;y1:x;;;l2:py1:_;y"
"12:syntax-rules;;py17:%25residual-number?;y12:syntax-rules;;;l2:y1:_;y" "12:syntax-rules;;py17:%25residual-number?;y12:syntax-rules;;;l2:y1:_;y"
@ -542,8 +518,8 @@ char *s_code[] = {
"&0{%2.1%l,.1A1]2}@!(y14:%25residual-memv)", "&0{%2.1%l,.1A1]2}@!(y14:%25residual-memv)",
0, 0,
"&0{%3.1p?{${.3a,.3,.6[02}?{.1]3}.2,.2d,.2,@(y7:%25member)[33}f]3}@!(y7" "&0{%3.1p?{${${.5,@(y4:%25car)[01},.3,.6[02}?{.1]3}.2,${.4,@(y4:%25cdr)"
":%25member)", "[01},.2,@(y7:%25member)[33}f]3}@!(y7:%25member)",
"member", "member",
"l6:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y1:y;;l3:y5:%25meme;y1:v;l2:y4:%" "l6:y12:syntax-rules;n;l2:l3:y1:_;y1:v;y1:y;;l3:y5:%25meme;y1:v;l2:y4:%"
@ -1391,19 +1367,18 @@ char *s_code[] = {
0, 0,
"&0{%!2.0u?{n,.3,,#0.0,.5,&2{%2.0p?{.1,${.3a,:0[01}c,.1d,:1^[22}.1A9]2}" "&0{%!2.0u?{n,.3,,#0.0,.5,&2{%2.0p?{.1,${.3a,:0[01}c,.1d,:1^[22}.1A9]2}"
".!0.0^_1[32}n,.1,.4c,,#0.0,.5,&2{%2${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{" ".!0.0^_1[32}n,.1,.4c,,#0.0,.5,&2{%2${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{"
".1d,:0^[21}f]2}.!0.0^_1[01}?{.1,${@(y13:%25residual-car),${.6,,#0.4,.1" ".1d,:0^[21}f]2}.!0.0^_1[01}?{.1,${@(y3:car),${.6,,#0.4,.1,&2{%1.0p?{${"
",&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:0,@(y5:%2" ".2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:0,@(y5:%25appl)[02}c,@"
"5appl)[02}c,@(y13:%25residual-cdr),${.4,,#0.4,.1,&2{%1.0p?{${.2d,:0^[0" "(y3:cdr),${.4,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0"
"1},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:1^[22}.1A9]2}.!0.0^_1[32}@!(y13" ".0^_1[01}_1,:1^[22}.1A9]2}.!0.0^_1[32}@!(y13:%25residual-map)",
":%25residual-map)",
0, 0,
"&0{%!2.0u?{.2,,#0.3,.1,&2{%1.0p?{${.2a,:1[01}.0d,:0^[11}]1}.!0.0^_1[31" "&0{%!2.0u?{.2,,#0.3,.1,&2{%1.0p?{${.2a,:1[01}.0d,:0^[11}]1}.!0.0^_1[31"
"}.0,.3c,,#0.3,.1,&2{%1${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{.1d,:0^[21}f]" "}.0,.3c,,#0.3,.1,&2{%1${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{.1d,:0^[21}f]"
"2}.!0.0^_1[01}?{${@(y13:%25residual-car),${.5,,#0.4,.1,&2{%1.0p?{${.2d" "2}.!0.0^_1[01}?{${@(y3:car),${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3"
",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:1,@(y5:%25appl)[02}@(y13:" "a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:1,@(y5:%25appl)[02}@(y3:cdr),${.3,,#0."
"%25residual-cdr),${.3,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1" "4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:0^[11"
"}n]1}.!0.0^_1[01}_1,:0^[11}]1}.!0.0^_1[31}@!(y18:%25residual-for-each)", "}]1}.!0.0^_1[31}@!(y18:%25residual-for-each)",
0, 0,
"&0{%!0.0,,#0.0,&1{%1.0u?{n]1}.0du?{.0a]1}${.2d,:0^[01},.1aL6]1}.!0.0^_" "&0{%!0.0,,#0.0,&1{%1.0u?{n]1}.0du?{.0a]1}${.2d,:0^[01},.1aL6]1}.!0.0^_"

View file

@ -1101,6 +1101,29 @@
(codegen (car args) l f s g #f port) (codegen (car args) l f s g #f port)
(unless (null? (cdr args)) (write-char #\, port))) (unless (null? (cdr args)) (write-char #\, port)))
(write-string igc0 port)] (write-string igc0 port)]
[(#\p) ; (length args) >= 0
(if (null? args)
(let ([igc1 (integrable-code ig 1)])
(write-string igc1 port))
(let ([opc (fx- (length args) 1)])
(do ([args (reverse args) (cdr args)] [l l (cons #f l)])
[(null? args)]
(codegen (car args) l f s g #f port)
(unless (null? (cdr args)) (write-char #\, port)))
(do ([i 0 (fx+ i 1)]) [(fx>=? i opc)]
(write-string igc0 port))))]
[(#\m) ; (length args) >= 1
(if (null? (cdr args))
(let ([igc1 (integrable-code ig 1)])
(codegen (car args) l f s g #f port)
(write-string igc1 port))
(let ([opc (fx- (length args) 1)])
(do ([args (reverse args) (cdr args)] [l l (cons #f l)])
[(null? args)]
(codegen (car args) l f s g #f port)
(unless (null? (cdr args)) (write-char #\, port)))
(do ([i 0 (fx+ i 1)]) [(fx>=? i opc)]
(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))] (when k (write-char #\] port) (write-serialized-arg k port))]
[call (exp . args) [call (exp . args)

252
src/s.scm
View file

@ -46,139 +46,89 @@
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Equivalence predicates ; Equivalence predicates
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
#|
(define-inline (eq? x y) %residual-eq? (%isq x y))
(define-inline (eqv? x y) %residual-eqv? (%isv x y)) ; integrables:
;
; (eq? x y)
; (eqv? x y)
; (equal? x y)
(define-inline (equal? x y) %residual-equal? (%ise x y))
|#
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Boxes, aka cells ; Boxes, aka cells
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
#| ; integrables:
(define-inline (box? x) %residual-box? (%boxp x)) ;
; (box? x)
; (box x)
; (unbox x)
; (set-box! x y)
(define-inline (box x) %residual-box (%box x))
(define-inline (unbox x) %residual-unbox (%unbox x))
(define-inline (set-box! x y) %residual-set-box! (%setbox x y))
|#
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Exact integer numbers (fixnums) ; Exact integer numbers (fixnums)
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
#| ; integrables:
;
; (fixnum? x)
; (fxzero? x)
; (fxpositive? x)
; (fxnegative? x)
; (fx+ x y)
; (fx* x y)
; (fx- x y)
; (fx/ x y)
; (fxquotient x y)
; (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
; (fxneg x)
; (fxabs x)
; (fx<? x y)
; (fx<=? x y)
; (fx>? x y)
; (fx>=? x y)
; (fx=? x y)
; (fxmin x y)
; (fxmax x y)
; (fixnum->flonum x)
(define-inline (fixnum? x) %residual-fixnum? (%fixp x))
(define-inline (fxzero? x) %residual-fxzero? (%izerop x))
(define-inline (fxpositive? x) %residual-fxpositive? (%iposp x))
(define-inline (fxnegative? x) %residual-fxnegative? (%inegp x))
(define-inline (fx+ x y) %residual-fx+ (%iadd x y))
(define-inline (fx* x y) %residual-fx* (%imul x y))
(define-inline (fx- x y) %residual-fx- (%isub x y))
(define-inline (fx/ x y) %residual-fx/ (%idiv x y))
(define-inline (fxquotient x y) %residual-fxquotient (%iquo x y))
(define-inline (fxremainder x y) %residual-fxremainder (%irem x y))
(define-inline (fxmodquo x y) %residual-fxmodquo (%imqu x y))
(define-inline (fxmodulo x y) %residual-fxmodulo (%imlo x y))
(define-inline (fxeucquo x y) %residual-fxeucquo (%ieuq x y)) ;euclidean-quotient
(define-inline (fxeucrem x y) %residual-fxeucrem (%ieur x y)) ;euclidean-remainder
(define-inline (fxneg x) %residual-fxneg (%ineg x))
(define-inline (fxabs x) %residual-fxabs (%iabs x))
(define-inline (fx<? x y) %residual-fx<? (%ilt x y))
(define-inline (fx<=? x y) %residual-fx<=? (%ile x y))
(define-inline (fx>? x y) %residual-fx>? (%igt x y))
(define-inline (fx>=? x y) %residual-fx>=? (%ige x y))
(define-inline (fx=? x y) %residual-fx=? (%ieq x y))
(define-inline (fxmin x y) %residual-fxmin (%imin x y))
(define-inline (fxmax x y) %residual-fxmax (%imax x y))
(define-inline (fixnum->flonum x) %residual-fixnum->flonum (%itoj x))
|#
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Inexact floating-point numbers (flonums) ; Inexact floating-point numbers (flonums)
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
#| ; integrables:
;
; (flonum? x)
; (flzero? x)
; (flpositive? x)
; (flnegative? x)
; (flinteger? x)
; (flnan? x)
; (flinfinite? x)
; (flfinite? x)
; (fleven? x)
; (flodd? x)
; (fl+ x y)
; (fl- x y)
; (fl* x y)
; (fl/ x y)
; (flneg x)
; (flabs x)
; (fl<? x y)
; (fl<=? x y)
; (fl>? x y)
; (fl>=? x y)
; (fl=? x y)
; (flmin x y)
; (flmax x y)
; (flonum->fixnum x)
(define-inline (flonum? x) %residual-flonum? (%flop x))
(define-inline (flzero? x) %residual-flzero? (%jzerop x))
(define-inline (flpositive? x) %residual-flpositive? (%jposp x))
(define-inline (flnegative? x) %residual-flnegative? (%jnegp x))
(define-inline (flinteger? x) %residual-flinteger? (%jintp x))
(define-inline (flnan? x) %residual-flnan? (%jnanp x))
(define-inline (flinfinite? x) %residual-flinfinite? (%jinfp x))
(define-inline (flfinite? x) %residual-flfinite? (%jfinp x))
(define-inline (fleven? x) %residual-fleven? (%jevnp x))
(define-inline (flodd? x) %residual-flodd? (%joddp x))
(define-inline (fl+ x y) %residual-fl+ (%jadd x y))
(define-inline (fl- x y) %residual-fl- (%jsub x y))
(define-inline (fl* x y) %residual-fl* (%jmul x y))
(define-inline (fl/ x y) %residual-fl/ (%jdiv x y))
(define-inline (flneg x) %residual-flneg (%jneg x))
(define-inline (flabs x) %residual-flabs (%jabs x))
(define-inline (fl<? x y) %residual-fl<? (%jlt x y))
(define-inline (fl<=? x y) %residual-fl<=? (%jle x y))
(define-inline (fl>? x y) %residual-fl>? (%jgt x y))
(define-inline (fl>=? x y) %residual-fl>=? (%jge x y))
(define-inline (fl=? x y) %residual-fl=? (%jeq x y))
(define-inline (flmin x y) %residual-flmin (%jmin x y))
(define-inline (flmax x y) %residual-flmax (%jmax x y))
(define-inline (flonum->fixnum x) %residual-flonum->fixnum (%jtoi x))
|#
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Numbers (fixnums or flonums) ; Numbers (fixnums or flonums)
@ -324,13 +274,11 @@
; Booleans ; Booleans
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
#| ; integrables:
;
; (boolean? x)
; (not x)
(define-inline (boolean? x) %residual-boolean? (%boolp x))
(define-inline (not x) %residual-not (%not x))
|#
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
; Characters ; Characters
@ -382,60 +330,16 @@
; Null and Pairs ; Null and Pairs
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
#| ; integrables:
(define-inline (null? x) %residual-null? (%nullp x)) ;
; (null? x)
(define-inline (pair? x) %residual-pair? (%pairp x)) ; (pair? x)
; (car x)
(define-inline (car x) %residual-car (%car x)) ; (set-car! x v)
; (cdr x)
(define-inline (set-car! x v) %residual-set-car! (%setcar x v)) ; (set-cdr! x v)
; (caar x) ... (cddddr x)
(define-inline (cdr x) %residual-cdr (%cdr x)) ; (cons x y)
(define-inline (set-cdr! x v) %residual-set-cdr! (%setcdr x v))
|#
(define-syntax c?r
(syntax-rules (a d)
[(c?r x) x]
[(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))
(define-inline (cddr x) %residual-cddr (c?r d d x))
(define-inline (caaar x) %residual-caaar (c?r a a a x))
(define-inline (caadr x) %residual-caadr (c?r a a d x))
(define-inline (cadar x) %residual-cadar (c?r a d a x))
(define-inline (caddr x) %residual-caddr (c?r a d d x))
(define-inline (cdaar x) %residual-cdaar (c?r d a a x))
(define-inline (cdadr x) %residual-cdadr (c?r d a d x))
(define-inline (cddar x) %residual-cddar (c?r d d a x))
(define-inline (cdddr x) %residual-cdddr (c?r d d d x))
(define-inline (caaaar x) %residual-caaaar (c?r a a a a x))
(define-inline (caaadr x) %residual-caaadr (c?r a a a d x))
(define-inline (caadar x) %residual-caadar (c?r a a d a x))
(define-inline (caaddr x) %residual-caaddr (c?r a a d d x))
(define-inline (cadaar x) %residual-cadaar (c?r a d a a x))
(define-inline (cadadr x) %residual-cadadr (c?r a d a d x))
(define-inline (caddar x) %residual-caddar (c?r a d d a x))
(define-inline (cadddr x) %residual-cadddr (c?r a d d d x))
(define-inline (cdaaar x) %residual-cdaaar (c?r d a a a x))
(define-inline (cdaadr x) %residual-cdaadr (c?r d a a d x))
(define-inline (cdadar x) %residual-cdadar (c?r d a d a x))
(define-inline (cdaddr x) %residual-cdaddr (c?r d a d d x))
(define-inline (cddaar x) %residual-cddaar (c?r d d a a x))
(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))
|#
;--------------------------------------------------------------------------------------------- ;---------------------------------------------------------------------------------------------
@ -480,7 +384,7 @@
(define-inline (memv v y) %residual-memv (%memv v (%ckl y))) ; TODO: make sure memv checks list (define-inline (memv v y) %residual-memv (%memv v (%ckl y))) ; TODO: make sure memv checks list
(define (%member x l eq) (define (%member x l eq)
(and (pair? l) (if (eq x (%car l)) l (%member x (%cdr l) eq)))) (and (pair? l) (if (eq x (car l)) l (%member x (cdr l) eq))))
(define-syntax member (define-syntax member
(syntax-rules () (syntax-rules ()

52
t.c
View file

@ -81,28 +81,28 @@ char *t_code[] = {
"t-req-count)", "t-req-count)",
0, 0,
"@(y15:%25residual-pair?)@!(y9:val-core?)", "@(y5:pair?)@!(y9:val-core?)",
0, 0,
"&0{%1.0p~]1}@!(y12:val-special?)", "&0{%1.0p~]1}@!(y12:val-special?)",
0, 0,
"@(y15:%25residual-pair?)@!(y8:binding?)", "@(y5:pair?)@!(y8:binding?)",
0, 0,
"@(y14:%25residual-cons)@!(y12:make-binding)", "@(y4:cons)@!(y12:make-binding)",
0, 0,
"@(y13:%25residual-cdr)@!(y11:binding-val)", "@(y3:cdr)@!(y11:binding-val)",
0, 0,
"&0{%1.0d,@(y12:val-special?)[11}@!(y16:binding-special?)", "&0{%1.0d,@(y12:val-special?)[11}@!(y16:binding-special?)",
0, 0,
"@(y13:%25residual-car)@!(y11:binding-sym)", "@(y3:car)@!(y11:binding-sym)",
0, 0,
"@(y18:%25residual-set-cdr!)@!(y16:binding-set-val!)", "@(y8:set-cdr!)@!(y16:binding-set-val!)",
0, 0,
"@(y14:%25residual-assq)@!(y16:find-top-binding)", "@(y14:%25residual-assq)@!(y16:find-top-binding)",
@ -295,26 +295,26 @@ char *t_code[] = {
"0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{${:7^[00}}_1.3,.3X0," "0[01}q}{f},.1^[41}.3,.3,.3cc]4}.1V0?{.2V0,.0?{.0}{${:7^[00}}_1.3,.3X0,"
".3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1ddg,.3L0?{.3g}{${:7^[" ".3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1ddg,.3L0?{.3g}{${:7^["
"00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${:4^,t,.(i10)a,:5^[0" "00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${:4^,t,.(i10)a,:5^[0"
"3},,#0.8,:6,&2{%1@(y13:%25residual-cdr),${n,.4,:1a,:0^[03},,#0.2,.1,&2" "3},,#0.8,:6,&2{%1@(y3:cdr),${n,.4,:1a,:0^[03},,#0.2,.1,&2{%1.0p?{${.2d"
"{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[21}.!0${.(i12),.6,." ",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[21}.!0${.(i12),.6,.(i12)dd,:6^[0"
"(i12)dd,:6^[03},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[0" "3},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0"
"1}c]1}n]1}.!0.0^_1[01}_1,.5c,@(y14:%25residual-list)c,@(y13:%25residua" ".0^_1[01}_1,.5c,@(y14:%25residual-list)c,@(y13:%25residual-map),@(y5:%"
"l-map),@(y5:%25appl)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[03},.3a,.3a,:6^" "25appl)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[03},.3a,.3a,:6^[43}:7^[40}.!"
"[43}:7^[40}.!0.0^_1[63}.!5.7,.2,.6,.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0[" "0.0^_1[63}.!5.7,.2,.6,.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0[01},@(y6:new-"
"01},@(y6:new-id)[01},.1c]1},${${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[0" "id)[01},.1c]1},${${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[03},,#0.4,.1,&"
"3},,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1" "2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1.!0${:2^,f,.7"
".!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2" ",:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,."
".5,.5,,#0.8,.4,.2,.8,:0,&5{%2.0,,#0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3" "4,.2,.8,:0,&5{%2.0,,#0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:3"
":id?)[01}?{:3,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${." ",.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:2^[01}X1"
"2X0,:2^[01}X1]1}.0p?{${.2d,:6^[01}?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A" "]1}.0p?{${.2d,:6^[01}?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A3d]1}.!0.2,.4"
"3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y14:%25residual-cons),@(y13:%25residu" ",:4,&3{%!0${.2,:2,@(y4:cons),@(y13:%25residual-map)[03},:1a,:0^[12}.!1"
"al-map)[03},:1a,:0^[12}.!1.0^,${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${" ".0^,${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1"
".3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,${.6dd,:2^[01},${.3,.6^c,@(y13:%25res" "[01}_1,${.6dd,:2^[01},${.3,.6^c,@(y13:%25residual-map),@(y5:%25appl)[0"
"idual-map),@(y5:%25appl)[02}L6]5}${.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}." "2}L6]5}${.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!6"
"!0.0^_1[21}.!0.0^_1[62}.!6.(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1" ".(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid sy"
".0u?{${:3,'(s14:invalid syntax),'(y9:transform),@(y5:error)[03}}.0a,.0" "ntax),'(y9:transform),@(y5:error)[03}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},"
"a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[2" ".0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i11)}@!(y13:syntax-rul"
"1}](i11)}@!(y13:syntax-rules*)", "es*)",
0, 0,
"${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n" "${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n"