mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-26 21:58:51 +01:00
new integrable model, part V (fl+, fl-, 'p','m'))
This commit is contained in:
ESL
parent
328046cf4a
commit
d820f510b3
7 changed files with 1663 additions and 1258 deletions
168
i.c
168
i.c
|
|
@ -440,19 +440,42 @@ define_instrhelper(cxi_failactype) {
|
|||
{ 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) {
|
||||
int i, n = fixnum_from_obj(*ip++), c = n+1;
|
||||
|
|
@ -473,11 +496,33 @@ define_instruction(sbox) {
|
|||
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) {
|
||||
int i = fixnum_from_obj(*ip++);
|
||||
|
|
@ -723,7 +768,10 @@ define_instruction(adrop) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(pop) { ac = spop(); gonexti(); }
|
||||
define_instruction(pop) {
|
||||
ac = spop();
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(atest) {
|
||||
obj no = *ip++;
|
||||
|
|
@ -751,7 +799,7 @@ define_instruction(shrarg) {
|
|||
sdrop(c-n);
|
||||
spush(l);
|
||||
}
|
||||
/* ac = obj_from_fixnum(n+1); */
|
||||
ac = obj_from_fixnum(n+1);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
|
|
@ -760,8 +808,17 @@ define_instruction(aerr) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(shlit) { spush(ac); ac = *ip++; gonexti(); }
|
||||
define_instruction(shi0) { spush(ac); ac = obj_from_fixnum(0); gonexti(); }
|
||||
define_instruction(shlit) {
|
||||
spush(ac);
|
||||
ac = *ip++;
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(shi0) {
|
||||
spush(ac);
|
||||
ac = obj_from_fixnum(0);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
|
||||
/* type checks */
|
||||
|
|
@ -2649,11 +2706,30 @@ define_instruction(sreturn4) {
|
|||
retfromi();
|
||||
}
|
||||
|
||||
define_instruction(atest0) { if (unlikely(ac != obj_from_fixnum(0))) 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(atest0) {
|
||||
if (unlikely(ac != obj_from_fixnum(0))) 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) {
|
||||
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 char buf[60]; char *ps, *code = NULL;
|
||||
int it = pi->igtype;
|
||||
char *ps, *code = NULL; int it = pi->igtype;
|
||||
if (it >= ' ') {
|
||||
ps = pi->enc;
|
||||
ps = pi->enc; assert(ps);
|
||||
while (ps && n-- > 0) {
|
||||
ps = strchr(ps, '\t');
|
||||
if (ps) ps += 1;
|
||||
}
|
||||
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;
|
||||
}
|
||||
ps += strlen(ps) + 1; /* \0 terminates each field */
|
||||
assert(*ps);
|
||||
}
|
||||
code = ps;
|
||||
}
|
||||
return code;
|
||||
}
|
||||
|
|
@ -3371,6 +3438,19 @@ more:
|
|||
*--hp = obj_from_size(PAIR_BTAG); sref(0) = hendblk(3);
|
||||
goto more;
|
||||
} 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 */
|
||||
fixnum_t n;
|
||||
ra = sref(1); hp = rds_block(r, sp, hp);
|
||||
|
|
@ -3390,9 +3470,7 @@ more:
|
|||
case 'd': { /* dclose */
|
||||
fixnum_t n;
|
||||
ra = sref(1); hp = rds_arg(r, sp, hp);
|
||||
if (!is_fixnum_obj(ra)) {
|
||||
ra = mkeof(); goto out;
|
||||
}
|
||||
if (!is_fixnum_obj(ra)) { ra = mkeof(); goto out; }
|
||||
n = fixnum_from_obj(ra);
|
||||
ra = sref(1); hp = rds_block(r, sp, hp);
|
||||
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)
|
||||
{
|
||||
int i, n = sizeof(intgtab)/sizeof(intgtab[0]);
|
||||
char lbuf[60], *lcode;
|
||||
char lbuf[200], *lcode, *pe0, *pe1;
|
||||
if (!intgtab_sorted) sort_intgtab(n);
|
||||
for (i = 0; i < n; ++i) {
|
||||
struct intgtab_entry *pe = &intgtab[i];
|
||||
|
|
@ -3488,16 +3566,26 @@ static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
|
|||
break;
|
||||
case 1: case '1':
|
||||
lcode = lbuf; assert(pe->enc);
|
||||
sprintf(lbuf, "%%1_!%s]0", pe->enc); // "%%1.0%s]1"
|
||||
sprintf(lbuf, "%%1_!%s]0", pe->enc);
|
||||
break;
|
||||
case 2: case '2':
|
||||
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;
|
||||
case 3: case '3':
|
||||
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;
|
||||
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);
|
||||
}
|
||||
if (!lcode || *lcode == 0) continue;
|
||||
|
|
|
|||
5
i.h
5
i.h
|
|
@ -52,6 +52,7 @@ declare_instruction(sbox, "#", 1, NULL, 0, NULL)
|
|||
declare_instruction(br, NULL, 'b', NULL, 0, NULL)
|
||||
declare_instruction(brnot, "?", '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(dseti, ":!", 1, 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(jfinp, "Jf", 0, "flfinite?", '1', AUTOGL)
|
||||
declare_instruction(jinfp, "Jh", 0, "flinfinite?", '1', AUTOGL)
|
||||
declare_instruction(jadd, "J+", 0, "fl+", '2', AUTOGL)
|
||||
declare_instruction(jsub, "J-", 0, "fl-", '2', AUTOGL)
|
||||
declare_instruction(jadd, "J+\0'(j0)", 0, "fl+", 'p', AUTOGL)
|
||||
declare_instruction(jsub, "J-\0J-!", 0, "fl-", 'm', AUTOGL)
|
||||
declare_instruction(jmul, "J*", 0, "fl*", '2', AUTOGL)
|
||||
declare_instruction(jdiv, "J/", 0, "fl/", '2', AUTOGL)
|
||||
declare_instruction(jquo, "Jq", 0, "flquotient", '2', AUTOGL)
|
||||
|
|
|
|||
45
s.c
45
s.c
|
|
@ -2,30 +2,6 @@
|
|||
|
||||
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?",
|
||||
"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"
|
||||
|
|
@ -542,8 +518,8 @@ char *s_code[] = {
|
|||
"&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{%3.1p?{${${.5,@(y4:%25car)[01},.3,.6[02}?{.1]3}.2,${.4,@(y4:%25cdr)"
|
||||
"[01},.2,@(y7:%25member)[33}f]3}@!(y7:%25member)",
|
||||
|
||||
"member",
|
||||
"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{%!2.0u?{n,.3,,#0.0,.5,&2{%2.0p?{.1,${.3a,:0[01}c,.1d,:1^[22}.1A9]2}"
|
||||
".!0.0^_1[32}n,.1,.4c,,#0.0,.5,&2{%2${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{"
|
||||
".1d,:0^[21}f]2}.!0.0^_1[01}?{.1,${@(y13:%25residual-car),${.6,,#0.4,.1"
|
||||
",&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:0,@(y5:%2"
|
||||
"5appl)[02}c,@(y13:%25residual-cdr),${.4,,#0.4,.1,&2{%1.0p?{${.2d,:0^[0"
|
||||
"1},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:1^[22}.1A9]2}.!0.0^_1[32}@!(y13"
|
||||
":%25residual-map)",
|
||||
".1d,:0^[21}f]2}.!0.0^_1[01}?{.1,${@(y3:car),${.6,,#0.4,.1,&2{%1.0p?{${"
|
||||
".2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:0,@(y5:%25appl)[02}c,@"
|
||||
"(y3:cdr),${.4,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0"
|
||||
".0^_1[01}_1,:1^[22}.1A9]2}.!0.0^_1[32}@!(y13:%25residual-map)",
|
||||
|
||||
0,
|
||||
"&0{%!2.0u?{.2,,#0.3,.1,&2{%1.0p?{${.2a,:1[01}.0d,:0^[11}]1}.!0.0^_1[31"
|
||||
"}.0,.3c,,#0.3,.1,&2{%1${.2,,#0.0,&1{%1.0u,.0?{.0]2}.1ap?{.1d,:0^[21}f]"
|
||||
"2}.!0.0^_1[01}?{${@(y13:%25residual-car),${.5,,#0.4,.1,&2{%1.0p?{${.2d"
|
||||
",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:1,@(y5:%25appl)[02}@(y13:"
|
||||
"%25residual-cdr),${.3,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1"
|
||||
"}n]1}.!0.0^_1[01}_1,:0^[11}]1}.!0.0^_1[31}@!(y18:%25residual-for-each)",
|
||||
"2}.!0.0^_1[01}?{${@(y3:car),${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3"
|
||||
"a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:1,@(y5:%25appl)[02}@(y3:cdr),${.3,,#0."
|
||||
"4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,:0^[11"
|
||||
"}]1}.!0.0^_1[31}@!(y18:%25residual-for-each)",
|
||||
|
||||
0,
|
||||
"&0{%!0.0,,#0.0,&1{%1.0u?{n]1}.0du?{.0a]1}${.2d,:0^[01},.1aL6]1}.!0.0^_"
|
||||
|
|
|
|||
23
src/k.sf
23
src/k.sf
|
|
@ -1101,6 +1101,29 @@
|
|||
(codegen (car args) l f s g #f port)
|
||||
(unless (null? (cdr args)) (write-char #\, 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)]))
|
||||
(when k (write-char #\] port) (write-serialized-arg k port))]
|
||||
[call (exp . args)
|
||||
|
|
|
|||
252
src/s.scm
252
src/s.scm
|
|
@ -46,139 +46,89 @@
|
|||
;---------------------------------------------------------------------------------------------
|
||||
; 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
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
(define-inline (box? x) %residual-box? (%boxp x))
|
||||
; integrables:
|
||||
;
|
||||
; (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)
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
; 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)
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
; 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)
|
||||
|
|
@ -324,13 +274,11 @@
|
|||
; Booleans
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
; integrables:
|
||||
;
|
||||
; (boolean? x)
|
||||
; (not x)
|
||||
|
||||
(define-inline (boolean? x) %residual-boolean? (%boolp x))
|
||||
|
||||
(define-inline (not x) %residual-not (%not x))
|
||||
|
||||
|#
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Characters
|
||||
|
|
@ -382,60 +330,16 @@
|
|||
; Null and Pairs
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
||||
#|
|
||||
(define-inline (null? x) %residual-null? (%nullp x))
|
||||
|
||||
(define-inline (pair? x) %residual-pair? (%pairp x))
|
||||
|
||||
(define-inline (car x) %residual-car (%car x))
|
||||
|
||||
(define-inline (set-car! x v) %residual-set-car! (%setcar x v))
|
||||
|
||||
(define-inline (cdr x) %residual-cdr (%cdr x))
|
||||
|
||||
(define-inline (set-cdr! x v) %residual-set-cdr! (%setcdr x v))
|
||||
|#
|
||||
|
||||
(define-syntax c?r
|
||||
(syntax-rules (a d)
|
||||
[(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))
|
||||
|#
|
||||
; integrables:
|
||||
;
|
||||
; (null? x)
|
||||
; (pair? x)
|
||||
; (car x)
|
||||
; (set-car! x v)
|
||||
; (cdr x)
|
||||
; (set-cdr! x v)
|
||||
; (caar x) ... (cddddr x)
|
||||
; (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 (%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
|
||||
(syntax-rules ()
|
||||
|
|
|
|||
52
t.c
52
t.c
|
|
@ -81,28 +81,28 @@ char *t_code[] = {
|
|||
"t-req-count)",
|
||||
|
||||
0,
|
||||
"@(y15:%25residual-pair?)@!(y9:val-core?)",
|
||||
"@(y5:pair?)@!(y9:val-core?)",
|
||||
|
||||
0,
|
||||
"&0{%1.0p~]1}@!(y12:val-special?)",
|
||||
|
||||
0,
|
||||
"@(y15:%25residual-pair?)@!(y8:binding?)",
|
||||
"@(y5:pair?)@!(y8:binding?)",
|
||||
|
||||
0,
|
||||
"@(y14:%25residual-cons)@!(y12:make-binding)",
|
||||
"@(y4:cons)@!(y12:make-binding)",
|
||||
|
||||
0,
|
||||
"@(y13:%25residual-cdr)@!(y11:binding-val)",
|
||||
"@(y3:cdr)@!(y11:binding-val)",
|
||||
|
||||
0,
|
||||
"&0{%1.0d,@(y12:val-special?)[11}@!(y16:binding-special?)",
|
||||
|
||||
0,
|
||||
"@(y13:%25residual-car)@!(y11:binding-sym)",
|
||||
"@(y3:car)@!(y11:binding-sym)",
|
||||
|
||||
0,
|
||||
"@(y18:%25residual-set-cdr!)@!(y16:binding-set-val!)",
|
||||
"@(y8:set-cdr!)@!(y16:binding-set-val!)",
|
||||
|
||||
0,
|
||||
"@(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,"
|
||||
".3X0,:6^[43}.1p~?{.2,.2e,.1^[41}${.3d,:3^[01}?{.1ddg,.3L0?{.3g}{${:7^["
|
||||
"00}},.1,.1I-,.0<0?{${:7^[00}}.0,.6A6,.3,.7A8A6A8,${:4^,t,.(i10)a,:5^[0"
|
||||
"3},,#0.8,:6,&2{%1@(y13:%25residual-cdr),${n,.4,:1a,:0^[03},,#0.2,.1,&2"
|
||||
"{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[21}.!0${.(i12),.6,."
|
||||
"(i12)dd,:6^[03},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[0"
|
||||
"1}c]1}n]1}.!0.0^_1[01}_1,.5c,@(y14:%25residual-list)c,@(y13:%25residua"
|
||||
"l-map),@(y5:%25appl)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[03},.3a,.3a,:6^"
|
||||
"[43}:7^[40}.!0.0^_1[63}.!5.7,.2,.6,.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0["
|
||||
"01},@(y6:new-id)[01},.1c]1},${${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[0"
|
||||
"3},,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1"
|
||||
".!0${:2^,f,.7,:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2"
|
||||
".5,.5,,#0.8,.4,.2,.8,:0,&5{%2.0,,#0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3"
|
||||
":id?)[01}?{:3,.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${."
|
||||
"2X0,:2^[01}X1]1}.0p?{${.2d,:6^[01}?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A"
|
||||
"3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y14:%25residual-cons),@(y13:%25residu"
|
||||
"al-map)[03},:1a,:0^[12}.!1.0^,${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${"
|
||||
".3a,:1[01}c]1}n]1}.!0.0^_1[01}_1,${.6dd,:2^[01},${.3,.6^c,@(y13:%25res"
|
||||
"idual-map),@(y5:%25appl)[02}L6]5}${.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}."
|
||||
"!0.0^_1[21}.!0.0^_1[62}.!6.(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1"
|
||||
".0u?{${:3,'(s14:invalid syntax),'(y9:transform),@(y5:error)[03}}.0a,.0"
|
||||
"a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[2"
|
||||
"1}](i11)}@!(y13:syntax-rules*)",
|
||||
"3},,#0.8,:6,&2{%1@(y3:cdr),${n,.4,:1a,:0^[03},,#0.2,.1,&2{%1.0p?{${.2d"
|
||||
",:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[21}.!0${.(i12),.6,.(i12)dd,:6^[0"
|
||||
"3},${.3^,${.8,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0"
|
||||
".0^_1[01}_1,.5c,@(y14:%25residual-list)c,@(y13:%25residual-map),@(y5:%"
|
||||
"25appl)[02}L6](i11)}.2p?{${.5,.5d,.5d,:6^[03},.3a,.3a,:6^[43}:7^[40}.!"
|
||||
"0.0^_1[63}.!5.7,.2,.6,.5,&4{%3,,,#0#1#2:3,&1{%1${${.4,:0[01},@(y6:new-"
|
||||
"id)[01},.1c]1},${${.(i10),&1{%1:0,.1A3~]1},t,.(i11),:1^[03},,#0.4,.1,&"
|
||||
"2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1[01}_1.!0${:2^,f,.7"
|
||||
",:1^[03}.!1.1,:1,&2{%1:1,&1{%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,."
|
||||
"4,.2,.8,:0,&5{%2.0,,#0:0,:1,:2,.6,.4,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:3"
|
||||
",.1A3,.0?{.0}{:0,.2A3,.0?{.0}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:2^[01}X1"
|
||||
"]1}.0p?{${.2d,:6^[01}?{${.2a,:5^[01},,,#0#1:3,&1{%1:0,.1A3d]1}.!0.2,.4"
|
||||
",:4,&3{%!0${.2,:2,@(y4:cons),@(y13:%25residual-map)[03},:1a,:0^[12}.!1"
|
||||
".0^,${.5,,#0.4,.1,&2{%1.0p?{${.2d,:0^[01},${.3a,:1[01}c]1}n]1}.!0.0^_1"
|
||||
"[01}_1,${.6dd,:2^[01},${.3,.6^c,@(y13:%25residual-map),@(y5:%25appl)[0"
|
||||
"2}L6]5}${.2d,:2^[01},${.3a,:2^[01}c]1}.0]1}.!0.0^_1[21}.!0.0^_1[62}.!6"
|
||||
".(i10),.7,.7,&3{%2:2,,#0:0,.3,.5,:1,.4,&5{%1.0u?{${:3,'(s14:invalid sy"
|
||||
"ntax),'(y9:transform),@(y5:error)[03}}.0a,.0a,.1da,${:2,:3,.5,:4^[03},"
|
||||
".0?{.0,.0,.3,.5,:1^[63}.4d,:0^[51}.!0.0^_1[21}](i11)}@!(y13:syntax-rul"
|
||||
"es*)",
|
||||
|
||||
0,
|
||||
"${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n"
|
||||
|
|
|
|||
Loading…
Reference in a new issue