mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-26 21:58:51 +01:00
new integrable model switch is complete!
This commit is contained in:
ESL
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;
|
||||
|
|
|
|||
30
i.h
30
i.h
|
|
@ -36,7 +36,7 @@
|
|||
extern obj vmcases[]; /* vm host */
|
||||
#endif
|
||||
|
||||
/* basic vm machinery */
|
||||
/* 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)
|
||||
|
|
@ -107,7 +107,6 @@ 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)
|
||||
|
|
@ -128,7 +127,6 @@ 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)
|
||||
|
|
@ -139,7 +137,6 @@ 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)
|
||||
|
|
@ -150,7 +147,6 @@ 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)
|
||||
|
|
@ -161,13 +157,11 @@ 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)
|
||||
|
|
@ -192,22 +186,19 @@ 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 */
|
||||
/* 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)
|
||||
|
|
@ -223,7 +214,7 @@ 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 */
|
||||
/* 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)
|
||||
|
|
@ -329,7 +320,7 @@ 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(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)
|
||||
|
|
@ -376,7 +367,6 @@ 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)
|
||||
|
|
@ -385,7 +375,6 @@ 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)
|
||||
|
|
@ -396,7 +385,6 @@ 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)
|
||||
|
|
@ -428,15 +416,15 @@ 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(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(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)
|
||||
|
|
@ -455,8 +443,6 @@ 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)
|
||||
|
|
|
|||
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)]
|
||||
|
|
|
|||
87
src/t.scm
87
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,15 +231,21 @@
|
|||
(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)])
|
||||
(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)]
|
||||
[(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)]
|
||||
|
|
@ -238,9 +255,11 @@
|
|||
[(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)
|
||||
[else (if (integrable? hval)
|
||||
(xform-integrable hval tail env)
|
||||
(if (procedure? hval)
|
||||
(xform appos? (hval sexp env) env)
|
||||
(xform-call hval tail 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))])
|
||||
|
|
@ -302,13 +345,15 @@
|
|||
[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))
|
||||
[(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