mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-25 21:58:54 +01:00
new integrable model switch is complete!
This commit is contained in:
parent
33d1d668a4
commit
f8c55fd3c9
6 changed files with 1602 additions and 1912 deletions
78
i.c
78
i.c
|
@ -12,7 +12,6 @@ extern obj cx_callmv_2Dadapter_2Dclosure;
|
|||
#define istagged(o, t) istagged_inlined(o, t)
|
||||
|
||||
/* forwards */
|
||||
static struct intgtab_entry *intgtab_find_encoding(int sym, int arity);
|
||||
static struct intgtab_entry *lookup_integrable(int sym);
|
||||
static int isintegrable(obj x);
|
||||
static struct intgtab_entry *integrabledata(obj x);
|
||||
|
@ -272,11 +271,7 @@ jump:
|
|||
case 4: /* find-integrable-encoding */
|
||||
/* r[0] = clo, r[1] = k, r[2] = id, r[3] = argc */
|
||||
{ assert(rc == 4);
|
||||
if (issymbol(r[2]) && is_fixnum_obj(r[3])) {
|
||||
int sym = getsymbol(r[2]), argc = fixnum_from_obj(r[3]);
|
||||
struct intgtab_entry *pe = intgtab_find_encoding(sym, argc);
|
||||
r[2] = (obj)pe;
|
||||
} else r[2] = 0;
|
||||
r[2] = obj_from_bool(0);;
|
||||
r[0] = r[1]; r[1] = obj_from_ktrap();
|
||||
pc = objptr_from_obj(r[0])[0];
|
||||
rc = 3;
|
||||
|
@ -285,10 +280,7 @@ jump:
|
|||
case 5: /* encode-integrable */
|
||||
/* r[0] = clo, r[1] = k, r[2] = argc, r[3] = pe, r[4] = port */
|
||||
{ assert(rc == 5);
|
||||
if (is_fixnum_obj(r[2]) && isaptr(r[3]) && notobjptr(r[3]) && isoport(r[4])) {
|
||||
int argc = fixnum_from_obj(r[2]);
|
||||
wrs_integrable(argc, (struct intgtab_entry *)r[3], r[4]);
|
||||
} else assert(0);
|
||||
assert(0);
|
||||
r[0] = r[1]; r[1] = obj_from_ktrap();
|
||||
pc = objptr_from_obj(r[0])[0];
|
||||
rc = 3;
|
||||
|
@ -2536,13 +2528,6 @@ define_instruction(wriw) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(fenc) {
|
||||
obj y = ac, c = spop(); cky(y); ckc(c);
|
||||
ac = (obj)intgtab_find_encoding(getsymbol(y), fixnum_from_obj(c));
|
||||
gonexti();
|
||||
}
|
||||
|
||||
|
||||
define_instruction(igp) {
|
||||
ac = obj_from_bool(isintegrable(ac));
|
||||
gonexti();
|
||||
|
@ -2577,14 +2562,6 @@ define_instruction(igco) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
|
||||
define_instruction(wrsi) {
|
||||
obj c = ac, e = spop(), p = spop(); cki(c);
|
||||
assert(isaptr(e) && notobjptr(e) && isoport(p));
|
||||
wrs_integrable(fixnum_from_obj(c), (struct intgtab_entry *)e, p);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(rdsx) {
|
||||
cks(ac); unload_ac(); /* ac->ra (string) */
|
||||
hp = rds_stox(r, sp, hp);
|
||||
|
@ -2974,24 +2951,11 @@ static void sort_intgtab(int n)
|
|||
}
|
||||
}
|
||||
|
||||
static struct intgtab_entry *intgtab_find_encoding(int sym, int arity)
|
||||
{
|
||||
struct intgtab_entry e, *pe;
|
||||
int n = sizeof(intgtab)/sizeof(intgtab[0]);
|
||||
if (!intgtab_sorted) sort_intgtab(n);
|
||||
e.sym = sym; e.igtype = arity;
|
||||
pe = bsearch(&e, &intgtab[0], n, sizeof(intgtab[0]), intgtab_cmp);
|
||||
if (!pe) { e.igtype = -1; pe = bsearch(&e, &intgtab[0], n, sizeof(intgtab[0]), intgtab_cmp); }
|
||||
return (pe && pe->igtype < ' ' && pe->enc) ? pe : NULL;
|
||||
}
|
||||
|
||||
#define INTEGRABLE_ITAG 6
|
||||
|
||||
static int isintegrable(obj o)
|
||||
{
|
||||
int n = sizeof(intgtab)/sizeof(intgtab[0]);
|
||||
if (isimm(o, INTEGRABLE_ITAG)) {
|
||||
int i = getimms(o, INTEGRABLE_ITAG);
|
||||
if (is_fixnum_obj(o)) {
|
||||
int i = fixnum_from_obj(o);
|
||||
if (i >= 0 && i < n) {
|
||||
struct intgtab_entry *pe = &intgtab[i];
|
||||
return (pe && pe->igtype >= ' ' && pe->igname && pe->enc);
|
||||
|
@ -3003,7 +2967,7 @@ static int isintegrable(obj o)
|
|||
static struct intgtab_entry *integrabledata(obj o)
|
||||
{
|
||||
int n = sizeof(intgtab)/sizeof(intgtab[0]);
|
||||
int i = getimms(o, INTEGRABLE_ITAG);
|
||||
int i = fixnum_from_obj(o);
|
||||
struct intgtab_entry *pe = &intgtab[i];
|
||||
assert(i >= 0 && i < n);
|
||||
return pe;
|
||||
|
@ -3013,7 +2977,7 @@ static obj mkintegrable(struct intgtab_entry *pe)
|
|||
{
|
||||
int n = sizeof(intgtab)/sizeof(intgtab[0]);
|
||||
assert(pe >= &intgtab[0] && pe < &intgtab[n]);
|
||||
return mkimm((pe-intgtab), INTEGRABLE_ITAG);
|
||||
return obj_from_fixnum(pe-intgtab);
|
||||
}
|
||||
|
||||
static struct intgtab_entry *lookup_integrable(int sym)
|
||||
|
@ -3051,28 +3015,6 @@ static const char *integrable_code(struct intgtab_entry *pi, int n)
|
|||
return code;
|
||||
}
|
||||
|
||||
|
||||
/* serialization machinery */
|
||||
static void wrs_int_arg(int arg, obj port)
|
||||
{
|
||||
if (0 <= arg && arg <= 9) {
|
||||
oportputc('0'+arg, port);
|
||||
} else {
|
||||
char buf[60];
|
||||
sprintf(buf, "(i%d)", arg);
|
||||
oportputs(buf, port);
|
||||
}
|
||||
}
|
||||
|
||||
static void wrs_integrable(int argc, struct intgtab_entry *pe, obj port)
|
||||
{
|
||||
assert(pe); assert(pe->enc);
|
||||
if (pe->igtype == -1 && argc > 0) oportputc(',', port);
|
||||
oportputs(pe->enc, port);
|
||||
if (pe->igtype == -1) wrs_int_arg(argc, port);
|
||||
}
|
||||
|
||||
|
||||
/* deserialization machinery */
|
||||
|
||||
static int rds_char(obj port)
|
||||
|
@ -3575,19 +3517,19 @@ static obj *rds_intgtab(obj *r, obj *sp, obj *hp)
|
|||
if (!pe->igname) continue;
|
||||
lcode = pe->lcode;
|
||||
if (!lcode) switch (pe->igtype) {
|
||||
case 0: case '0': {
|
||||
case '0': {
|
||||
lcode = lbuf; assert(pe->enc);
|
||||
sprintf(lbuf, "%%0%s]0", pe->enc);
|
||||
} break;
|
||||
case 1: case '1': {
|
||||
case '1': {
|
||||
lcode = lbuf; assert(pe->enc);
|
||||
sprintf(lbuf, "%%1_!%s]0", pe->enc);
|
||||
} break;
|
||||
case 2: case '2': {
|
||||
case '2': {
|
||||
lcode = lbuf; assert(pe->enc);
|
||||
sprintf(lbuf, "%%2_!%s]0", pe->enc);
|
||||
} break;
|
||||
case 3: case '3': {
|
||||
case '3': {
|
||||
lcode = lbuf; assert(pe->enc);
|
||||
sprintf(lbuf, "%%3_!%s]0", pe->enc);
|
||||
} break;
|
||||
|
|
924
i.h
924
i.h
|
@ -36,476 +36,462 @@
|
|||
extern obj vmcases[]; /* vm host */
|
||||
#endif
|
||||
|
||||
/* basic vm machinery */
|
||||
declare_instruction(halt, NULL, 0, NULL, 0, NULL)
|
||||
declare_instruction(litf, "f", 0, NULL, 0, NULL)
|
||||
declare_instruction(litt, "t", 0, NULL, 0, NULL)
|
||||
declare_instruction(litn, "n", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit, "'", 1, NULL, 0, NULL)
|
||||
declare_instruction(sref, ".", 1, NULL, 0, NULL)
|
||||
declare_instruction(dref, ":", 1, NULL, 0, NULL)
|
||||
declare_instruction(gref, "@", 'g', NULL, 0, NULL)
|
||||
declare_instruction(iref, "^", 0, NULL, 0, NULL)
|
||||
declare_instruction(iset, "^!", 0, NULL, 0, NULL)
|
||||
declare_instruction(dclose, "&", 'd', NULL, 0, NULL)
|
||||
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)
|
||||
declare_instruction(gset, "@!", 'g', NULL, 0, NULL)
|
||||
declare_instruction(appl, "K3", 0, NULL, 0, NULL)
|
||||
declare_instruction(cwmv, "K4", 0, NULL, 0, NULL)
|
||||
declare_instruction(rcmv, "K5", 0, NULL, 0, NULL)
|
||||
declare_instruction(sdmv, "K6", 0, NULL, 0, NULL)
|
||||
declare_instruction(lck, "k", 1, NULL, 0, NULL)
|
||||
declare_instruction(lck0, "k0", 0, NULL, 0, NULL)
|
||||
declare_instruction(rck, "k!", 0, NULL, 0, NULL)
|
||||
declare_instruction(wck, "w", 0, NULL, 0, NULL)
|
||||
declare_instruction(wckr, "w!", 0, NULL, 0, NULL)
|
||||
declare_instruction(save, "$", 's', NULL, 0, NULL)
|
||||
declare_instruction(push, ",", 0, NULL, 0, NULL)
|
||||
declare_instruction(jdceq, "|", 2, NULL, 0, NULL)
|
||||
declare_instruction(jdcge, "|!", 2, NULL, 0, NULL)
|
||||
declare_instruction(jdref, "|!0", 1, NULL, 0, NULL)
|
||||
declare_instruction(call, "[0", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall, "[", 2, NULL, 0, NULL)
|
||||
declare_instruction(return, "]0", 0, NULL, 0, NULL)
|
||||
declare_instruction(sreturn, "]", 1, NULL, 0, NULL)
|
||||
declare_instruction(adrop, "_", 1, NULL, 0, NULL)
|
||||
declare_instruction(pop, "_!", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest, "%", 1, NULL, 0, NULL)
|
||||
declare_instruction(shrarg, "%!", 1, NULL, 0, NULL)
|
||||
declare_instruction(aerr, "%%", 0, NULL, 0, NULL)
|
||||
/* basic vm machinery: generated by compiler and used in hand-coded functions */
|
||||
declare_instruction(halt, NULL, 0, NULL, 0, NULL)
|
||||
declare_instruction(litf, "f", 0, NULL, 0, NULL)
|
||||
declare_instruction(litt, "t", 0, NULL, 0, NULL)
|
||||
declare_instruction(litn, "n", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit, "'", 1, NULL, 0, NULL)
|
||||
declare_instruction(sref, ".", 1, NULL, 0, NULL)
|
||||
declare_instruction(dref, ":", 1, NULL, 0, NULL)
|
||||
declare_instruction(gref, "@", 'g', NULL, 0, NULL)
|
||||
declare_instruction(iref, "^", 0, NULL, 0, NULL)
|
||||
declare_instruction(iset, "^!", 0, NULL, 0, NULL)
|
||||
declare_instruction(dclose, "&", 'd', NULL, 0, NULL)
|
||||
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)
|
||||
declare_instruction(gset, "@!", 'g', NULL, 0, NULL)
|
||||
declare_instruction(appl, "K3", 0, NULL, 0, NULL)
|
||||
declare_instruction(cwmv, "K4", 0, NULL, 0, NULL)
|
||||
declare_instruction(rcmv, "K5", 0, NULL, 0, NULL)
|
||||
declare_instruction(sdmv, "K6", 0, NULL, 0, NULL)
|
||||
declare_instruction(lck, "k", 1, NULL, 0, NULL)
|
||||
declare_instruction(lck0, "k0", 0, NULL, 0, NULL)
|
||||
declare_instruction(rck, "k!", 0, NULL, 0, NULL)
|
||||
declare_instruction(wck, "w", 0, NULL, 0, NULL)
|
||||
declare_instruction(wckr, "w!", 0, NULL, 0, NULL)
|
||||
declare_instruction(save, "$", 's', NULL, 0, NULL)
|
||||
declare_instruction(push, ",", 0, NULL, 0, NULL)
|
||||
declare_instruction(jdceq, "|", 2, NULL, 0, NULL)
|
||||
declare_instruction(jdcge, "|!", 2, NULL, 0, NULL)
|
||||
declare_instruction(jdref, "|!0", 1, NULL, 0, NULL)
|
||||
declare_instruction(call, "[0", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall, "[", 2, NULL, 0, NULL)
|
||||
declare_instruction(return, "]0", 0, NULL, 0, NULL)
|
||||
declare_instruction(sreturn, "]", 1, NULL, 0, NULL)
|
||||
declare_instruction(adrop, "_", 1, NULL, 0, NULL)
|
||||
declare_instruction(pop, "_!", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest, "%", 1, NULL, 0, NULL)
|
||||
declare_instruction(shrarg, "%!", 1, NULL, 0, NULL)
|
||||
declare_instruction(aerr, "%%", 0, NULL, 0, NULL)
|
||||
|
||||
/* popular instruction combos */
|
||||
declare_instruction(shlit, ",'", 1, NULL, 0, NULL)
|
||||
declare_instruction(shi0, ",'0", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlitf, "f,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlitt, "t,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlitn, "n,", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit0, "'0", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit1, "'1", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit2, "'2", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit3, "'3", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit4, "'4", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit5, "'5", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit6, "'6", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit7, "'7", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit8, "'8", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit9, "'9", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit0, "'0,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit1, "'1,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit2, "'2,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit3, "'3,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit4, "'4,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit5, "'5,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit6, "'6,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit7, "'7,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit8, "'8,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit9, "'9,", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref0, ".0", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref1, ".1", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref2, ".2", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref3, ".3", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref4, ".4", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref5, ".5", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref6, ".6", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref7, ".7", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref8, ".8", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref9, ".9", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref0, ".0,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref1, ".1,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref2, ".2,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref3, ".3,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref4, ".4,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref5, ".5,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref6, ".6,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref7, ".7,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref8, ".8,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref9, ".9,", 0, NULL, 0, NULL)
|
||||
declare_instruction(srefi0, ".0^", 0, NULL, 0, NULL)
|
||||
declare_instruction(srefi1, ".1^", 0, NULL, 0, NULL)
|
||||
declare_instruction(srefi2, ".2^", 0, NULL, 0, NULL)
|
||||
declare_instruction(srefi3, ".3^", 0, NULL, 0, NULL)
|
||||
declare_instruction(srefi4, ".4^", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi0, ".0^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi1, ".1^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi2, ".2^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi3, ".3^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi4, ".4^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(dref0, ":0", 0, NULL, 0, NULL)
|
||||
declare_instruction(dref1, ":1", 0, NULL, 0, NULL)
|
||||
declare_instruction(dref2, ":2", 0, NULL, 0, NULL)
|
||||
declare_instruction(dref3, ":3", 0, NULL, 0, NULL)
|
||||
declare_instruction(dref4, ":4", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref0, ":0,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref1, ":1,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref2, ":2,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref3, ":3,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref4, ":4,", 0, NULL, 0, NULL)
|
||||
declare_instruction(drefi0, ":0^", 0, NULL, 0, NULL)
|
||||
declare_instruction(drefi1, ":1^", 0, NULL, 0, NULL)
|
||||
declare_instruction(drefi2, ":2^", 0, NULL, 0, NULL)
|
||||
declare_instruction(drefi3, ":3^", 0, NULL, 0, NULL)
|
||||
declare_instruction(drefi4, ":4^", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi0, ":0^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi1, ":1^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi2, ":2^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi3, ":3^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi4, ":4^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(call0, "[00", 0, NULL, 0, NULL)
|
||||
declare_instruction(call1, "[01", 0, NULL, 0, NULL)
|
||||
declare_instruction(call2, "[02", 0, NULL, 0, NULL)
|
||||
declare_instruction(call3, "[03", 0, NULL, 0, NULL)
|
||||
declare_instruction(call4, "[04", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall1, "[1", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall10, "[10", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall11, "[11", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall12, "[12", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall13, "[13", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall14, "[14", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall2, "[2", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall20, "[20", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall21, "[21", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall22, "[22", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall23, "[23", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall24, "[24", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall3, "[3", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall30, "[30", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall31, "[31", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall32, "[32", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall33, "[33", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall34, "[34", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall4, "[4", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall40, "[40", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall41, "[41", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall42, "[42", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall43, "[43", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall44, "[44", 0, NULL, 0, NULL)
|
||||
declare_instruction(sreturn1, "]1", 0, NULL, 0, NULL)
|
||||
declare_instruction(sreturn2, "]2", 0, NULL, 0, NULL)
|
||||
declare_instruction(sreturn3, "]3", 0, NULL, 0, NULL)
|
||||
declare_instruction(sreturn4, "]4", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest0, "%0", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest1, "%1", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest2, "%2", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest3, "%3", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest4, "%4", 0, NULL, 0, NULL)
|
||||
declare_instruction(brnotlt, "<?", 'b', NULL, 0, NULL)
|
||||
declare_instruction(pushsub, "-,", 0, NULL, 0, NULL)
|
||||
|
||||
/* popular instruction combos */
|
||||
declare_instruction(shlit, ",'", 1, NULL, 0, NULL)
|
||||
declare_instruction(shi0, ",'0", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlitf, "f,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlitt, "t,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlitn, "n,", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit0, "'0", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit1, "'1", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit2, "'2", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit3, "'3", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit4, "'4", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit5, "'5", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit6, "'6", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit7, "'7", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit8, "'8", 0, NULL, 0, NULL)
|
||||
declare_instruction(lit9, "'9", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit0, "'0,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit1, "'1,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit2, "'2,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit3, "'3,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit4, "'4,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit5, "'5,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit6, "'6,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit7, "'7,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit8, "'8,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushlit9, "'9,", 0, NULL, 0, NULL)
|
||||
|
||||
declare_instruction(sref0, ".0", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref1, ".1", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref2, ".2", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref3, ".3", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref4, ".4", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref5, ".5", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref6, ".6", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref7, ".7", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref8, ".8", 0, NULL, 0, NULL)
|
||||
declare_instruction(sref9, ".9", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref0, ".0,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref1, ".1,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref2, ".2,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref3, ".3,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref4, ".4,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref5, ".5,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref6, ".6,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref7, ".7,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref8, ".8,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsref9, ".9,", 0, NULL, 0, NULL)
|
||||
|
||||
declare_instruction(srefi0, ".0^", 0, NULL, 0, NULL)
|
||||
declare_instruction(srefi1, ".1^", 0, NULL, 0, NULL)
|
||||
declare_instruction(srefi2, ".2^", 0, NULL, 0, NULL)
|
||||
declare_instruction(srefi3, ".3^", 0, NULL, 0, NULL)
|
||||
declare_instruction(srefi4, ".4^", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi0, ".0^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi1, ".1^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi2, ".2^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi3, ".3^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushsrefi4, ".4^,", 0, NULL, 0, NULL)
|
||||
|
||||
declare_instruction(dref0, ":0", 0, NULL, 0, NULL)
|
||||
declare_instruction(dref1, ":1", 0, NULL, 0, NULL)
|
||||
declare_instruction(dref2, ":2", 0, NULL, 0, NULL)
|
||||
declare_instruction(dref3, ":3", 0, NULL, 0, NULL)
|
||||
declare_instruction(dref4, ":4", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref0, ":0,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref1, ":1,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref2, ":2,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref3, ":3,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdref4, ":4,", 0, NULL, 0, NULL)
|
||||
|
||||
declare_instruction(drefi0, ":0^", 0, NULL, 0, NULL)
|
||||
declare_instruction(drefi1, ":1^", 0, NULL, 0, NULL)
|
||||
declare_instruction(drefi2, ":2^", 0, NULL, 0, NULL)
|
||||
declare_instruction(drefi3, ":3^", 0, NULL, 0, NULL)
|
||||
declare_instruction(drefi4, ":4^", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi0, ":0^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi1, ":1^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi2, ":2^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi3, ":3^,", 0, NULL, 0, NULL)
|
||||
declare_instruction(pushdrefi4, ":4^,", 0, NULL, 0, NULL)
|
||||
|
||||
declare_instruction(call0, "[00", 0, NULL, 0, NULL)
|
||||
declare_instruction(call1, "[01", 0, NULL, 0, NULL)
|
||||
declare_instruction(call2, "[02", 0, NULL, 0, NULL)
|
||||
declare_instruction(call3, "[03", 0, NULL, 0, NULL)
|
||||
declare_instruction(call4, "[04", 0, NULL, 0, NULL)
|
||||
|
||||
declare_instruction(scall1, "[1", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall10, "[10", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall11, "[11", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall12, "[12", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall13, "[13", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall14, "[14", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall2, "[2", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall20, "[20", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall21, "[21", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall22, "[22", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall23, "[23", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall24, "[24", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall3, "[3", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall30, "[30", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall31, "[31", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall32, "[32", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall33, "[33", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall34, "[34", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall4, "[4", 1, NULL, 0, NULL)
|
||||
declare_instruction(scall40, "[40", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall41, "[41", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall42, "[42", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall43, "[43", 0, NULL, 0, NULL)
|
||||
declare_instruction(scall44, "[44", 0, NULL, 0, NULL)
|
||||
|
||||
declare_instruction(sreturn1, "]1", 0, NULL, 0, NULL)
|
||||
declare_instruction(sreturn2, "]2", 0, NULL, 0, NULL)
|
||||
declare_instruction(sreturn3, "]3", 0, NULL, 0, NULL)
|
||||
declare_instruction(sreturn4, "]4", 0, NULL, 0, NULL)
|
||||
|
||||
declare_instruction(atest0, "%0", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest1, "%1", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest2, "%2", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest3, "%3", 0, NULL, 0, NULL)
|
||||
declare_instruction(atest4, "%4", 0, NULL, 0, NULL)
|
||||
|
||||
declare_instruction(brnotlt, "<?", 'b', NULL, 0, NULL)
|
||||
declare_instruction(pushsub, "-,", 0, NULL, 0, NULL)
|
||||
|
||||
/* type checks, integra */
|
||||
declare_instruction(ckp, "%p", 0, "%ckp", '1', INLINED)
|
||||
declare_instruction(ckl, "%l", 0, "%ckl", '1', INLINED)
|
||||
declare_instruction(ckv, "%v", 0, "%ckv", '1', INLINED)
|
||||
declare_instruction(ckc, "%c", 0, "%ckc", '1', INLINED)
|
||||
declare_instruction(cks, "%s", 0, "%cks", '1', INLINED)
|
||||
declare_instruction(cki, "%i", 0, "%cki", '1', INLINED)
|
||||
declare_instruction(ckj, "%j", 0, "%ckj", '1', INLINED)
|
||||
declare_instruction(ckn, "%n", 0, "%ckn", '1', INLINED)
|
||||
declare_instruction(ckk, "%k", 0, "%ckk", '1', INLINED)
|
||||
declare_instruction(cky, "%y", 0, "%cky", '1', INLINED)
|
||||
declare_instruction(ckr, "%r", 0, "%ckr", '1', INLINED)
|
||||
declare_instruction(ckw, "%w", 0, "%ckw", '1', INLINED)
|
||||
declare_instruction(ckx, "%x", 0, "%ckx", '1', INLINED)
|
||||
declare_instruction(ckz, "%z", 0, "%ckz", '1', INLINED)
|
||||
|
||||
/* intrinsics (no arg checks), integrables and globals */
|
||||
declare_instruction(isq, "q", 0, "eq?", '2', AUTOGL)
|
||||
declare_instruction(isv, "v", 0, "eqv?", '2', AUTOGL)
|
||||
declare_instruction(ise, "e", 0, "equal?", '2', AUTOGL)
|
||||
declare_instruction(box, "b", 0, "box", '1', AUTOGL)
|
||||
declare_instruction(unbox, "z", 0, "unbox", '1', AUTOGL)
|
||||
declare_instruction(setbox, "z!", 0, "set-box!", '2', AUTOGL)
|
||||
declare_instruction(car, "a", 0, "car", '1', AUTOGL)
|
||||
declare_instruction(setcar, "a!", 0, "set-car!", '2', AUTOGL)
|
||||
declare_instruction(cdr, "d", 0, "cdr", '1', AUTOGL)
|
||||
declare_instruction(setcdr, "d!", 0, "set-cdr!", '2', AUTOGL)
|
||||
declare_instruction(caar, "aa", 0, "caar", '1', AUTOGL)
|
||||
declare_instruction(cadr, "da", 0, "cadr", '1', AUTOGL)
|
||||
declare_instruction(cdar, "ad", 0, "cdar", '1', AUTOGL)
|
||||
declare_instruction(cddr, "dd", 0, "cddr", '1', AUTOGL)
|
||||
declare_instruction(nullp, "u", 0, "null?", '1', AUTOGL)
|
||||
declare_instruction(pairp, "p", 0, "pair?", '1', AUTOGL)
|
||||
declare_instruction(cons, "c", 0, "cons", '2', AUTOGL)
|
||||
declare_instruction(not, "~", 0, "not", '1', AUTOGL)
|
||||
declare_instruction(izerop, "I=0", 0, "fxzero?", '1', AUTOGL)
|
||||
declare_instruction(iposp, "I>0", 0, "fxpositive?", '1', AUTOGL)
|
||||
declare_instruction(inegp, "I<0", 0, "fxnegative?", '1', AUTOGL)
|
||||
declare_instruction(ievnp, "Ie", 0, "fxeven?", '1', AUTOGL)
|
||||
declare_instruction(ioddp, "Io", 0, "fxodd?", '1', AUTOGL)
|
||||
declare_instruction(iadd, "I+\0'0", 0, "fx+", 'p', AUTOGL)
|
||||
declare_instruction(isub, "I-\0I-!", 0, "fx-", 'm', AUTOGL)
|
||||
declare_instruction(imul, "I*\0'1", 0, "fx*", 'p', AUTOGL)
|
||||
declare_instruction(idiv, "I/\0,'1I/", 0, "fx/", 'm', AUTOGL)
|
||||
declare_instruction(iquo, "Iq", 0, "fxquotient", '2', AUTOGL)
|
||||
declare_instruction(irem, "Ir", 0, "fxremainder", '2', AUTOGL)
|
||||
declare_instruction(ilt, "I<", 0, "fx<?", 'c', AUTOGL)
|
||||
declare_instruction(igt, "I>", 0, "fx>?", 'c', AUTOGL)
|
||||
declare_instruction(ile, "I>!", 0, "fx<=?", 'c', AUTOGL)
|
||||
declare_instruction(ige, "I<!", 0, "fx>=?", 'c', AUTOGL)
|
||||
declare_instruction(ieq, "I=", 0, "fx=?", 'c', AUTOGL)
|
||||
declare_instruction(ine, "I=!", 0, "fx!=?", '2', AUTOGL)
|
||||
declare_instruction(imin, "In", 0, "fxmin", 'x', AUTOGL)
|
||||
declare_instruction(imax, "Ix", 0, "fxmax", 'x', AUTOGL)
|
||||
declare_instruction(ineg, "I-!", 0, "fxneg", '1', AUTOGL)
|
||||
declare_instruction(iabs, "Ia", 0, "fxabs", '1', AUTOGL)
|
||||
declare_instruction(itoj, "Ij", 0, "fixnum->flonum", '1', AUTOGL)
|
||||
declare_instruction(fixp, "I0", 0, "fixnum?", '1', AUTOGL)
|
||||
declare_instruction(imqu, "I3", 0, "fxmodquo", '2', AUTOGL)
|
||||
declare_instruction(imlo, "I4", 0, "fxmodulo", '2', AUTOGL)
|
||||
declare_instruction(ieuq, "I5", 0, "fxeucquo", '2', AUTOGL)
|
||||
declare_instruction(ieur, "I6", 0, "fxeucrem", '2', AUTOGL)
|
||||
declare_instruction(igcd, "I7", 0, "fxgcd", '2', AUTOGL)
|
||||
declare_instruction(ipow, "I8", 0, "fxexpt", '2', AUTOGL)
|
||||
declare_instruction(isqrt, "I9", 0, "fxsqrt", '1', AUTOGL)
|
||||
declare_instruction(inot, "D0", 0, "fxnot", '1', AUTOGL)
|
||||
declare_instruction(iand, "D1\0'(i-1)", 0, "fxand", 'p', AUTOGL)
|
||||
declare_instruction(iior, "D2\0'0", 0, "fxior", 'p', AUTOGL)
|
||||
declare_instruction(ixor, "D3\0'0", 0, "fxxor", 'p', AUTOGL)
|
||||
declare_instruction(iasl, "D4", 0, "fxsll", '2', AUTOGL)
|
||||
declare_instruction(iasr, "D5", 0, "fxsrl", '2', AUTOGL)
|
||||
declare_instruction(jzerop, "J=0", 0, "flzero?", '1', AUTOGL)
|
||||
declare_instruction(jposp, "J>0", 0, "flpositive?", '1', AUTOGL)
|
||||
declare_instruction(jnegp, "J<0", 0, "flnegative?", '1', AUTOGL)
|
||||
declare_instruction(jevnp, "Je", 0, "fleven?", '1', AUTOGL)
|
||||
declare_instruction(joddp, "Jo", 0, "flodd?", '1', AUTOGL)
|
||||
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'(j0)", 0, "fl+", 'p', AUTOGL)
|
||||
declare_instruction(jsub, "J-\0J-!", 0, "fl-", 'm', AUTOGL)
|
||||
declare_instruction(jmul, "J*\0'(j1)", 0, "fl*", 'p', AUTOGL)
|
||||
declare_instruction(jdiv, "J/\0,'(j1)J/", 0, "fl/", 'm', AUTOGL)
|
||||
declare_instruction(jquo, "Jq", 0, "flquotient", '2', AUTOGL)
|
||||
declare_instruction(jrem, "Jr", 0, "flremainder", '2', AUTOGL)
|
||||
declare_instruction(jlt, "J<", 0, "fl<?", 'c', AUTOGL)
|
||||
declare_instruction(jgt, "J>", 0, "fl>?", 'c', AUTOGL)
|
||||
declare_instruction(jle, "J>!", 0, "fl<=?", 'c', AUTOGL)
|
||||
declare_instruction(jge, "J<!", 0, "fl>=?", 'c', AUTOGL)
|
||||
declare_instruction(jeq, "J=", 0, "fl=?", 'c', AUTOGL)
|
||||
declare_instruction(jne, "J=!", 0, "fl!=?", '2', AUTOGL)
|
||||
declare_instruction(jmin, "Jn", 0, "flmin", 'x', AUTOGL)
|
||||
declare_instruction(jmax, "Jx", 0, "flmax", 'x', AUTOGL)
|
||||
declare_instruction(jneg, "J-!", 0, "flneg", '1', AUTOGL)
|
||||
declare_instruction(jabs, "Ja", 0, "flabs", '1', AUTOGL)
|
||||
declare_instruction(jtoi, "Ji", 0, "flonum->fixnum", '1', AUTOGL)
|
||||
declare_instruction(flop, "J0", 0, "flonum?", '1', AUTOGL)
|
||||
declare_instruction(jmqu, "J3", 0, "flmodquo", '2', AUTOGL)
|
||||
declare_instruction(jmlo, "J4", 0, "flmodulo", '2', AUTOGL)
|
||||
declare_instruction(jfloor, "H0", 0, "flfloor", '1', AUTOGL)
|
||||
declare_instruction(jceil, "H1", 0, "flceiling", '1', AUTOGL)
|
||||
declare_instruction(jtrunc, "H2", 0, "fltruncate", '1', AUTOGL)
|
||||
declare_instruction(jround, "H3", 0, "flround", '1', AUTOGL)
|
||||
declare_instruction(zerop, "=0", 0, "zero?", '1', AUTOGL)
|
||||
declare_instruction(posp, ">0", 0, "positive?", '1', AUTOGL)
|
||||
declare_instruction(negp, "<0", 0, "negative?", '1', AUTOGL)
|
||||
declare_instruction(add, "+\0'0", 0, "+", 'p', AUTOGL)
|
||||
declare_instruction(sub, "-\0-!", 0, "-", 'm', AUTOGL)
|
||||
declare_instruction(mul, "*\0'1", 0, "*", 'p', AUTOGL)
|
||||
declare_instruction(div, "/\0,'1/", 0, "/", 'm', AUTOGL)
|
||||
declare_instruction(lt, "<", 0, "<", 'c', AUTOGL)
|
||||
declare_instruction(gt, ">", 0, ">", 'c', AUTOGL)
|
||||
declare_instruction(le, ">!", 0, "<=", 'c', AUTOGL)
|
||||
declare_instruction(ge, "<!", 0, ">=", 'c', AUTOGL)
|
||||
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, "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)
|
||||
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, "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, "list?", '1', AUTOGL)
|
||||
declare_instruction(list, "l", 1, "list", '#', "%!0_!]0")
|
||||
declare_instruction(lmk, "L2\0f", 0, "make-list", 'b', AUTOGL)
|
||||
declare_instruction(llen, "g", 0, "length", '1', AUTOGL)
|
||||
declare_instruction(lget, "L4", 0, "list-ref", '2', AUTOGL)
|
||||
declare_instruction(lput, "L5", 0, "list-set!", '3', AUTOGL)
|
||||
declare_instruction(lcat, "L6", 0, "list-cat", '2', AUTOGL)
|
||||
declare_instruction(memq, "A0", 0, "memq", '2', AUTOGL)
|
||||
declare_instruction(memv, "A1", 0, "memv", '2', AUTOGL)
|
||||
declare_instruction(meme, "A2", 0, "meme", '2', AUTOGL)
|
||||
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, "char?", '1', AUTOGL)
|
||||
declare_instruction(cwsp, "C1", 0, "char-whitespace?", '1', AUTOGL)
|
||||
declare_instruction(clcp, "C2", 0, "char-lower-case?", '1', AUTOGL)
|
||||
declare_instruction(cucp, "C3", 0, "char-upper-case?", '1', AUTOGL)
|
||||
declare_instruction(calp, "C4", 0, "char-alphabetic?", '1', AUTOGL)
|
||||
declare_instruction(cnup, "C5", 0, "char-numeric?", '1', AUTOGL)
|
||||
declare_instruction(cupc, "C6", 0, "char-upcase", '1', AUTOGL)
|
||||
declare_instruction(cdnc, "C7", 0, "char-downcase", '1', AUTOGL)
|
||||
declare_instruction(ceq, "C=", 0, "char=?", 'c', AUTOGL)
|
||||
declare_instruction(clt, "C<", 0, "char<?", 'c', AUTOGL)
|
||||
declare_instruction(cgt, "C>", 0, "char>?", 'c', AUTOGL)
|
||||
declare_instruction(cle, "C>!", 0, "char<=?", 'c', AUTOGL)
|
||||
declare_instruction(cge, "C<!", 0, "char>=?", 'c', AUTOGL)
|
||||
declare_instruction(cieq, "Ci=", 0, "char-ci=?", 'c', AUTOGL)
|
||||
declare_instruction(cilt, "Ci<", 0, "char-ci<?", 'c', AUTOGL)
|
||||
declare_instruction(cigt, "Ci>", 0, "char-ci>?", 'c', AUTOGL)
|
||||
declare_instruction(cile, "Ci>!", 0, "char-ci<=?", 'c', AUTOGL)
|
||||
declare_instruction(cige, "Ci<!", 0, "char-ci>=?", 'c', AUTOGL)
|
||||
|
||||
declare_instruction(strp, "S0", 0, "string?", '1', AUTOGL)
|
||||
declare_instruction(str, "S1", 1, "string", '#', "%!0.0X3]1")
|
||||
declare_instruction(smk, "S2\0'(c )", 0, "make-string", 'b', AUTOGL)
|
||||
declare_instruction(slen, "S3", 0, "string-length", '1', AUTOGL)
|
||||
declare_instruction(sget, "S4", 0, "string-ref", '2', AUTOGL)
|
||||
declare_instruction(sput, "S5", 0, "string-set!", '3', AUTOGL)
|
||||
declare_instruction(scat, "S6", 0, "string-cat", '2', AUTOGL)
|
||||
declare_instruction(ssub, "S7", 0, "substring", '3', AUTOGL)
|
||||
|
||||
declare_instruction(seq, "S=", 0, "string=?", 'c', AUTOGL)
|
||||
declare_instruction(slt, "S<", 0, "string<?", 'c', AUTOGL)
|
||||
declare_instruction(sgt, "S>", 0, "string>?", 'c', AUTOGL)
|
||||
declare_instruction(sle, "S>!", 0, "string<=?", 'c', AUTOGL)
|
||||
declare_instruction(sge, "S<!", 0, "string>=?", 'c', AUTOGL)
|
||||
declare_instruction(sieq, "Si=", 0, "string-ci=?", 'c', AUTOGL)
|
||||
declare_instruction(silt, "Si<", 0, "string-ci<?", 'c', AUTOGL)
|
||||
declare_instruction(sigt, "Si>", 0, "string-ci>?", 'c', AUTOGL)
|
||||
declare_instruction(sile, "Si>!", 0, "string-ci<=?", 'c', AUTOGL)
|
||||
declare_instruction(sige, "Si<!", 0, "string-ci>=?", 'c', AUTOGL)
|
||||
|
||||
declare_instruction(vecp, "V0", 0, "vector?", '1', AUTOGL)
|
||||
declare_instruction(vec, "V1", 1, "vector", '#', "%!0.0X1]1")
|
||||
declare_instruction(vmk, "V2\0f", 0, "make-vector", 'b', AUTOGL)
|
||||
declare_instruction(vlen, "V3", 0, "vector-length", '1', AUTOGL)
|
||||
declare_instruction(vget, "V4", 0, "vector-ref", '2', AUTOGL)
|
||||
declare_instruction(vput, "V5", 0, "vector-set!", '3', AUTOGL)
|
||||
declare_instruction(vcat, "V6", 0, "vector-cat", '2', AUTOGL)
|
||||
declare_instruction(vtol, "X0", 0, "%vector->list1", '1', AUTOGL)
|
||||
declare_instruction(ltov, "X1", 0, "list->vector", '1', AUTOGL)
|
||||
declare_instruction(stol, "X2", 0, "%string->list1", '1', AUTOGL)
|
||||
declare_instruction(ltos, "X3", 0, "list->string", '1', AUTOGL)
|
||||
declare_instruction(ytos, "X4", 0, "symbol->string", '1', AUTOGL)
|
||||
declare_instruction(stoy, "X5", 0, "string->symbol", '1', AUTOGL)
|
||||
declare_instruction(itos, "X6\0'(i10)", 0, "fixnum->string", 'b', AUTOGL)
|
||||
declare_instruction(stoi, "X7\0'(i10)", 0, "string->fixnum", 'b', AUTOGL)
|
||||
declare_instruction(ctoi, "X8", 0, "char->integer", '1', AUTOGL)
|
||||
declare_instruction(itoc, "X9", 0, "integer->char", '1', AUTOGL)
|
||||
declare_instruction(jtos, "E6", 0, "flonum->string", '1', AUTOGL)
|
||||
declare_instruction(stoj, "E7", 0, "string->flonum", '1', AUTOGL)
|
||||
declare_instruction(ntos, "E8\0'(i10)", 0, "number->string", 'b', AUTOGL)
|
||||
declare_instruction(ston, "E9\0'(i10)", 0, "string->number", 'b', AUTOGL)
|
||||
declare_instruction(ccmp, "O0", 0, "char-cmp", '2', AUTOGL)
|
||||
declare_instruction(cicmp, "O1", 0, "char-ci-cmp", '2', AUTOGL)
|
||||
declare_instruction(scmp, "O2", 0, "string-cmp", '2', AUTOGL)
|
||||
declare_instruction(sicmp, "O3", 0, "string-ci-cmp", '2', AUTOGL)
|
||||
declare_instruction(symp, "Y0", 0, "symbol?", '1', AUTOGL)
|
||||
declare_instruction(boolp, "Y1", 0, "boolean?", '1', AUTOGL)
|
||||
declare_instruction(boxp, "Y2", 0, "box?", '1', AUTOGL)
|
||||
declare_instruction(funp, "K0", 0, "procedure?", '1', AUTOGL)
|
||||
declare_instruction(ipp, "P00", 0, "input-port?", '1', AUTOGL)
|
||||
declare_instruction(opp, "P01", 0, "output-port?", '1', AUTOGL)
|
||||
declare_instruction(sip, "P10", 0, "current-input-port",'0', AUTOGL)
|
||||
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)
|
||||
declare_instruction(wrcw, "W5\0P11", 0, "write", 'b', AUTOGL)
|
||||
declare_instruction(wrnl, "W6\0P11", 0, "newline", 'u', AUTOGL)
|
||||
declare_instruction(wrhw, "W7\0P11", 0, "write-shared", 'b', AUTOGL)
|
||||
declare_instruction(wriw, "W8\0P11", 0, "write-simple", 'b', AUTOGL)
|
||||
|
||||
/* serialization and deserialization instructions */
|
||||
declare_instruction(igp, "U0", 0, "integrable?", '1', AUTOGL)
|
||||
declare_instruction(fenc, "U1", 0, "find-integrable-encoding", 2, AUTOGL)
|
||||
declare_instruction(wrsi, "U2", 0, "encode-integrable", 3, AUTOGL)
|
||||
declare_instruction(rdsx, "U3", 0, "deserialize-sexp", '1', AUTOGL)
|
||||
declare_instruction(rdsc, "U4", 0, "deserialize-code", '1', AUTOGL)
|
||||
declare_instruction(iglk, "U5", 0, "lookup-integrable", '1', AUTOGL)
|
||||
declare_instruction(igty, "U6", 0, "integrable-type", '1', AUTOGL)
|
||||
declare_instruction(iggl, "U7", 0, "integrable-global", '1', AUTOGL)
|
||||
declare_instruction(igco, "U8", 0, "integrable-code", '2', AUTOGL)
|
||||
|
||||
/* 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, "Ij", 0, "exact->inexact", '1', AUTOGL)
|
||||
declare_integrable(NULL, "Ji", 0, "inexact->exact", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aaa", 0, "caaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daa", 0, "caadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ada", 0, "cadar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dda", 0, "caddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aad", 0, "cdaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dad", 0, "cdadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "add", 0, "cddar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddd", 0, "cdddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aaaa", 0, "caaaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daaa", 0, "caaadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "adaa", 0, "caadar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddaa", 0, "caaddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aada", 0, "cadaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dada", 0, "cadadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "adda", 0, "caddar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddda", 0, "cadddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aaad", 0, "cdaaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daad", 0, "cdaadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "adad", 0, "cdadar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddad", 0, "cdaddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aadd", 0, "cddaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dadd", 0, "cddadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "addd", 0, "cdddar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dddd", 0, "cddddr", '1', AUTOGL)
|
||||
|
||||
/* non-integrable global definitions */
|
||||
declare_integrable(NULL, NULL, 0, "apply-to-list", '@', "%2_!K3")
|
||||
declare_integrable(NULL, NULL, 0, "call-with-values", '@', "%2_!K4")
|
||||
declare_integrable(NULL, NULL, 0, "values", '@', "K6")
|
||||
declare_integrable(NULL, NULL, 0, "%call/cc", '@', "%1k1,.0,.2[21")
|
||||
/* type checks: integrables but no globals */
|
||||
declare_instruction(ckp, "%p", 0, "%ckp", '1', INLINED)
|
||||
declare_instruction(ckl, "%l", 0, "%ckl", '1', INLINED)
|
||||
declare_instruction(ckv, "%v", 0, "%ckv", '1', INLINED)
|
||||
declare_instruction(ckc, "%c", 0, "%ckc", '1', INLINED)
|
||||
declare_instruction(cks, "%s", 0, "%cks", '1', INLINED)
|
||||
declare_instruction(cki, "%i", 0, "%cki", '1', INLINED)
|
||||
declare_instruction(ckj, "%j", 0, "%ckj", '1', INLINED)
|
||||
declare_instruction(ckn, "%n", 0, "%ckn", '1', INLINED)
|
||||
declare_instruction(ckk, "%k", 0, "%ckk", '1', INLINED)
|
||||
declare_instruction(cky, "%y", 0, "%cky", '1', INLINED)
|
||||
declare_instruction(ckr, "%r", 0, "%ckr", '1', INLINED)
|
||||
declare_instruction(ckw, "%w", 0, "%ckw", '1', INLINED)
|
||||
declare_instruction(ckx, "%x", 0, "%ckx", '1', INLINED)
|
||||
declare_instruction(ckz, "%z", 0, "%ckz", '1', INLINED)
|
||||
|
||||
/* built-in procedures: integrables with globals */
|
||||
declare_instruction(isq, "q", 0, "eq?", '2', AUTOGL)
|
||||
declare_instruction(isv, "v", 0, "eqv?", '2', AUTOGL)
|
||||
declare_instruction(ise, "e", 0, "equal?", '2', AUTOGL)
|
||||
declare_instruction(box, "b", 0, "box", '1', AUTOGL)
|
||||
declare_instruction(unbox, "z", 0, "unbox", '1', AUTOGL)
|
||||
declare_instruction(setbox, "z!", 0, "set-box!", '2', AUTOGL)
|
||||
declare_instruction(car, "a", 0, "car", '1', AUTOGL)
|
||||
declare_instruction(setcar, "a!", 0, "set-car!", '2', AUTOGL)
|
||||
declare_instruction(cdr, "d", 0, "cdr", '1', AUTOGL)
|
||||
declare_instruction(setcdr, "d!", 0, "set-cdr!", '2', AUTOGL)
|
||||
declare_instruction(caar, "aa", 0, "caar", '1', AUTOGL)
|
||||
declare_instruction(cadr, "da", 0, "cadr", '1', AUTOGL)
|
||||
declare_instruction(cdar, "ad", 0, "cdar", '1', AUTOGL)
|
||||
declare_instruction(cddr, "dd", 0, "cddr", '1', AUTOGL)
|
||||
declare_instruction(nullp, "u", 0, "null?", '1', AUTOGL)
|
||||
declare_instruction(pairp, "p", 0, "pair?", '1', AUTOGL)
|
||||
declare_instruction(cons, "c", 0, "cons", '2', AUTOGL)
|
||||
declare_instruction(not, "~", 0, "not", '1', AUTOGL)
|
||||
declare_instruction(izerop, "I=0", 0, "fxzero?", '1', AUTOGL)
|
||||
declare_instruction(iposp, "I>0", 0, "fxpositive?", '1', AUTOGL)
|
||||
declare_instruction(inegp, "I<0", 0, "fxnegative?", '1', AUTOGL)
|
||||
declare_instruction(ievnp, "Ie", 0, "fxeven?", '1', AUTOGL)
|
||||
declare_instruction(ioddp, "Io", 0, "fxodd?", '1', AUTOGL)
|
||||
declare_instruction(iadd, "I+\0'0", 0, "fx+", 'p', AUTOGL)
|
||||
declare_instruction(isub, "I-\0I-!", 0, "fx-", 'm', AUTOGL)
|
||||
declare_instruction(imul, "I*\0'1", 0, "fx*", 'p', AUTOGL)
|
||||
declare_instruction(idiv, "I/\0,'1I/", 0, "fx/", 'm', AUTOGL)
|
||||
declare_instruction(iquo, "Iq", 0, "fxquotient", '2', AUTOGL)
|
||||
declare_instruction(irem, "Ir", 0, "fxremainder", '2', AUTOGL)
|
||||
declare_instruction(ilt, "I<", 0, "fx<?", 'c', AUTOGL)
|
||||
declare_instruction(igt, "I>", 0, "fx>?", 'c', AUTOGL)
|
||||
declare_instruction(ile, "I>!", 0, "fx<=?", 'c', AUTOGL)
|
||||
declare_instruction(ige, "I<!", 0, "fx>=?", 'c', AUTOGL)
|
||||
declare_instruction(ieq, "I=", 0, "fx=?", 'c', AUTOGL)
|
||||
declare_instruction(ine, "I=!", 0, "fx!=?", '2', AUTOGL)
|
||||
declare_instruction(imin, "In", 0, "fxmin", 'x', AUTOGL)
|
||||
declare_instruction(imax, "Ix", 0, "fxmax", 'x', AUTOGL)
|
||||
declare_instruction(ineg, "I-!", 0, "fxneg", '1', AUTOGL)
|
||||
declare_instruction(iabs, "Ia", 0, "fxabs", '1', AUTOGL)
|
||||
declare_instruction(itoj, "Ij", 0, "fixnum->flonum", '1', AUTOGL)
|
||||
declare_instruction(fixp, "I0", 0, "fixnum?", '1', AUTOGL)
|
||||
declare_instruction(imqu, "I3", 0, "fxmodquo", '2', AUTOGL)
|
||||
declare_instruction(imlo, "I4", 0, "fxmodulo", '2', AUTOGL)
|
||||
declare_instruction(ieuq, "I5", 0, "fxeucquo", '2', AUTOGL)
|
||||
declare_instruction(ieur, "I6", 0, "fxeucrem", '2', AUTOGL)
|
||||
declare_instruction(igcd, "I7", 0, "fxgcd", '2', AUTOGL)
|
||||
declare_instruction(ipow, "I8", 0, "fxexpt", '2', AUTOGL)
|
||||
declare_instruction(isqrt, "I9", 0, "fxsqrt", '1', AUTOGL)
|
||||
declare_instruction(inot, "D0", 0, "fxnot", '1', AUTOGL)
|
||||
declare_instruction(iand, "D1\0'(i-1)", 0, "fxand", 'p', AUTOGL)
|
||||
declare_instruction(iior, "D2\0'0", 0, "fxior", 'p', AUTOGL)
|
||||
declare_instruction(ixor, "D3\0'0", 0, "fxxor", 'p', AUTOGL)
|
||||
declare_instruction(iasl, "D4", 0, "fxsll", '2', AUTOGL)
|
||||
declare_instruction(iasr, "D5", 0, "fxsrl", '2', AUTOGL)
|
||||
declare_instruction(jzerop, "J=0", 0, "flzero?", '1', AUTOGL)
|
||||
declare_instruction(jposp, "J>0", 0, "flpositive?", '1', AUTOGL)
|
||||
declare_instruction(jnegp, "J<0", 0, "flnegative?", '1', AUTOGL)
|
||||
declare_instruction(jevnp, "Je", 0, "fleven?", '1', AUTOGL)
|
||||
declare_instruction(joddp, "Jo", 0, "flodd?", '1', AUTOGL)
|
||||
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'(j0)", 0, "fl+", 'p', AUTOGL)
|
||||
declare_instruction(jsub, "J-\0J-!", 0, "fl-", 'm', AUTOGL)
|
||||
declare_instruction(jmul, "J*\0'(j1)", 0, "fl*", 'p', AUTOGL)
|
||||
declare_instruction(jdiv, "J/\0,'(j1)J/", 0, "fl/", 'm', AUTOGL)
|
||||
declare_instruction(jquo, "Jq", 0, "flquotient", '2', AUTOGL)
|
||||
declare_instruction(jrem, "Jr", 0, "flremainder", '2', AUTOGL)
|
||||
declare_instruction(jlt, "J<", 0, "fl<?", 'c', AUTOGL)
|
||||
declare_instruction(jgt, "J>", 0, "fl>?", 'c', AUTOGL)
|
||||
declare_instruction(jle, "J>!", 0, "fl<=?", 'c', AUTOGL)
|
||||
declare_instruction(jge, "J<!", 0, "fl>=?", 'c', AUTOGL)
|
||||
declare_instruction(jeq, "J=", 0, "fl=?", 'c', AUTOGL)
|
||||
declare_instruction(jne, "J=!", 0, "fl!=?", '2', AUTOGL)
|
||||
declare_instruction(jmin, "Jn", 0, "flmin", 'x', AUTOGL)
|
||||
declare_instruction(jmax, "Jx", 0, "flmax", 'x', AUTOGL)
|
||||
declare_instruction(jneg, "J-!", 0, "flneg", '1', AUTOGL)
|
||||
declare_instruction(jabs, "Ja", 0, "flabs", '1', AUTOGL)
|
||||
declare_instruction(jtoi, "Ji", 0, "flonum->fixnum", '1', AUTOGL)
|
||||
declare_instruction(flop, "J0", 0, "flonum?", '1', AUTOGL)
|
||||
declare_instruction(jmqu, "J3", 0, "flmodquo", '2', AUTOGL)
|
||||
declare_instruction(jmlo, "J4", 0, "flmodulo", '2', AUTOGL)
|
||||
declare_instruction(jfloor, "H0", 0, "flfloor", '1', AUTOGL)
|
||||
declare_instruction(jceil, "H1", 0, "flceiling", '1', AUTOGL)
|
||||
declare_instruction(jtrunc, "H2", 0, "fltruncate", '1', AUTOGL)
|
||||
declare_instruction(jround, "H3", 0, "flround", '1', AUTOGL)
|
||||
declare_instruction(zerop, "=0", 0, "zero?", '1', AUTOGL)
|
||||
declare_instruction(posp, ">0", 0, "positive?", '1', AUTOGL)
|
||||
declare_instruction(negp, "<0", 0, "negative?", '1', AUTOGL)
|
||||
declare_instruction(add, "+\0'0", 0, "+", 'p', AUTOGL)
|
||||
declare_instruction(sub, "-\0-!", 0, "-", 'm', AUTOGL)
|
||||
declare_instruction(mul, "*\0'1", 0, "*", 'p', AUTOGL)
|
||||
declare_instruction(div, "/\0,'1/", 0, "/", 'm', AUTOGL)
|
||||
declare_instruction(lt, "<", 0, "<", 'c', AUTOGL)
|
||||
declare_instruction(gt, ">", 0, ">", 'c', AUTOGL)
|
||||
declare_instruction(le, ">!", 0, "<=", 'c', AUTOGL)
|
||||
declare_instruction(ge, "<!", 0, ">=", 'c', AUTOGL)
|
||||
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, "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)
|
||||
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, "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, "list?", '1', AUTOGL)
|
||||
declare_instruction(list, "l", 1, "list", '#', "%!0_!]0")
|
||||
declare_instruction(lmk, "L2\0f", 0, "make-list", 'b', AUTOGL)
|
||||
declare_instruction(llen, "g", 0, "length", '1', AUTOGL)
|
||||
declare_instruction(lget, "L4", 0, "list-ref", '2', AUTOGL)
|
||||
declare_instruction(lput, "L5", 0, "list-set!", '3', AUTOGL)
|
||||
declare_instruction(lcat, "L6", 0, "list-cat", '2', AUTOGL)
|
||||
declare_instruction(memq, "A0", 0, "memq", '2', AUTOGL)
|
||||
declare_instruction(memv, "A1", 0, "memv", '2', AUTOGL)
|
||||
declare_instruction(meme, "A2", 0, "meme", '2', AUTOGL)
|
||||
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, "char?", '1', AUTOGL)
|
||||
declare_instruction(cwsp, "C1", 0, "char-whitespace?", '1', AUTOGL)
|
||||
declare_instruction(clcp, "C2", 0, "char-lower-case?", '1', AUTOGL)
|
||||
declare_instruction(cucp, "C3", 0, "char-upper-case?", '1', AUTOGL)
|
||||
declare_instruction(calp, "C4", 0, "char-alphabetic?", '1', AUTOGL)
|
||||
declare_instruction(cnup, "C5", 0, "char-numeric?", '1', AUTOGL)
|
||||
declare_instruction(cupc, "C6", 0, "char-upcase", '1', AUTOGL)
|
||||
declare_instruction(cdnc, "C7", 0, "char-downcase", '1', AUTOGL)
|
||||
declare_instruction(ceq, "C=", 0, "char=?", 'c', AUTOGL)
|
||||
declare_instruction(clt, "C<", 0, "char<?", 'c', AUTOGL)
|
||||
declare_instruction(cgt, "C>", 0, "char>?", 'c', AUTOGL)
|
||||
declare_instruction(cle, "C>!", 0, "char<=?", 'c', AUTOGL)
|
||||
declare_instruction(cge, "C<!", 0, "char>=?", 'c', AUTOGL)
|
||||
declare_instruction(cieq, "Ci=", 0, "char-ci=?", 'c', AUTOGL)
|
||||
declare_instruction(cilt, "Ci<", 0, "char-ci<?", 'c', AUTOGL)
|
||||
declare_instruction(cigt, "Ci>", 0, "char-ci>?", 'c', AUTOGL)
|
||||
declare_instruction(cile, "Ci>!", 0, "char-ci<=?", 'c', AUTOGL)
|
||||
declare_instruction(cige, "Ci<!", 0, "char-ci>=?", 'c', AUTOGL)
|
||||
declare_instruction(strp, "S0", 0, "string?", '1', AUTOGL)
|
||||
declare_instruction(str, "S1", 1, "string", '#', "%!0.0X3]1")
|
||||
declare_instruction(smk, "S2\0'(c )", 0, "make-string", 'b', AUTOGL)
|
||||
declare_instruction(slen, "S3", 0, "string-length", '1', AUTOGL)
|
||||
declare_instruction(sget, "S4", 0, "string-ref", '2', AUTOGL)
|
||||
declare_instruction(sput, "S5", 0, "string-set!", '3', AUTOGL)
|
||||
declare_instruction(scat, "S6", 0, "string-cat", '2', AUTOGL)
|
||||
declare_instruction(ssub, "S7", 0, "substring", '3', AUTOGL)
|
||||
declare_instruction(seq, "S=", 0, "string=?", 'c', AUTOGL)
|
||||
declare_instruction(slt, "S<", 0, "string<?", 'c', AUTOGL)
|
||||
declare_instruction(sgt, "S>", 0, "string>?", 'c', AUTOGL)
|
||||
declare_instruction(sle, "S>!", 0, "string<=?", 'c', AUTOGL)
|
||||
declare_instruction(sge, "S<!", 0, "string>=?", 'c', AUTOGL)
|
||||
declare_instruction(sieq, "Si=", 0, "string-ci=?", 'c', AUTOGL)
|
||||
declare_instruction(silt, "Si<", 0, "string-ci<?", 'c', AUTOGL)
|
||||
declare_instruction(sigt, "Si>", 0, "string-ci>?", 'c', AUTOGL)
|
||||
declare_instruction(sile, "Si>!", 0, "string-ci<=?", 'c', AUTOGL)
|
||||
declare_instruction(sige, "Si<!", 0, "string-ci>=?", 'c', AUTOGL)
|
||||
declare_instruction(vecp, "V0", 0, "vector?", '1', AUTOGL)
|
||||
declare_instruction(vec, "V1", 1, "vector", '#', "%!0.0X1]1")
|
||||
declare_instruction(vmk, "V2\0f", 0, "make-vector", 'b', AUTOGL)
|
||||
declare_instruction(vlen, "V3", 0, "vector-length", '1', AUTOGL)
|
||||
declare_instruction(vget, "V4", 0, "vector-ref", '2', AUTOGL)
|
||||
declare_instruction(vput, "V5", 0, "vector-set!", '3', AUTOGL)
|
||||
declare_instruction(vcat, "V6", 0, "vector-cat", '2', AUTOGL)
|
||||
declare_instruction(vtol, "X0", 0, "%vector->list1", '1', AUTOGL)
|
||||
declare_instruction(ltov, "X1", 0, "list->vector", '1', AUTOGL)
|
||||
declare_instruction(stol, "X2", 0, "%string->list1", '1', AUTOGL)
|
||||
declare_instruction(ltos, "X3", 0, "list->string", '1', AUTOGL)
|
||||
declare_instruction(ytos, "X4", 0, "symbol->string", '1', AUTOGL)
|
||||
declare_instruction(stoy, "X5", 0, "string->symbol", '1', AUTOGL)
|
||||
declare_instruction(itos, "X6\0'(i10)", 0, "fixnum->string", 'b', AUTOGL)
|
||||
declare_instruction(stoi, "X7\0'(i10)", 0, "string->fixnum", 'b', AUTOGL)
|
||||
declare_instruction(ctoi, "X8", 0, "char->integer", '1', AUTOGL)
|
||||
declare_instruction(itoc, "X9", 0, "integer->char", '1', AUTOGL)
|
||||
declare_instruction(jtos, "E6", 0, "flonum->string", '1', AUTOGL)
|
||||
declare_instruction(stoj, "E7", 0, "string->flonum", '1', AUTOGL)
|
||||
declare_instruction(ntos, "E8\0'(i10)", 0, "number->string", 'b', AUTOGL)
|
||||
declare_instruction(ston, "E9\0'(i10)", 0, "string->number", 'b', AUTOGL)
|
||||
declare_instruction(ccmp, "O0", 0, "char-cmp", '2', AUTOGL)
|
||||
declare_instruction(cicmp, "O1", 0, "char-ci-cmp", '2', AUTOGL)
|
||||
declare_instruction(scmp, "O2", 0, "string-cmp", '2', AUTOGL)
|
||||
declare_instruction(sicmp, "O3", 0, "string-ci-cmp", '2', AUTOGL)
|
||||
declare_instruction(symp, "Y0", 0, "symbol?", '1', AUTOGL)
|
||||
declare_instruction(boolp, "Y1", 0, "boolean?", '1', AUTOGL)
|
||||
declare_instruction(boxp, "Y2", 0, "box?", '1', AUTOGL)
|
||||
declare_instruction(funp, "K0", 0, "procedure?", '1', AUTOGL)
|
||||
declare_instruction(ipp, "P00", 0, "input-port?", '1', AUTOGL)
|
||||
declare_instruction(opp, "P01", 0, "output-port?", '1', AUTOGL)
|
||||
declare_instruction(sip, "P10", 0, "current-input-port", '0', AUTOGL)
|
||||
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)
|
||||
declare_instruction(wrcw, "W5\0P11", 0, "write", 'b', AUTOGL)
|
||||
declare_instruction(wrnl, "W6\0P11", 0, "newline", 'u', AUTOGL)
|
||||
declare_instruction(wrhw, "W7\0P11", 0, "write-shared", 'b', AUTOGL)
|
||||
declare_instruction(wriw, "W8\0P11", 0, "write-simple", 'b', AUTOGL)
|
||||
|
||||
/* serialization and deserialization instructions */
|
||||
declare_instruction(igp, "U0", 0, "integrable?", '1', AUTOGL)
|
||||
declare_instruction(rdsx, "U3", 0, "deserialize-sexp", '1', AUTOGL)
|
||||
declare_instruction(rdsc, "U4", 0, "deserialize-code", '1', AUTOGL)
|
||||
declare_instruction(iglk, "U5", 0, "lookup-integrable", '1', AUTOGL)
|
||||
declare_instruction(igty, "U6", 0, "integrable-type", '1', AUTOGL)
|
||||
declare_instruction(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, "Ij", 0, "exact->inexact", '1', AUTOGL)
|
||||
declare_integrable(NULL, "Ji", 0, "inexact->exact", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aaa", 0, "caaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daa", 0, "caadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ada", 0, "cadar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dda", 0, "caddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aad", 0, "cdaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dad", 0, "cdadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "add", 0, "cddar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddd", 0, "cdddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aaaa", 0, "caaaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daaa", 0, "caaadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "adaa", 0, "caadar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddaa", 0, "caaddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aada", 0, "cadaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dada", 0, "cadadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "adda", 0, "caddar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddda", 0, "cadddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aaad", 0, "cdaaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "daad", 0, "cdaadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "adad", 0, "cdadar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "ddad", 0, "cdaddr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "aadd", 0, "cddaar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dadd", 0, "cddadr", '1', AUTOGL)
|
||||
declare_integrable(NULL, "addd", 0, "cdddar", '1', AUTOGL)
|
||||
declare_integrable(NULL, "dddd", 0, "cddddr", '1', AUTOGL)
|
||||
|
||||
/* non-integrable global definitions */
|
||||
declare_integrable(NULL, NULL, 0, "apply-to-list", '@', "%2_!K3")
|
||||
declare_integrable(NULL, NULL, 0, "call-with-values", '@', "%2_!K4")
|
||||
declare_integrable(NULL, NULL, 0, "values", '@', "K6")
|
||||
declare_integrable(NULL, NULL, 0, "%call/cc", '@', "%1k1,.0,.2[21")
|
||||
|
||||
#undef declare_instruction
|
||||
#undef declare_instrshadow
|
||||
|
|
32
src/k.sf
32
src/k.sf
|
@ -174,7 +174,7 @@
|
|||
; <core> -> (begin <core> ...)
|
||||
; <core> -> (if <core> <core> <core>)
|
||||
; <core> -> (call <core> <core> ...)
|
||||
; <core> -> (integrable <ienc> <core> ...) where <ienc> is a pointer to ig table entry
|
||||
; <core> -> (integrable <ig> <core> ...) where <ig> is an index in the integrables table
|
||||
|
||||
; NB: (begin) is legit, returns unspecified value
|
||||
; on top level, these two extra core forms are legal:
|
||||
|
@ -925,18 +925,6 @@
|
|||
[call (exp . args)
|
||||
(set-union (find-sets exp v) (find-sets* args v))])))
|
||||
|
||||
|
||||
(define find-integrable-encoding
|
||||
(%prim "{ /* define find-integrable-encoding */
|
||||
static obj c[] = { obj_from_objptr(vmcases+4) };
|
||||
$return objptr(c); }"))
|
||||
|
||||
(define encode-integrable
|
||||
(%prim "{ /* define encode-integrable */
|
||||
static obj c[] = { obj_from_objptr(vmcases+5) };
|
||||
$return objptr(c); }"))
|
||||
|
||||
|
||||
(define codegen
|
||||
; x: Scheme Core expression to compile
|
||||
; l: local var list (with #f placeholders for nonvar slots)
|
||||
|
@ -1188,20 +1176,7 @@
|
|||
(codegen exp newl f news g #f port)
|
||||
(write-char #\_ port)
|
||||
(write-serialized-arg (length args) port))))]
|
||||
[(and (eq? (car exp) 'ref)
|
||||
(not (posq (cadr exp) l)) (not (posq (cadr exp) f))
|
||||
(find-integrable-encoding (cadr exp) (length args))) =>
|
||||
; integrable function/procedure
|
||||
(lambda (ienc)
|
||||
; regular convention is 1st arg in a, others on stack
|
||||
(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)))
|
||||
(encode-integrable (length args) ienc port)
|
||||
(when k (write-char #\] port) (write-serialized-arg k port)))]
|
||||
[k
|
||||
; tail call with k elements under arguments
|
||||
[k ; tail call with k elements under arguments
|
||||
(do ([args (reverse args) (cdr args)] [l l (cons #f l)])
|
||||
[(null? args) (codegen exp l f s g #f port)]
|
||||
(codegen (car args) l f s g #f port)
|
||||
|
@ -1209,8 +1184,7 @@
|
|||
(write-char #\[ port)
|
||||
(write-serialized-arg k port)
|
||||
(write-serialized-arg (length args) port)]
|
||||
[else
|
||||
; non-tail call; 'save' puts 2 extra elements on the stack!
|
||||
[else ; non-tail call; 'save' puts 2 extra elements on the stack!
|
||||
(write-char #\$ port) (write-char #\{ port)
|
||||
(do ([args (reverse args) (cdr args)] [l (cons #f (cons #f l)) (cons #f l)])
|
||||
[(null? args) (codegen exp l f s g #f port)]
|
||||
|
|
127
src/t.scm
127
src/t.scm
|
@ -115,6 +115,9 @@
|
|||
(if (null? rest) x
|
||||
(cons x (loop (car rest) (cdr rest))))))
|
||||
|
||||
(define (andmap p l)
|
||||
(if (pair? l) (and (p (car l)) (andmap p (cdr l))) #t))
|
||||
|
||||
(define (list1? x) (and (pair? x) (null? (cdr x))))
|
||||
(define (list1+? x) (and (pair? x) (list? (cdr x))))
|
||||
(define (list2? x) (and (pair? x) (list1? (cdr x))))
|
||||
|
@ -128,6 +131,7 @@
|
|||
; <core> -> (quote <object>)
|
||||
; <core> -> (ref <id>)
|
||||
; <core> -> (set! <id> <core>)
|
||||
; <core> -> (set& <id>)
|
||||
; <core> -> (lambda <ids> <core>) where <ids> -> (<id> ...) | (<id> ... . <id>) | <id>
|
||||
; <core> -> (lambda* (<arity> <core>) ...) where <arity> -> (<cnt> <rest?>)
|
||||
; <core> -> (letcc <id> <core>)
|
||||
|
@ -135,6 +139,7 @@
|
|||
; <core> -> (begin <core> ...)
|
||||
; <core> -> (if <core> <core> <core>)
|
||||
; <core> -> (call <core> <core> ...)
|
||||
; <core> -> (integrable <ig> <core> ...) where <ig> is an index in the integrables table
|
||||
|
||||
; NB: (begin) is legit, returns unspecified value
|
||||
; on top level, these two extra core forms are legal:
|
||||
|
@ -142,6 +147,12 @@
|
|||
; <core> -> (define <id> <core>)
|
||||
; <core> -> (define-syntax <id> <transformer>)
|
||||
|
||||
(define idslist?
|
||||
(lambda (x)
|
||||
(cond [(null? x) #t]
|
||||
[(pair? x) (and (id? (car x)) (idslist? (cdr x)))]
|
||||
[else (id? x)])))
|
||||
|
||||
(define normalize-arity
|
||||
(lambda (arity)
|
||||
(if (and (list2? arity) (fixnum? (car arity)) (boolean? (cadr arity)))
|
||||
|
@ -220,27 +231,35 @@
|
|||
(define (xform appos? sexp env)
|
||||
(cond [(id? sexp)
|
||||
(let ([hval (xform-ref sexp env)])
|
||||
(if (and (procedure? hval) (not appos?))
|
||||
(xform appos? (hval sexp env) env) ; id-syntax
|
||||
hval))]
|
||||
[(not (pair? sexp)) (xform-quote sexp env)]
|
||||
[else (let* ([head (car sexp)] [tail (cdr sexp)] [hval (xform #t head env)])
|
||||
(case hval
|
||||
[(syntax) (car tail)]
|
||||
[(quote) (xform-quote (car tail) env)]
|
||||
[(set!) (xform-set! (car tail) (cadr tail) env)]
|
||||
[(begin) (xform-begin tail env)]
|
||||
[(if) (xform-if tail env)]
|
||||
[(lambda) (xform-lambda tail env)]
|
||||
[(lambda*) (xform-lambda* tail env)]
|
||||
[(letcc) (xform-letcc tail env)]
|
||||
[(withcc) (xform-withcc tail env)]
|
||||
[(body) (xform-body tail env)]
|
||||
[(define) (xform-define (car tail) (cadr tail) env)]
|
||||
[(define-syntax) (xform-define-syntax (car tail) (cadr tail) env)]
|
||||
[else (if (procedure? hval)
|
||||
(xform appos? (hval sexp env) env)
|
||||
(xform-call hval tail env))]))]))
|
||||
(cond [appos? hval]
|
||||
[(integrable? hval) ; integrable id-syntax
|
||||
(list 'ref (integrable-global hval))]
|
||||
[(procedure? hval) ; id-syntax
|
||||
(xform appos? (hval sexp env) env)]
|
||||
[else hval]))]
|
||||
[(not (pair? sexp))
|
||||
(xform-quote sexp env)]
|
||||
[else
|
||||
(let* ([head (car sexp)] [tail (cdr sexp)] [hval (xform #t head env)])
|
||||
(case hval
|
||||
[(syntax) (car tail)] ; internal use only
|
||||
[(quote) (xform-quote (car tail) env)]
|
||||
[(set!) (xform-set! (car tail) (cadr tail) env)]
|
||||
[(set&) (xform-set& tail env)]
|
||||
[(begin) (xform-begin tail env)]
|
||||
[(if) (xform-if tail env)]
|
||||
[(lambda) (xform-lambda tail env)]
|
||||
[(lambda*) (xform-lambda* tail env)]
|
||||
[(letcc) (xform-letcc tail env)]
|
||||
[(withcc) (xform-withcc tail env)]
|
||||
[(body) (xform-body tail env)]
|
||||
[(define) (xform-define (car tail) (cadr tail) env)]
|
||||
[(define-syntax) (xform-define-syntax (car tail) (cadr tail) env)]
|
||||
[else (if (integrable? hval)
|
||||
(xform-integrable hval tail env)
|
||||
(if (procedure? hval)
|
||||
(xform appos? (hval sexp env) env)
|
||||
(xform-call hval tail env)))]))]))
|
||||
|
||||
(define (xform-quote sexp env)
|
||||
(list 'quote
|
||||
|
@ -264,6 +283,17 @@
|
|||
(list 'set! (cadr val) xexp)
|
||||
(error 'transform "set! to non-identifier form")))])))
|
||||
|
||||
(define (xform-set& tail env)
|
||||
(if (list1? tail)
|
||||
(let ([den (env (car tail))])
|
||||
(cond [(symbol? den) (list 'set& den)]
|
||||
[(binding-special? den) (error 'transform "set& of a non-variable")]
|
||||
[else (let ([val (binding-val den)])
|
||||
(if (eq? (car val) 'ref)
|
||||
(list 'set& (cadr val))
|
||||
(error 'transform "set& of a non-variable")))]))
|
||||
(error 'transform "improper set& form")))
|
||||
|
||||
(define (xform-begin tail env)
|
||||
(if (list? tail)
|
||||
(let ([xexps (map (lambda (sexp) (xform #f sexp env)) tail)])
|
||||
|
@ -289,8 +319,21 @@
|
|||
(pair* 'call xexp xexps)))
|
||||
(error 'transform "improper application")))
|
||||
|
||||
(define (integrable-argc-match? igt n)
|
||||
(case igt
|
||||
[(#\0) (= n 0)] [(#\1) (= n 1)] [(#\2) (= n 2)] [(#\3) (= n 3)]
|
||||
[(#\p) (>= n 0)] [(#\m) (>= n 1)] [(#\c) (>= n 2)] [(#\x) (>= n 1)]
|
||||
[(#\u) (<= 0 n 1)] [(#\b) (<= 1 n 2)]
|
||||
[(#\#) (>= n 0)] [(#\@) #f]
|
||||
[else #f]))
|
||||
|
||||
(define (xform-integrable ig tail env)
|
||||
(if (integrable-argc-match? (integrable-type ig) (length tail))
|
||||
(cons 'integrable (cons ig (map (lambda (sexp) (xform #f sexp env)) tail)))
|
||||
(xform-call (list 'ref (integrable-global ig)) tail env)))
|
||||
|
||||
(define (xform-lambda tail env)
|
||||
(if (list? tail)
|
||||
(if (and (list1+? tail) (idslist? (car tail)))
|
||||
(let loop ([vars (car tail)] [ienv env] [ipars '()])
|
||||
(cond [(pair? vars)
|
||||
(let* ([var (car vars)] [nvar (gensym (id->sym var))])
|
||||
|
@ -298,17 +341,19 @@
|
|||
[(null? vars)
|
||||
(list 'lambda (reverse ipars) (xform-body (cdr tail) ienv))]
|
||||
[else ; improper
|
||||
(let* ([var vars] [nvar (gensym (id->sym var))]
|
||||
(let* ([var vars] [nvar (gensym (id->sym var))]
|
||||
[ienv (add-var var nvar ienv)])
|
||||
(list 'lambda (append (reverse ipars) nvar)
|
||||
(xform-body (cdr tail) ienv)))]))
|
||||
(error 'transform "improper lambda body")))
|
||||
(error 'transform "improper lambda body" tail)))
|
||||
|
||||
(define (xform-lambda* tail env)
|
||||
(if (list? tail)
|
||||
(cons 'lambda*
|
||||
(map (lambda (aexp)
|
||||
(if (list2? aexp)
|
||||
(if (and (list2? aexp)
|
||||
(or (and (list2? (car aexp)) (fixnum? (caar aexp)) (boolean? (cadar aexp)))
|
||||
(idslist? (car aexp))))
|
||||
(list (normalize-arity (car aexp))
|
||||
(xform #f (cadr aexp) env))
|
||||
(error 'transform "improper lambda* clause")))
|
||||
|
@ -395,6 +440,7 @@
|
|||
(make-binding 'define-syntax 'define-syntax)
|
||||
(make-binding 'quote 'quote)
|
||||
(make-binding 'set! 'set!)
|
||||
(make-binding 'set& 'set&)
|
||||
(make-binding 'lambda 'lambda)
|
||||
(make-binding 'lambda* 'lambda*)
|
||||
(make-binding 'letcc 'letcc)
|
||||
|
@ -413,7 +459,7 @@
|
|||
(binding-set-val! bnd (transform #t val))))
|
||||
bnd]
|
||||
[(symbol? id)
|
||||
(let ([bnd (make-binding id (list 'ref id))])
|
||||
(let ([bnd (make-binding id (or (lookup-integrable id) (list 'ref id)))])
|
||||
(set! *transformers* (cons bnd *transformers*))
|
||||
bnd)]
|
||||
[else (old-den id)])))
|
||||
|
@ -520,19 +566,23 @@
|
|||
(assq tmpl new-literals)))]
|
||||
[(vector? tmpl)
|
||||
(list->vector (expand-part (vector->list tmpl)))]
|
||||
[(pair? tmpl)
|
||||
(if (ellipsis-pair? (cdr tmpl))
|
||||
(let ([vars-to-iterate (list-ellipsis-vars (car tmpl))])
|
||||
(define (lookup var)
|
||||
(cdr (assq var bindings)))
|
||||
(define (expand-using-vals . vals)
|
||||
(expand (car tmpl)
|
||||
(map cons vars-to-iterate vals)))
|
||||
[(and (pair? tmpl) (ellipsis-pair? (cdr tmpl)))
|
||||
(let ([vars-to-iterate (list-ellipsis-vars (car tmpl))])
|
||||
(define (lookup var)
|
||||
(cdr (assq var bindings)))
|
||||
(define (expand-using-vals . vals)
|
||||
(expand (car tmpl)
|
||||
(map cons vars-to-iterate vals)))
|
||||
(if (null? vars-to-iterate)
|
||||
; ellipsis following non-repeatable part is an error, but we don't care
|
||||
(cons (expand-part (car tmpl)) (expand-part (cddr tmpl))) ; repeat once
|
||||
; correct use of ellipsis
|
||||
(let ([val-lists (map lookup vars-to-iterate)])
|
||||
(append
|
||||
(apply map (cons expand-using-vals val-lists))
|
||||
(expand-part (cddr tmpl)))))
|
||||
(cons (expand-part (car tmpl)) (expand-part (cdr tmpl))))]
|
||||
(expand-part (cddr tmpl))))))]
|
||||
[(pair? tmpl)
|
||||
(cons (expand-part (car tmpl)) (expand-part (cdr tmpl)))]
|
||||
[else tmpl]))))
|
||||
|
||||
(lambda (use use-env)
|
||||
|
@ -654,11 +704,6 @@
|
|||
[(_ #(x ...) . d) (list->vector (quasiquote (x ...) . d))]
|
||||
[(_ x . d) 'x]))
|
||||
|
||||
(install-sr-transformer! 'delay
|
||||
(syntax-rules ()
|
||||
[(_ exp)
|
||||
(make-delayed (lambda () exp))]))
|
||||
|
||||
(install-sr-transformer! 'when
|
||||
(syntax-rules ()
|
||||
[(_ test . rest) (if test (begin . rest))]))
|
||||
|
|
122
t.c
122
t.c
|
@ -55,6 +55,9 @@ char *t_code[] = {
|
|||
"&0{%!1.0,.2,,#0.0,&1{%2.1u?{.0]2}${.3d,.4a,:0^[02},.1c]2}.!0.0^_1[22}@"
|
||||
"!(y5:pair*)",
|
||||
|
||||
0,
|
||||
"&0{%2.1p?{${.3a,.3[01}?{.1d,.1,@(y6:andmap)[22}f]2}t]2}@!(y6:andmap)",
|
||||
|
||||
0,
|
||||
"&0{%1.0p?{.0du]1}f]1}@!(y6:list1?)",
|
||||
|
||||
|
@ -67,6 +70,10 @@ char *t_code[] = {
|
|||
0,
|
||||
"&0{%1.0p?{.0d,@(y7:list1+?)[11}f]1}@!(y7:list2+?)",
|
||||
|
||||
0,
|
||||
"&0{%1.0u?{t]1}.0p?{${.2a,@(y3:id?)[01}?{.0d,@(y8:idslist?)[11}f]1}.0,@"
|
||||
"(y3:id?)[11}@!(y8:idslist?)",
|
||||
|
||||
0,
|
||||
"&0{%1${.2,@(y6:list2?)[01}?{.0aI0?{.0daY1}{f}}{f}?{.0]1}.0,'0,,#0.0,&1"
|
||||
"{%2.1p?{.1d,.1,'1I+,:0^[22}.1u?{f,.1,l2]2}t,.1,l2]2}.!0.0^_1[12}@!(y15"
|
||||
|
@ -138,19 +145,21 @@ char *t_code[] = {
|
|||
".1,.4,@(y11:extend-xenv)[33}@!(y7:add-var)",
|
||||
|
||||
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;),.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{%3${.3,@(y3:id?)[01}?{${.4,.4,@(y9:xform-ref)[02},.1?{.0]4}.0U0?{.0"
|
||||
"U7,'(y3:ref),l2]4}.0K0?{.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;),.1A1?{.2a]7}'(l1:y5:quote;),.1A1?{.6,.3a,@(y11:xform-quot"
|
||||
"e)[72}'(l1:y4:set!;),.1A1?{.6,.3da,.4a,@(y10:xform-set!)[73}'(l1:y4:se"
|
||||
"t&;),.1A1?{.6,.3,@(y10:xform-set&)[72}'(l1:y5:begin;),.1A1?{.6,.3,@(y1"
|
||||
"1:xform-begin)[72}'(l1:y2:if;),.1A1?{.6,.3,@(y8:xform-if)[72}'(l1:y6:l"
|
||||
"ambda;),.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-let"
|
||||
"cc)[72}'(l1:y6:withcc;),.1A1?{.6,.3,@(y12:xform-withcc)[72}'(l1:y4:bod"
|
||||
"y;),.1A1?{.6,.3,@(y10:xform-body)[72}'(l1:y6:define;),.1A1?{.6,.3da,.4"
|
||||
"a,@(y12:xform-define)[73}'(l1:y13:define-syntax;),.1A1?{.6,.3da,.4a,@("
|
||||
"y19:xform-define-syntax)[73}t?{.1U0?{.6,.3,.3,@(y16:xform-integrable)["
|
||||
"73}.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"
|
||||
|
@ -168,6 +177,14 @@ char *t_code[] = {
|
|||
"'(y4:set!),l3]6}'(s27:set! to non-identifier form),'(y9:transform),@(y"
|
||||
"5:error)[62}@!(y10:xform-set!)",
|
||||
|
||||
0,
|
||||
"&0{%2${.2,@(y6:list1?)[01}?{${.2a,.4[01},.0Y0?{.0,'(y4:set&),l2]3}${.2"
|
||||
",@(y16:binding-special?)[01}?{'(s22:set& of a non-variable),'(y9:trans"
|
||||
"form),@(y5:error)[32}${.2,@(y11:binding-val)[01},'(y3:ref),.1aq?{.0da,"
|
||||
"'(y4:set&),l2]4}'(s22:set& of a non-variable),'(y9:transform),@(y5:err"
|
||||
"or)[42}'(s18:improper set& form),'(y9:transform),@(y5:error)[22}@!(y10"
|
||||
":xform-set&)",
|
||||
|
||||
0,
|
||||
"&0{%2.0L0?{${.2,.4,&1{%1:0,.1,f,@(y5:xform)[13},@(y5:%25map1)[02},.0p?"
|
||||
"{.0du}{f}?{.0a]3}.0,'(y5:begin)c]3}'(s19:improper begin form),'(y9:tra"
|
||||
|
@ -187,19 +204,34 @@ char *t_code[] = {
|
|||
":xform-call)",
|
||||
|
||||
0,
|
||||
"&0{%2.0L0?{n,.2,.2a,,#0.4,.1,&2{%3.0p?{.0a,${${.4,@(y7:id->sym)[01},@("
|
||||
"y6:gensym)[01},.4,.1c,${.6,.4,.6,@(y7:add-var)[03},.4d,:0^[53}.0u?{${."
|
||||
"3,:1d,@(y10:xform-body)[02},.3A8,'(y6:lambda),l3]3}.0,${${.4,@(y7:id->"
|
||||
"sym)[01},@(y6:gensym)[01},${.5,.3,.5,@(y7:add-var)[03},${.2,:1d,@(y10:"
|
||||
"xform-body)[02},.2,.7A8L6,'(y6:lambda),l3]6}.!0.0^_1[23}'(s20:improper"
|
||||
" lambda body),'(y9:transform),@(y5:error)[22}@!(y12:xform-lambda)",
|
||||
"&0{%2.0,'(l1:c0;),.1A1?{'0,.3=]3}'(l1:c1;),.1A1?{'1,.3=]3}'(l1:c2;),.1"
|
||||
"A1?{'2,.3=]3}'(l1:c3;),.1A1?{'3,.3=]3}'(l1:cp;),.1A1?{'0,.3<!]3}'(l1:c"
|
||||
"m;),.1A1?{'1,.3<!]3}'(l1:cc;),.1A1?{'2,.3<!]3}'(l1:cx;),.1A1?{'1,.3<!]"
|
||||
"3}'(l1:cu;),.1A1?{'1,.3,,'0>!;>!]3}'(l1:cb;),.1A1?{'2,.3,,'1>!;>!]3}'("
|
||||
"l1:c#;),.1A1?{'0,.3<!]3}'(l1:c@;),.1A1?{f]3}t?{f]3}f]3}@!(y22:integrab"
|
||||
"le-argc-match?)",
|
||||
|
||||
0,
|
||||
"&0{%2.0L0?{${.2,.4,&1{%1${.2,@(y6:list2?)[01}?{${:0,.3da,f,@(y5:xform)"
|
||||
"[03},${.3a,@(y15:normalize-arity)[01},l2]1}'(s23:improper lambda* clau"
|
||||
"se),'(y9:transform),@(y5:error)[12},@(y5:%25map1)[02},'(y7:lambda*)c]2"
|
||||
"}'(s21:improper lambda* form),'(y9:transform),@(y5:error)[22}@!(y13:xf"
|
||||
"orm-lambda*)",
|
||||
"&0{%3${.3g,.3U6,@(y22:integrable-argc-match?)[02}?{${.3,.5,&1{%1:0,.1,"
|
||||
"f,@(y5:xform)[13},@(y5:%25map1)[02},.1c,'(y10:integrable)c]3}.2,.2,.2U"
|
||||
"7,'(y3:ref),l2,@(y10:xform-call)[33}@!(y16:xform-integrable)",
|
||||
|
||||
0,
|
||||
"&0{%2${.2,@(y7:list1+?)[01}?{${.2a,@(y8:idslist?)[01}}{f}?{n,.2,.2a,,#"
|
||||
"0.4,.1,&2{%3.0p?{.0a,${${.4,@(y7:id->sym)[01},@(y6:gensym)[01},.4,.1c,"
|
||||
"${.6,.4,.6,@(y7:add-var)[03},.4d,:0^[53}.0u?{${.3,:1d,@(y10:xform-body"
|
||||
")[02},.3A8,'(y6:lambda),l3]3}.0,${${.4,@(y7:id->sym)[01},@(y6:gensym)["
|
||||
"01},${.5,.3,.5,@(y7:add-var)[03},${.2,:1d,@(y10:xform-body)[02},.2,.7A"
|
||||
"8L6,'(y6:lambda),l3]6}.!0.0^_1[23}.0,'(s20:improper lambda body),'(y9:"
|
||||
"transform),@(y5:error)[23}@!(y12:xform-lambda)",
|
||||
|
||||
0,
|
||||
"&0{%2.0L0?{${.2,.4,&1{%1${.2,@(y6:list2?)[01}?{${.2a,@(y6:list2?)[01}?"
|
||||
"{.0aaI0?{.0adaY1}{f}}{f},.0?{.0}{${.3a,@(y8:idslist?)[01}}_1}{f}?{${:0"
|
||||
",.3da,f,@(y5:xform)[03},${.3a,@(y15:normalize-arity)[01},l2]1}'(s23:im"
|
||||
"proper lambda* clause),'(y9:transform),@(y5:error)[12},@(y5:%25map1)[0"
|
||||
"2},'(y7:lambda*)c]2}'(s21:improper lambda* form),'(y9:transform),@(y5:"
|
||||
"error)[22}@!(y13:xform-lambda*)",
|
||||
|
||||
0,
|
||||
"&0{%2${.2,@(y7:list2+?)[01}?{${.2a,@(y3:id?)[01}}{f}?{.0a,${${.4,@(y7:"
|
||||
|
@ -253,19 +285,20 @@ char *t_code[] = {
|
|||
"in),'(y5:begin),@(y12:make-binding)[02},${'(y6:withcc),'(y6:withcc),@("
|
||||
"y12:make-binding)[02},${'(y5:letcc),'(y5:letcc),@(y12:make-binding)[02"
|
||||
"},${'(y7:lambda*),'(y7:lambda*),@(y12:make-binding)[02},${'(y6:lambda)"
|
||||
",'(y6:lambda),@(y12:make-binding)[02},${'(y4:set!),'(y4:set!),@(y12:ma"
|
||||
"ke-binding)[02},${'(y5:quote),'(y5:quote),@(y12:make-binding)[02},${'("
|
||||
"y13:define-syntax),'(y13:define-syntax),@(y12:make-binding)[02},${'(y6"
|
||||
":define),'(y6:define),@(y12:make-binding)[02},${'(y6:syntax),'(y6:synt"
|
||||
"ax),@(y12:make-binding)[02},l(i13)@!(y14:*transformers*)",
|
||||
",'(y6:lambda),@(y12:make-binding)[02},${'(y4:set&),'(y4:set&),@(y12:ma"
|
||||
"ke-binding)[02},${'(y4:set!),'(y4:set!),@(y12:make-binding)[02},${'(y5"
|
||||
":quote),'(y5:quote),@(y12:make-binding)[02},${'(y13:define-syntax),'(y"
|
||||
"13:define-syntax),@(y12:make-binding)[02},${'(y6:define),'(y6:define),"
|
||||
"@(y12:make-binding)[02},${'(y6:syntax),'(y6:syntax),@(y12:make-binding"
|
||||
")[02},l(i14)@!(y14:*transformers*)",
|
||||
|
||||
0,
|
||||
"&0{%1${@(y14:*transformers*),.3,@(y16:find-top-binding)[02},${.2,@(y8:"
|
||||
"binding?)[01}?{${.2,@(y11:binding-val)[01},.0p?{'(y12:syntax-rules),.1"
|
||||
"aq}{f}?{${${.4,t,@(y9:transform)[02},.4,@(y16:binding-set-val!)[02}}_1"
|
||||
".0]2}.1Y0?{${.3,'(y3:ref),l2,.4,@(y12:make-binding)[02},@(y14:*transfo"
|
||||
"rmers*),.1c@!(y14:*transformers*).0]3}.1,@(y7:old-den)[21}@!(y19:top-t"
|
||||
"ransformer-env)",
|
||||
".0]2}.1Y0?{${.3U5,.0?{.0}{.4,'(y3:ref),l2}_1,.4,@(y12:make-binding)[02"
|
||||
"},@(y14:*transformers*),.1c@!(y14:*transformers*).0]3}.1,@(y7:old-den)"
|
||||
"[21}@!(y19:top-transformer-env)",
|
||||
|
||||
0,
|
||||
"&0{%2.1,${.3,@(y19:top-transformer-env)[01},@(y16:binding-set-val!)[22"
|
||||
|
@ -298,16 +331,17 @@ char *t_code[] = {
|
|||
"},.3a,.3a,:6^[43}:7^[40}.!0.0^_1[63}.!5.7,.2,.6,.5,&4{%3,,,#0#1#2${${."
|
||||
"9,&1{%1:0,.1A3~]1},t,.(i10),:1^[03},:3,&1{%1${${.4,:0[01},@(y6:new-id)"
|
||||
"[01},.1c]1},@(y5:%25map1)[02}.!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)"
|
||||
",@(y5:%25map2)[03},:1a,:0^[12}.!1${.4,.3^,@(y5:%25map1)[02},${.6dd,:2^"
|
||||
"[01},${.3,.6^c,@(y4:%25map),@(y13:apply-to-list)[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,.0a,.1da,${:2,:3,.5,:4^[03},.0?{.0,.0,.3,.5,:1^["
|
||||
"63}.4d,:0^[51}.!0.0^_1[21}](i11)}@!(y13:syntax-rules*)",
|
||||
"%1:0^,.1A0]1},t,.2,:0^[13}.!2.5,.5,,#0.8,.4,:0,.8,.4,&5{%2.0,,#0.0,.4,"
|
||||
":0,:1,:2,:3,:4,&7{%1${.2,@(y3:id?)[01}?{:5,.1A3,.0?{.0}{:0,.2A3,.0?{.0"
|
||||
"}{:1^,.3A3}_1}_1d]1}.0V0?{${.2X0,:6^[01}X1]1}.0p?{${.2d,:2^[01}}{f}?{$"
|
||||
"{.2a,:3^[01},,,#0#1:5,&1{%1:0,.1A3d]1}.!0.2,.4,:4,&3{%!0${.2,:2,@(y4:c"
|
||||
"ons),@(y5:%25map2)[03},:1a,:0^[12}.!1.2u?{${.5dd,:6^[01},${.6a,:6^[01}"
|
||||
"c]4}${.4,.3^,@(y5:%25map1)[02},${.6dd,:6^[01},${.3,.6^c,@(y4:%25map),@"
|
||||
"(y13:apply-to-list)[02}L6]5}.0p?{${.2d,:6^[01},${.3a,:6^[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*)",
|
||||
|
||||
0,
|
||||
"${&0{%2,#0${${'(y6:syntax),'(y6:syntax),@(y12:make-binding)[02},@(y6:n"
|
||||
|
@ -409,10 +443,6 @@ char *t_code[] = {
|
|||
"d;;;l2:y5:quote;y1:x;;;),'(l3:y7:unquote;y16:unquote-splicing;y10:quas"
|
||||
"iquote;),f,'(y10:quasiquote),@(y26:install-transformer-rules!)[04}",
|
||||
|
||||
0,
|
||||
"${'(l1:l2:l2:y1:_;y3:exp;;l2:y12:make-delayed;l3:y6:lambda;n;y3:exp;;;"
|
||||
";),n,f,'(y5:delay),@(y26:install-transformer-rules!)[04}",
|
||||
|
||||
0,
|
||||
"${'(l1:l2:py1:_;py4:test;y4:rest;;;l3:y2:if;y4:test;py5:begin;y4:rest;"
|
||||
";;;),n,f,'(y4:when),@(y26:install-transformer-rules!)[04}",
|
||||
|
|
Loading…
Reference in a new issue