core: Integrate garbage collector/jam scraper.
* mes.c (r0, r1, r2, r3, stack): New globals. (gc_loop): Handle MACRO and SCM. (gc_copy): Handle FUNCTION, allow for pre-allocated SCM and SYMBOL. (assq): Flag any BROKEN_HEARTs. (vm_call): New function. Enables moving C stack to GC stack. (evlis_env, apply_env, eval_env, expand_macro_env, begin_env, if_env): Use vm_call-indirection. (call_lambda): New function. (vm_apply_env): Rename from apply_env. Remove parameters, instead use r1, r2 and r0. (vm_evlis_env, vm_eval_env, vm_expand_macro_env, vm_begin_env, vm_if_env): Likewise. (acons): New function. (mes_environment) [!MES_FULL, MES_MINI]: Add cpp switches to create minimally filled environment, for debugging. (main): Print free value at exit. * define.c (define_env): Use vm_call-indirection. (vm_define_env): Rename from define_env. * quasiquote.c (eval_quasiquote): Use vm_call-indirection. (vm_eval_quasiquote): Rename from eval_quasiquote. * tests/gc-2.test: New test. tests/gc-2a.test: New test. tests/gc-3.test: New test.
This commit is contained in:
Jan Nieuwenhuizen
parent
c035a59094
commit
25c29ecb6d
38
define.c
38
define.c
|
|
@ -20,33 +20,41 @@
|
||||||
|
|
||||||
#if !BOOT
|
#if !BOOT
|
||||||
scm *
|
scm *
|
||||||
define_env (scm *x, scm *a)
|
define_env (scm *e, scm *a)
|
||||||
{
|
{
|
||||||
scm *e;
|
return vm_call (vm_define_env, e, &scm_undefined, a);
|
||||||
scm *name = cadr (x);
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
vm_define_env ()
|
||||||
|
{
|
||||||
|
scm *x;
|
||||||
|
scm *name = cadr (r1);
|
||||||
if (name->type != PAIR)
|
if (name->type != PAIR)
|
||||||
e = eval_env (caddr (x), cons (cons (cadr (x), cadr (x)), a));
|
x = eval_env (caddr (r1), cons (cons (cadr (r1), cadr (r1)), r0));
|
||||||
else {
|
else {
|
||||||
name = car (name);
|
name = car (name);
|
||||||
scm *p = pairlis (cadr (x), cadr (x), a);
|
scm *p = pairlis (cadr (r1), cadr (r1), r0);
|
||||||
cache_invalidate_range (p, a);
|
cache_invalidate_range (p, r0);
|
||||||
e = eval_env (make_lambda (cdadr (x), cddr (x)), p);
|
x = eval_env (make_lambda (cdadr (r1), cddr (r1)), p);
|
||||||
}
|
}
|
||||||
if (eq_p (car (x), &symbol_define_macro) == &scm_t)
|
if (eq_p (car (r1), &symbol_define_macro) == &scm_t)
|
||||||
e = make_macro (name, e);
|
x = make_macro (name, x);
|
||||||
scm *entry = cons (name, e);
|
|
||||||
|
scm *entry = cons (name, x);
|
||||||
scm *aa = cons (entry, &scm_nil);
|
scm *aa = cons (entry, &scm_nil);
|
||||||
set_cdr_x (aa, cdr (a));
|
set_cdr_x (aa, cdr (r0));
|
||||||
set_cdr_x (a, aa);
|
set_cdr_x (r0, aa);
|
||||||
scm *cl = assq (&scm_closure, a);
|
scm *cl = assq (&scm_closure, r0);
|
||||||
set_cdr_x (cl, aa);
|
set_cdr_x (cl, aa);
|
||||||
return entry;
|
return entry;
|
||||||
}
|
}
|
||||||
#else // BOOT
|
#else // BOOT
|
||||||
scm*define_env (scm *x, scm *a){}
|
scm*define_env (scm *r1, scm *a){}
|
||||||
|
scm*vm_define_env (scm *r1, scm *a){}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
define_macro (scm *x, scm *a)
|
define_macro (scm *r1, scm *a)
|
||||||
{
|
{
|
||||||
}
|
}
|
||||||
|
|
|
||||||
1
lib.c
1
lib.c
|
|
@ -29,6 +29,7 @@ scm *cdadr (scm *x) {return cdr (car (cdr (x)));}
|
||||||
scm *cadar (scm *x) {return car (cdr (car (x)));}
|
scm *cadar (scm *x) {return car (cdr (car (x)));}
|
||||||
scm *cddar (scm *x) {return cdr (cdr (car (x)));}
|
scm *cddar (scm *x) {return cdr (cdr (car (x)));}
|
||||||
scm *cdddr (scm *x) {return cdr (cdr (cdr (x)));}
|
scm *cdddr (scm *x) {return cdr (cdr (cdr (x)));}
|
||||||
|
scm *cadddr (scm *x) {return car (cdr (cdr (cdr (x))));}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
length (scm *x)
|
length (scm *x)
|
||||||
|
|
|
||||||
463
mes.c
463
mes.c
|
|
@ -30,19 +30,29 @@
|
||||||
#define DEBUG 0
|
#define DEBUG 0
|
||||||
#define QUASIQUOTE 1
|
#define QUASIQUOTE 1
|
||||||
//#define QUASISYNTAX 0
|
//#define QUASISYNTAX 0
|
||||||
|
|
||||||
#define GC 1
|
#define GC 1
|
||||||
#if GC // call gc from builtin_eval () -- dumps core
|
#define MES_FULL 1
|
||||||
//int ARENA_SIZE = 1024 * 1024 * 1024;
|
#define MES_MINI 0 // 1 for gc-2a.test, gc-3.test
|
||||||
/* 28000 cells triggers a gc for mes-check just afre passing the first test */
|
|
||||||
int ARENA_SIZE = 28000; // sizeof(scm) = 24
|
#if MES_FULL
|
||||||
|
int ARENA_SIZE = 300000000; // need this much for tests/match.scm
|
||||||
|
//int ARENA_SIZE = 30000000; // need this much for tests/record.scm
|
||||||
|
//int ARENA_SIZE = 500000; // enough for tests/scm.test
|
||||||
|
//int ARENA_SIZE = 60000; // enough for tests/base.test
|
||||||
|
int GC_SAFETY = 10000;
|
||||||
|
int GC_FREE = 20000;
|
||||||
|
#else
|
||||||
|
// just enough for empty environment and tests/gc-2.test.
|
||||||
|
//int ARENA_SIZE = 7500; // gc-3.test, gc-2a.test
|
||||||
|
//int ARENA_SIZE = 10000; // gc-2a.test
|
||||||
|
int ARENA_SIZE = 18000; // gc-2.test -->KRAK
|
||||||
|
//int ARENA_SIZE = 23000; // gc-2.test OK
|
||||||
int GC_SAFETY = 1000;
|
int GC_SAFETY = 1000;
|
||||||
#else // testing
|
int GC_FREE = 1000;
|
||||||
int ARENA_SIZE = 11;
|
|
||||||
int GC_SAFETY = 0;
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
enum type {CHAR, FUNCTION, MACRO, NUMBER, PAIR, SCM, STRING, SYMBOL, REF, VALUES, VECTOR, BROKEN_HEART};
|
enum type {CHAR, FUNCTION, MACRO, NUMBER, PAIR, SCM, STRING, SYMBOL, REF, VALUES, VECTOR, BROKEN_HEART};
|
||||||
|
|
||||||
typedef struct scm_t* (*function0_t) (void);
|
typedef struct scm_t* (*function0_t) (void);
|
||||||
typedef struct scm_t* (*function1_t) (struct scm_t*);
|
typedef struct scm_t* (*function1_t) (struct scm_t*);
|
||||||
typedef struct scm_t* (*function2_t) (struct scm_t*, struct scm_t*);
|
typedef struct scm_t* (*function2_t) (struct scm_t*, struct scm_t*);
|
||||||
|
|
@ -90,6 +100,13 @@ typedef struct scm_t {
|
||||||
scm *display_ (FILE* f, scm *x);
|
scm *display_ (FILE* f, scm *x);
|
||||||
scm *display_helper (FILE*, scm*, bool, char const*, bool);
|
scm *display_helper (FILE*, scm*, bool, char const*, bool);
|
||||||
|
|
||||||
|
scm *symbols = 0;
|
||||||
|
scm *stack = 0;
|
||||||
|
scm *r0 = 0; // a/env
|
||||||
|
scm *r1 = 0; // param 1
|
||||||
|
scm *r2 = 0; // param 2
|
||||||
|
scm *r3 = 0; // param 3
|
||||||
|
|
||||||
scm scm_nil = {SCM, "()"};
|
scm scm_nil = {SCM, "()"};
|
||||||
scm scm_dot = {SCM, "."};
|
scm scm_dot = {SCM, "."};
|
||||||
scm scm_f = {SCM, "#f"};
|
scm scm_f = {SCM, "#f"};
|
||||||
|
|
@ -102,7 +119,7 @@ scm scm_circular = {SCM, "*circular*"};
|
||||||
scm scm_label = {
|
scm scm_label = {
|
||||||
SCM, "label"};
|
SCM, "label"};
|
||||||
#endif
|
#endif
|
||||||
scm scm_begin = {SCM, "begin"};
|
scm scm_begin = {SCM, "*begin*"};
|
||||||
|
|
||||||
scm symbol_lambda = {SYMBOL, "lambda"};
|
scm symbol_lambda = {SYMBOL, "lambda"};
|
||||||
scm symbol_begin = {SYMBOL, "begin"};
|
scm symbol_begin = {SYMBOL, "begin"};
|
||||||
|
|
@ -162,8 +179,6 @@ scm *
|
||||||
alloc (int n)
|
alloc (int n)
|
||||||
{
|
{
|
||||||
#if GC
|
#if GC
|
||||||
// haha, where are we going to get our root, i.e., a=environment?
|
|
||||||
//if (g_free - g_cells + n >= ARENA_SIZE) gc ();
|
|
||||||
assert (g_free.value + n < ARENA_SIZE);
|
assert (g_free.value + n < ARENA_SIZE);
|
||||||
scm* x = &g_cells[g_free.value];
|
scm* x = &g_cells[g_free.value];
|
||||||
g_free.value += n;
|
g_free.value += n;
|
||||||
|
|
@ -185,33 +200,36 @@ gc_alloc (int n)
|
||||||
scm *
|
scm *
|
||||||
gc (scm *a)
|
gc (scm *a)
|
||||||
{
|
{
|
||||||
fprintf (stderr, "***GC***\n");
|
fprintf (stderr, "***gc[%d]...", g_free.value);
|
||||||
g_free.value = 0;
|
g_free.value = 0;
|
||||||
//gc_show ();
|
scm *new = gc_copy (stack);
|
||||||
scm *new = gc_copy (a);
|
gc_copy (symbols);
|
||||||
return gc_loop (new);
|
return gc_loop (new);
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
gc_loop (scm *new)
|
gc_loop (scm *scan)
|
||||||
{
|
{
|
||||||
while (new - g_news < g_free.value)
|
while (scan - g_news < g_free.value)
|
||||||
{
|
{
|
||||||
//gc_show ();
|
if (scan->type == MACRO
|
||||||
if (new->type == PAIR
|
|| scan->type == PAIR
|
||||||
|| new->type == REF
|
|| scan->type == REF
|
||||||
|| new->type == STRING
|
|| (scan->type == SCM && scan->car->type == PAIR)
|
||||||
|| new->type == SYMBOL)
|
|| (scan->type == STRING && scan->car->type == PAIR)
|
||||||
|
|| (scan->type == SYMBOL && scan->car->type == PAIR))
|
||||||
{
|
{
|
||||||
scm *car = gc_copy (new->car);
|
scm *car = gc_copy (scan->car);
|
||||||
gc_relocate_car (new, car);
|
gc_relocate_car (scan, car);
|
||||||
}
|
}
|
||||||
if (new->type == PAIR)
|
if ((scan->type == MACRO
|
||||||
|
|| scan->type == PAIR)
|
||||||
|
&& scan->cdr) // allow for 0 terminated list of symbols
|
||||||
{
|
{
|
||||||
scm *cdr = gc_copy (new->cdr);
|
scm *cdr = gc_copy (scan->cdr);
|
||||||
gc_relocate_cdr (new, cdr);
|
gc_relocate_cdr (scan, cdr);
|
||||||
}
|
}
|
||||||
new++;
|
scan++;
|
||||||
}
|
}
|
||||||
return gc_flip ();
|
return gc_flip ();
|
||||||
}
|
}
|
||||||
|
|
@ -220,7 +238,9 @@ scm *
|
||||||
gc_copy (scm *old)
|
gc_copy (scm *old)
|
||||||
{
|
{
|
||||||
if (old->type == BROKEN_HEART) return old->car;
|
if (old->type == BROKEN_HEART) return old->car;
|
||||||
|
if (old->type == FUNCTION) return old;
|
||||||
if (old->type == SCM) return old;
|
if (old->type == SCM) return old;
|
||||||
|
if (old < g_cells && old < g_news) return old;
|
||||||
scm *new = &g_news[g_free.value++];
|
scm *new = &g_news[g_free.value++];
|
||||||
*new = *old;
|
*new = *old;
|
||||||
if (new->type == VECTOR)
|
if (new->type == VECTOR)
|
||||||
|
|
@ -231,12 +251,6 @@ gc_copy (scm *old)
|
||||||
return new;
|
return new;
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
|
||||||
gc_move (scm* dest, scm *src)
|
|
||||||
{
|
|
||||||
*dest = *src;
|
|
||||||
}
|
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
gc_relocate_car (scm *new, scm *car)
|
gc_relocate_car (scm *new, scm *car)
|
||||||
{
|
{
|
||||||
|
|
@ -259,6 +273,24 @@ gc_flip ()
|
||||||
g_news = cells;
|
g_news = cells;
|
||||||
(g_cells-1)->vector = g_news;
|
(g_cells-1)->vector = g_news;
|
||||||
(g_news-1)->vector = g_cells;
|
(g_news-1)->vector = g_cells;
|
||||||
|
|
||||||
|
fprintf (stderr, " => jam[%d]\n", g_free.value);
|
||||||
|
// Reduce arena size to quickly get multiple GC's.
|
||||||
|
// Startup memory footprint is relatively high because of builtin
|
||||||
|
// function names
|
||||||
|
//ARENA_SIZE = g_free.value + GC_FREE + GC_SAFETY;
|
||||||
|
// fprintf (stderr, "ARENA SIZE => %d\n", ARENA_SIZE - GC_SAFETY);
|
||||||
|
symbols = &g_cells[1];
|
||||||
|
return &g_cells[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
gc_bump ()
|
||||||
|
{
|
||||||
|
g_cells += g_free.value;
|
||||||
|
g_news += g_free.value;
|
||||||
|
ARENA_SIZE -= g_free.value;
|
||||||
|
g_free.value = 0;
|
||||||
return &scm_unspecified;
|
return &scm_unspecified;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -391,7 +423,12 @@ pairlis (scm *x, scm *y, scm *a)
|
||||||
scm *
|
scm *
|
||||||
assq (scm *x, scm *a)
|
assq (scm *x, scm *a)
|
||||||
{
|
{
|
||||||
while (a != &scm_nil && eq_p (x, a->car->car) == &scm_f) a = a->cdr;
|
while (a != &scm_nil && eq_p (x, a->car->car) == &scm_f)
|
||||||
|
{
|
||||||
|
if (a->type == BROKEN_HEART || a->car->type == BROKEN_HEART)
|
||||||
|
fprintf (stderr, "oops, broken heart\n");
|
||||||
|
a = a->cdr;
|
||||||
|
}
|
||||||
return a != &scm_nil ? a->car : &scm_f;
|
return a != &scm_nil ? a->car : &scm_f;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -501,48 +538,145 @@ assert_defined (scm *x, scm *e)
|
||||||
return e;
|
return e;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
vm_call (function0_t f, scm *p1, scm *p2, scm *a)
|
||||||
|
{
|
||||||
|
scm *frame = cons (r1, cons (r2, cons (r3, cons (r0, &scm_nil))));
|
||||||
|
stack = cons (frame, stack);
|
||||||
|
r1 = p1;
|
||||||
|
r2 = p2;
|
||||||
|
r0 = a;
|
||||||
|
//if (f == vm_expand_macro_env && g_free.value + GC_SAFETY > ARENA_SIZE)
|
||||||
|
if (g_free.value + GC_SAFETY > ARENA_SIZE)
|
||||||
|
{
|
||||||
|
frame = cons (r1, cons (r2, cons (r3, cons (r0, &scm_nil))));
|
||||||
|
stack = cons (frame, stack);
|
||||||
|
scm *x = gc (stack);
|
||||||
|
*stack = *x;
|
||||||
|
frame = car (stack);
|
||||||
|
stack = cdr (stack);
|
||||||
|
r1 = car (frame);
|
||||||
|
r2 = cadr (frame);
|
||||||
|
r3 = caddr (frame);
|
||||||
|
r0 = cadddr (frame);
|
||||||
|
}
|
||||||
|
|
||||||
|
scm *r = f ();
|
||||||
|
frame = car (stack);
|
||||||
|
stack = cdr (stack);
|
||||||
|
r1 = car (frame);
|
||||||
|
r2 = cadr (frame);
|
||||||
|
r3 = caddr (frame);
|
||||||
|
r0 = cadddr (frame);
|
||||||
|
return r;
|
||||||
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
evlis_env (scm *m, scm *a)
|
evlis_env (scm *m, scm *a)
|
||||||
{
|
{
|
||||||
if (m == &scm_nil) return &scm_nil;
|
return vm_call (vm_evlis_env, m, &scm_undefined, a);
|
||||||
if (m->type != PAIR) return eval_env (m, a);
|
|
||||||
scm *e = eval_env (car (m), a);
|
|
||||||
return cons (e, evlis_env (cdr (m), a));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
apply_env (scm *fn, scm *x, scm *a)
|
apply_env (scm *fn, scm *x, scm *a)
|
||||||
{
|
{
|
||||||
if (fn->type != PAIR)
|
return vm_call (vm_apply_env, fn, x, a);
|
||||||
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
eval_env (scm *e, scm *a)
|
||||||
{
|
{
|
||||||
if (fn->type == FUNCTION) return call (fn, x);
|
return vm_call (vm_eval_env, e, &scm_undefined, a);
|
||||||
if (fn == &symbol_call_with_values)
|
|
||||||
return call (&scm_call_with_values_env, append2 (x, cons (a, &scm_nil)));
|
|
||||||
if (fn == &symbol_current_module) return a;
|
|
||||||
}
|
}
|
||||||
else if (fn->car == &symbol_lambda) {
|
|
||||||
scm *p = pairlis (cadr (fn), x, a);
|
scm *
|
||||||
cache_invalidate_range (p, a->cdr);
|
expand_macro_env (scm *e, scm *a)
|
||||||
scm *r = begin_env (cddr (fn), cons (cons (&scm_closure, p), p));
|
{
|
||||||
cache_invalidate_range (p, a->cdr);
|
return vm_call (vm_expand_macro_env, e, &scm_undefined, a);
|
||||||
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
begin_env (scm *e, scm *a)
|
||||||
|
{
|
||||||
|
return vm_call (vm_begin_env, e, &scm_undefined, a);
|
||||||
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
if_env (scm *e, scm *a)
|
||||||
|
{
|
||||||
|
return vm_call (vm_if_env, e, &scm_undefined, a);
|
||||||
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
call_lambda (scm *e, scm *x, scm* aa, scm *a) ///((internal))
|
||||||
|
{
|
||||||
|
scm *cl = cons (cons (&scm_closure, x), x);
|
||||||
|
r1 = e;
|
||||||
|
r0 = cl;
|
||||||
|
r2 = a;
|
||||||
|
r3 = aa;
|
||||||
|
cache_invalidate_range (r0, r3->cdr);
|
||||||
|
scm *r = vm_call_lambda ();
|
||||||
|
cache_invalidate_range (r0, r3->cdr);
|
||||||
return r;
|
return r;
|
||||||
}
|
}
|
||||||
else if (fn->car == &scm_closure) {
|
|
||||||
scm *args = caddr (fn);
|
scm *
|
||||||
scm *body = cdddr (fn);
|
vm_evlis_env ()
|
||||||
a = cdadr (fn);
|
{
|
||||||
a = cdr (a);
|
if (r1 == &scm_nil) return &scm_nil;
|
||||||
scm *p = pairlis (args, x, a);
|
if (r1->type != PAIR) return eval_env (r1, r0);
|
||||||
cache_invalidate_range (p, a->cdr);
|
r2 = eval_env (car (r1), r0);
|
||||||
scm *r = begin_env (body, cons (cons (&scm_closure, p), p));
|
r1 = evlis_env (cdr (r1), r0);
|
||||||
cache_invalidate_range (p, a->cdr);
|
return cons (r2, r1);
|
||||||
return r;
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
vm_call_lambda ()
|
||||||
|
{
|
||||||
|
return vm_call (vm_begin_env, r1, &scm_undefined, r0);
|
||||||
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
vm_apply_env ()
|
||||||
|
{
|
||||||
|
if (r1->type != PAIR)
|
||||||
|
{
|
||||||
|
if (r1->type == FUNCTION) return call (r1, r2);
|
||||||
|
if (r1 == &symbol_call_with_values)
|
||||||
|
return call (&scm_call_with_values_env, append2 (r2, cons (r0, &scm_nil)));
|
||||||
|
if (r1 == &symbol_current_module) return r0;
|
||||||
|
}
|
||||||
|
else if (r1->car == &symbol_lambda) {
|
||||||
|
scm *args = cadr (r1);
|
||||||
|
scm *body = cddr (r1);
|
||||||
|
scm *p = pairlis (args, r2, r0);
|
||||||
|
return call_lambda (body, p, p, r0);
|
||||||
|
// r2 = p;
|
||||||
|
// cache_invalidate_range (r2, r0->cdr);
|
||||||
|
// scm *r = begin_env (cddr (r1), cons (cons (&scm_closure, p), p));
|
||||||
|
// cache_invalidate_range (r2, r0->cdr);
|
||||||
|
// return r;
|
||||||
|
}
|
||||||
|
else if (r1->car == &scm_closure) {
|
||||||
|
scm *args = caddr (r1);
|
||||||
|
scm *body = cdddr (r1);
|
||||||
|
scm *aa = cdadr (r1);
|
||||||
|
aa = cdr (aa);
|
||||||
|
scm *p = pairlis (args, r2, aa);
|
||||||
|
return call_lambda (body, p, aa, r0);
|
||||||
|
// r2 = p;
|
||||||
|
// r3 = aa;
|
||||||
|
// cache_invalidate_range (r2, r3->cdr);
|
||||||
|
// scm *r = begin_env (body, cons (cons (&scm_closure, p), p));
|
||||||
|
// cache_invalidate_range (r2, r3->cdr);
|
||||||
|
// return r;
|
||||||
}
|
}
|
||||||
#if BOOT
|
#if BOOT
|
||||||
else if (fn->car == &scm_label)
|
else if (r1->car == &scm_label)
|
||||||
return apply_env (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a));
|
return apply_env (caddr (r1), r2, cons (cons (cadr (r1), caddr (r1)), r0));
|
||||||
#endif
|
#endif
|
||||||
scm *e = eval_env (fn, a);
|
scm *e = eval_env (r1, r0);
|
||||||
char const* type = 0;
|
char const* type = 0;
|
||||||
if (e == &scm_f || e == &scm_t) type = "bool";
|
if (e == &scm_f || e == &scm_t) type = "bool";
|
||||||
if (e->type == CHAR) type = "char";
|
if (e->type == CHAR) type = "char";
|
||||||
|
|
@ -554,122 +688,129 @@ apply_env (scm *fn, scm *x, scm *a)
|
||||||
{
|
{
|
||||||
fprintf (stderr, "cannot apply: %s: ", type);
|
fprintf (stderr, "cannot apply: %s: ", type);
|
||||||
display_ (stderr, e);
|
display_ (stderr, e);
|
||||||
fprintf (stderr, " (");
|
fprintf (stderr, " [");
|
||||||
display_ (stderr, fn);
|
display_ (stderr, r1);
|
||||||
fprintf (stderr, ")\n");
|
fprintf (stderr, "]\n");
|
||||||
assert (!"cannot apply");
|
assert (!"cannot apply");
|
||||||
}
|
}
|
||||||
return apply_env (e, x, a);
|
return apply_env (e, r2, r0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
scm*cstring_to_list (char const* s);
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
eval_env (scm *e, scm *a)
|
vm_eval_env ()
|
||||||
{
|
{
|
||||||
#if GC
|
switch (r1->type)
|
||||||
if (g_free.value + GC_SAFETY > ARENA_SIZE) gc (a);
|
|
||||||
#endif
|
|
||||||
switch (e->type)
|
|
||||||
{
|
{
|
||||||
case PAIR:
|
case PAIR:
|
||||||
{
|
{
|
||||||
if (e->car == &symbol_quote)
|
if (r1->car == &symbol_quote)
|
||||||
return cadr (e);
|
return cadr (r1);
|
||||||
#if QUASISYNTAX
|
#if QUASISYNTAX
|
||||||
if (e->car == &symbol_syntax)
|
if (r1->car == &symbol_syntax)
|
||||||
return e;
|
return r1;
|
||||||
#endif
|
#endif
|
||||||
if (e->car == &symbol_begin)
|
if (r1->car == &symbol_begin)
|
||||||
return begin_env (e, a);
|
return begin_env (r1, r0);
|
||||||
if (e->car == &symbol_lambda)
|
if (r1->car == &symbol_lambda)
|
||||||
return make_closure (cadr (e), cddr (e), assq (&scm_closure, a));
|
return make_closure (cadr (r1), cddr (r1), assq (&scm_closure, r0));
|
||||||
if (e->car == &scm_closure)
|
if (r1->car == &scm_closure)
|
||||||
return e;
|
return r1;
|
||||||
if (e->car == &symbol_if)
|
if (r1->car == &symbol_if)
|
||||||
return builtin_if (cdr (e), a);
|
return if_env (cdr (r1), r0);
|
||||||
#if !BOOT
|
#if !BOOT
|
||||||
if (e->car == &symbol_define)
|
if (r1->car == &symbol_define)
|
||||||
return define_env (e, a);
|
return define_env (r1, r0);
|
||||||
if (e->car == &symbol_define_macro)
|
if (r1->car == &symbol_define_macro)
|
||||||
return define_env (e, a);
|
return define_env (r1, r0);
|
||||||
if (e->car == &symbol_primitive_load)
|
if (r1->car == &symbol_primitive_load)
|
||||||
return load_env (a);
|
return load_env (r0);
|
||||||
#else
|
#else
|
||||||
if (e->car == &symbol_define) {
|
if (r1->car == &symbol_define) {
|
||||||
fprintf (stderr, "C DEFINE: ");
|
fprintf (stderr, "C DEFINE: ");
|
||||||
display_ (stderr,
|
display_ (stderr,
|
||||||
e->cdr->car->type == SYMBOL
|
r1->cdr->car->type == SYMBOL
|
||||||
? e->cdr->car->string
|
? r1->cdr->car->string
|
||||||
: e->cdr->car->car->string);
|
: r1->cdr->car->car->string);
|
||||||
fprintf (stderr, "\n");
|
fprintf (stderr, "\n");
|
||||||
}
|
}
|
||||||
assert (e->car != &symbol_define);
|
assert (r1->car != &symbol_define);
|
||||||
assert (e->car != &symbol_define_macro);
|
assert (r1->car != &symbol_define_macro);
|
||||||
|
#endif
|
||||||
|
#if 1 //!BOOT
|
||||||
|
if (r1->car == &symbol_set_x)
|
||||||
|
return set_env_x (cadr (r1), eval_env (caddr (r1), r0), r0);
|
||||||
|
#else
|
||||||
|
assert (r1->car != &symbol_set_x);
|
||||||
#endif
|
#endif
|
||||||
if (e->car == &symbol_set_x)
|
|
||||||
return set_env_x (cadr (e), eval_env (caddr (e), a), a);
|
|
||||||
#if QUASIQUOTE
|
#if QUASIQUOTE
|
||||||
if (e->car == &symbol_unquote)
|
if (r1->car == &symbol_unquote)
|
||||||
return eval_env (cadr (e), a);
|
return eval_env (cadr (r1), r0);
|
||||||
if (e->car == &symbol_quasiquote)
|
if (r1->car == &symbol_quasiquote)
|
||||||
return eval_quasiquote (cadr (e), add_unquoters (a));
|
return eval_quasiquote (cadr (r1), add_unquoters (r0));
|
||||||
#endif //QUASIQUOTE
|
#endif //QUASIQUOTE
|
||||||
#if QUASISYNTAX
|
#if QUASISYNTAX
|
||||||
if (e->car == &symbol_unsyntax)
|
if (r1->car == &symbol_unsyntax)
|
||||||
return eval_env (cadr (e), a);
|
return eval_env (cadr (r1), r0);
|
||||||
if (e->car == &symbol_quasisyntax)
|
if (r1->car == &symbol_quasisyntax)
|
||||||
return eval_quasisyntax (cadr (e), add_unsyntaxers (a));
|
return eval_quasisyntax (cadr (r1), add_unsyntaxers (r0));
|
||||||
#endif //QUASISYNTAX
|
#endif //QUASISYNTAX
|
||||||
scm *x = expand_macro_env (e, a);
|
scm *x = expand_macro_env (r1, r0);
|
||||||
if (x != e) return eval_env (x, a);
|
if (x != r1)
|
||||||
return apply_env (e->car, evlis_env (e->cdr, a), a);
|
return eval_env (x, r0);
|
||||||
|
scm *m = evlis_env (r1->cdr, r0);
|
||||||
|
return apply_env (r1->car, m, r0);
|
||||||
}
|
}
|
||||||
case SYMBOL: return assert_defined (e, assq_ref_cache (e, a));
|
case SYMBOL: return assert_defined (r1, assq_ref_cache (r1, r0));
|
||||||
default: return e;
|
default: return r1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
expand_macro_env (scm *e, scm *a)
|
vm_expand_macro_env ()
|
||||||
{
|
{
|
||||||
if (car (e)->type == STRING && string_to_symbol (car (e)) == &symbol_noexpand)
|
if (car (r1)->type == STRING && string_to_symbol (car (r1)) == &symbol_noexpand)
|
||||||
return cadr (e);
|
return cadr (r1);
|
||||||
|
|
||||||
scm *macro;
|
scm *macro;
|
||||||
if (e->type == PAIR
|
|
||||||
&& (macro = lookup_macro (e->car, a)) != &scm_f)
|
|
||||||
return apply_env (macro, e->cdr, a);
|
|
||||||
|
|
||||||
scm *expanders;
|
scm *expanders;
|
||||||
if (e->type == PAIR
|
if (r1->type == PAIR
|
||||||
&& car (e)->type == SYMBOL
|
&& (macro = lookup_macro (r1->car, r0)) != &scm_f)
|
||||||
&& ((expanders = assq_ref_cache (&symbol_sc_expander_alist, a)) != &scm_undefined)
|
return apply_env (macro, r1->cdr, r0);
|
||||||
&& ((macro = assq (car (e), expanders)) != &scm_f))
|
else if (r1->type == PAIR
|
||||||
|
&& car (r1)->type == SYMBOL
|
||||||
|
&& ((expanders = assq_ref_cache (&symbol_sc_expander_alist, r0)) != &scm_undefined)
|
||||||
|
&& ((macro = assq (car (r1), expanders)) != &scm_f))
|
||||||
{
|
{
|
||||||
scm *sc_expand = assq_ref_cache (&symbol_expand_macro, a);
|
scm *sc_expand = assq_ref_cache (&symbol_expand_macro, r0);
|
||||||
if (sc_expand != &scm_undefined && sc_expand != &scm_f)
|
if (sc_expand != &scm_undefined && sc_expand != &scm_f)
|
||||||
e = apply_env (sc_expand, cons (e, &scm_nil), a);
|
r1 = apply_env (sc_expand, cons (r1, &scm_nil), r0);
|
||||||
}
|
}
|
||||||
return e;
|
return r1;
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
begin_env (scm *e, scm *a)
|
vm_begin_env ()
|
||||||
{
|
{
|
||||||
scm *r = &scm_unspecified;
|
scm *r = &scm_unspecified;
|
||||||
while (e != &scm_nil) {
|
while (r1 != &scm_nil) {
|
||||||
r = eval_env (e->car, a);
|
if (car (r1)->type == PAIR && caar (r1) == &symbol_begin)
|
||||||
e = e->cdr;
|
r1 = append2 (cdar (r1), cdr (r1));
|
||||||
|
r = eval_env (r1->car, r0);
|
||||||
|
r1 = r1->cdr;
|
||||||
}
|
}
|
||||||
return r;
|
return r;
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
builtin_if (scm *e, scm *a)
|
vm_if_env ()
|
||||||
{
|
{
|
||||||
if (eval_env (car (e), a) != &scm_f)
|
scm *x = eval_env (car (r1), r0);
|
||||||
return eval_env (cadr (e), a);
|
if (x != &scm_f)
|
||||||
if (cddr (e) != &scm_nil)
|
return eval_env (cadr (r1), r0);
|
||||||
return eval_env (caddr (e), a);
|
if (cddr (r1) != &scm_nil)
|
||||||
|
return eval_env (caddr (r1), r0);
|
||||||
return &scm_unspecified;
|
return &scm_unspecified;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -773,8 +914,6 @@ cstring_to_list (char const* s)
|
||||||
return p;
|
return p;
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *symbols = 0;
|
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
list_of_char_equal_p (scm *a, scm *b)
|
list_of_char_equal_p (scm *a, scm *b)
|
||||||
{
|
{
|
||||||
|
|
@ -965,12 +1104,9 @@ force_output (scm *p) ///((arity . n))
|
||||||
fflush (f);
|
fflush (f);
|
||||||
}
|
}
|
||||||
|
|
||||||
int display_depth = 1000;
|
|
||||||
scm *
|
scm *
|
||||||
display_helper (FILE* f, scm *x, bool cont, char const *sep, bool quote)
|
display_helper (FILE* f, scm *x, bool cont, char const *sep, bool quote)
|
||||||
{
|
{
|
||||||
//if (!display_depth) return &scm_unspecified;
|
|
||||||
display_depth--;
|
|
||||||
scm *r;
|
scm *r;
|
||||||
fprintf (f, "%s", sep);
|
fprintf (f, "%s", sep);
|
||||||
switch (x->type)
|
switch (x->type)
|
||||||
|
|
@ -1012,7 +1148,7 @@ display_helper (FILE* f, scm *x, bool cont, char const *sep, bool quote)
|
||||||
}
|
}
|
||||||
if (!cont) fprintf (f, "(");
|
if (!cont) fprintf (f, "(");
|
||||||
display_ (f, car (x));
|
display_ (f, car (x));
|
||||||
if (cdr (x)->type == PAIR)
|
if (cdr (x) && cdr (x)->type == PAIR)
|
||||||
display_helper (f, cdr (x), true, " ", false);
|
display_helper (f, cdr (x), true, " ", false);
|
||||||
else if (cdr (x) != &scm_nil) {
|
else if (cdr (x) != &scm_nil) {
|
||||||
fprintf (f, " . ");
|
fprintf (f, " . ");
|
||||||
|
|
@ -1271,10 +1407,16 @@ read_env (scm *a)
|
||||||
return readword (getchar (), &scm_nil, a);
|
return readword (getchar (), &scm_nil, a);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
scm *
|
||||||
|
acons (scm *key, scm *value, scm *alist)
|
||||||
|
{
|
||||||
|
return cons (cons (key, value), alist);
|
||||||
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
add_environment (scm *a, char const *name, scm *x)
|
add_environment (scm *a, char const *name, scm *x)
|
||||||
{
|
{
|
||||||
return cons (cons (make_symbol (cstring_to_list (name)), x), a);
|
return acons (make_symbol (cstring_to_list (name)), x, a);
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
|
|
@ -1292,9 +1434,11 @@ mes_environment () ///((internal))
|
||||||
g_news[0].length = ARENA_SIZE - 1;
|
g_news[0].length = ARENA_SIZE - 1;
|
||||||
g_news[0].vector = &g_news[1];
|
g_news[0].vector = &g_news[1];
|
||||||
|
|
||||||
a = add_environment (a, "%free", &g_free);
|
g_cells++;
|
||||||
a = add_environment (a, "%the-cells", g_cells++);
|
g_news++;
|
||||||
a = add_environment (a, "%new-cells", g_news++);
|
// a = add_environment (a, "%free", &g_free); hihi, gets <3 moved
|
||||||
|
// a = add_environment (a, "%the-cells", g_cells);
|
||||||
|
// a = add_environment (a, "%new-cells", g_news);
|
||||||
|
|
||||||
#include "mes.symbols.i"
|
#include "mes.symbols.i"
|
||||||
|
|
||||||
|
|
@ -1304,6 +1448,7 @@ mes_environment () ///((internal))
|
||||||
#endif
|
#endif
|
||||||
a = cons (cons (&symbol_begin, &scm_begin), a);
|
a = cons (cons (&symbol_begin, &scm_begin), a);
|
||||||
|
|
||||||
|
#if MES_FULL
|
||||||
#include "posix.environment.i"
|
#include "posix.environment.i"
|
||||||
#include "string.environment.i"
|
#include "string.environment.i"
|
||||||
#include "math.environment.i"
|
#include "math.environment.i"
|
||||||
|
|
@ -1312,10 +1457,43 @@ mes_environment () ///((internal))
|
||||||
//#include "quasiquote.environment.i"
|
//#include "quasiquote.environment.i"
|
||||||
#include "define.environment.i"
|
#include "define.environment.i"
|
||||||
#include "type.environment.i"
|
#include "type.environment.i"
|
||||||
|
#else
|
||||||
|
a = add_environment (a, "cons", &scm_cons);
|
||||||
|
a = add_environment (a, "eq?", &scm_eq_p);
|
||||||
|
a = add_environment (a, "display", &scm_display);
|
||||||
|
a = add_environment (a, "newline", &scm_newline);
|
||||||
|
|
||||||
|
#if !MES_MINI
|
||||||
|
a = add_environment (a, "*", &scm_multiply);
|
||||||
|
a = add_environment (a, "list", &scm_list);
|
||||||
|
//
|
||||||
|
a = add_environment (a, "car", &scm_car);
|
||||||
|
a = add_environment (a, "cdr", &scm_cdr);
|
||||||
|
a = add_environment (a, "+", &scm_plus);
|
||||||
|
a = add_environment (a, "quote", &scm_quote);
|
||||||
|
a = add_environment (a, "null?", &scm_null_p);
|
||||||
|
a = add_environment (a, "=", &scm_is_p);
|
||||||
|
|
||||||
|
// a = add_environment (a, "gc", &scm_gc);
|
||||||
|
// a = add_environment (a, "apply-env", &scm_apply_env);
|
||||||
|
// a = add_environment (a, "eval-env", &scm_eval_env);
|
||||||
|
// a = add_environment (a, "cadr", &scm_cadr);
|
||||||
|
#endif
|
||||||
|
#endif
|
||||||
|
|
||||||
a = add_environment (a, "sc-expand", &scm_f);
|
a = add_environment (a, "sc-expand", &scm_f);
|
||||||
|
|
||||||
a = cons (cons (&scm_closure, a), a);
|
a = cons (cons (&scm_closure, a), a);
|
||||||
|
|
||||||
|
internal_lookup_symbol (&scm_nil);
|
||||||
|
|
||||||
|
gc_bump (); // secure the .string of builtins, scm and symbols
|
||||||
|
r0 = a;
|
||||||
|
r1 = make_char (0);
|
||||||
|
r2 = make_char (0);
|
||||||
|
r3 = make_char (0);
|
||||||
|
stack = cons (&scm_nil, &scm_nil);
|
||||||
|
|
||||||
return a;
|
return a;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
@ -1370,5 +1548,6 @@ main (int argc, char *argv[])
|
||||||
scm *a = mes_environment ();
|
scm *a = mes_environment ();
|
||||||
display_ (stderr, load_env (a));
|
display_ (stderr, load_env (a));
|
||||||
fputs ("", stderr);
|
fputs ("", stderr);
|
||||||
|
fprintf (stderr, "\nstats: [%d]\n", g_free.value);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
|
||||||
|
|
@ -37,7 +37,7 @@
|
||||||
((label loop-0
|
((label loop-0
|
||||||
(lambda (r e a)
|
(lambda (r e a)
|
||||||
;; (display "***LOOP-0*** ... e=") (display e) (newline)
|
;; (display "***LOOP-0*** ... e=") (display e) (newline)
|
||||||
(if (null? e) (eval-env (cons 'begin (read-file-env (read-env a) a)) a)
|
(if (null? e) (eval-env (cons 'begin (read-input-file-env (read-env a) a)) a)
|
||||||
(if (atom? e) (loop-0 (eval-env e a) (read-env a) a)
|
(if (atom? e) (loop-0 (eval-env e a) (read-env a) a)
|
||||||
(if (eq? (car e) 'define)
|
(if (eq? (car e) 'define)
|
||||||
((lambda (aa) ; env:define
|
((lambda (aa) ; env:define
|
||||||
|
|
|
||||||
26
quasiquote.c
26
quasiquote.c
|
|
@ -36,14 +36,24 @@ unquote_splicing (scm *x) ///((no-environment))
|
||||||
scm *
|
scm *
|
||||||
eval_quasiquote (scm *e, scm *a)
|
eval_quasiquote (scm *e, scm *a)
|
||||||
{
|
{
|
||||||
if (e == &scm_nil) return e;
|
return vm_call (vm_eval_quasiquote, e, &scm_undefined, a);
|
||||||
else if (atom_p (e) == &scm_t) return e;
|
}
|
||||||
else if (eq_p (car (e), &symbol_unquote) == &scm_t)
|
|
||||||
return eval_env (cadr (e), a);
|
scm *
|
||||||
else if (e->type == PAIR && e->car->type == PAIR
|
vm_eval_quasiquote ()
|
||||||
&& eq_p (caar (e), &symbol_unquote_splicing) == &scm_t)
|
{
|
||||||
return append2 (eval_env (cadar (e), a), eval_quasiquote (cdr (e), a));
|
if (r1 == &scm_nil) return r1;
|
||||||
return cons (eval_quasiquote (car (e), a), eval_quasiquote (cdr (e), a));
|
else if (atom_p (r1) == &scm_t) return r1;
|
||||||
|
else if (eq_p (car (r1), &symbol_unquote) == &scm_t)
|
||||||
|
return eval_env (cadr (r1), r0);
|
||||||
|
else if (r1->type == PAIR && r1->car->type == PAIR
|
||||||
|
&& eq_p (caar (r1), &symbol_unquote_splicing) == &scm_t)
|
||||||
|
{
|
||||||
|
r2 = eval_env (cadar (r1), r0);
|
||||||
|
return append2 (r2, eval_quasiquote (cdr (r1), r0));
|
||||||
|
}
|
||||||
|
r2 = eval_quasiquote (car (r1), r0);
|
||||||
|
return cons (r2, eval_quasiquote (cdr (r1), r0));
|
||||||
}
|
}
|
||||||
|
|
||||||
scm *
|
scm *
|
||||||
|
|
|
||||||
|
|
@ -1,6 +1,5 @@
|
||||||
#! /bin/sh
|
#! /bin/sh
|
||||||
# -*-scheme-*-
|
# -*-scheme-*-
|
||||||
set -x
|
|
||||||
echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
|
echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
|
||||||
#paredit:||
|
#paredit:||
|
||||||
exit $?
|
exit $?
|
||||||
|
|
@ -37,12 +36,11 @@ exit $?
|
||||||
(pass-if "begin" (seq? (begin 'a 'b (+ 1 2)) 3))
|
(pass-if "begin" (seq? (begin 'a 'b (+ 1 2)) 3))
|
||||||
(pass-if "lambda" (symbol? 'lambda))
|
(pass-if "lambda" (symbol? 'lambda))
|
||||||
|
|
||||||
(begin (define *top-begin-a* '*top-begin-a*))
|
(define *top-define-a* '*top-define-a*)
|
||||||
(pass-if "top begin " (seq? *top-begin-a* '*top-begin-a*))
|
(pass-if "top define " (seq? *top-define-a* '*top-define-a*))
|
||||||
|
|
||||||
(begin (begin (define *top-begin-begin-a* '*top-begin-begin-a*)))
|
|
||||||
(pass-if "top begin begin " (seq? *top-begin-begin-a* '*top-begin-begin-a*))
|
|
||||||
|
|
||||||
|
(begin (define *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
(pass-if "top begin define " (seq? *top-begin-define-a* '*top-begin-define-a*))
|
||||||
(pass-if "if" (seq? (if #t 'true) 'true))
|
(pass-if "if" (seq? (if #t 'true) 'true))
|
||||||
(pass-if "if 2" (seq? (if #f #f) *unspecified*))
|
(pass-if "if 2" (seq? (if #f #f) *unspecified*))
|
||||||
(pass-if "if 3" (seq? (if (seq? 0 '0) 'true 'false) 'true))
|
(pass-if "if 3" (seq? (if (seq? 0 '0) 'true 'false) 'true))
|
||||||
|
|
@ -73,7 +71,6 @@ exit $?
|
||||||
(pass-if "apply" (sequal? (apply list '(1)) '(1)))
|
(pass-if "apply" (sequal? (apply list '(1)) '(1)))
|
||||||
(pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2)))
|
(pass-if "apply 2" (sequal? (apply list 1 '(2)) '(1 2)))
|
||||||
(pass-if "apply 3" (sequal? (apply list 1 2 '(3)) '(1 2 3)))
|
(pass-if "apply 3" (sequal? (apply list 1 2 '(3)) '(1 2 3)))
|
||||||
|
|
||||||
(begin
|
(begin
|
||||||
(define local-answer 41))
|
(define local-answer 41))
|
||||||
(pass-if-equal "begin 2" 41 (begin local-answer))
|
(pass-if-equal "begin 2" 41 (begin local-answer))
|
||||||
|
|
|
||||||
360
tests/gc-2.test
Executable file
360
tests/gc-2.test
Executable file
|
|
@ -0,0 +1,360 @@
|
||||||
|
#! /bin/sh
|
||||||
|
# -*-scheme-*-
|
||||||
|
set -x
|
||||||
|
echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
|
||||||
|
#paredit:||
|
||||||
|
exit $?
|
||||||
|
!#
|
||||||
|
|
||||||
|
;;; -*-scheme-*-
|
||||||
|
|
||||||
|
;;; Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of Mes.
|
||||||
|
;;;
|
||||||
|
;;; Mes is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Mes is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;; (define *top-define-a* '*top-define-a*)
|
||||||
|
;; (display (eq? *top-define-a* '*top-define-a*))
|
||||||
|
;; (newline)
|
||||||
|
;; (begin (define *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
;; (display (eq? *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
;; (newline)
|
||||||
|
|
||||||
|
(display 'HALLO) (newline)
|
||||||
|
(define (result r)
|
||||||
|
(display 'result:) (display r) (newline))
|
||||||
|
|
||||||
|
(define (cadr x) (car (cdr x)))
|
||||||
|
(define (simple-map f l)
|
||||||
|
(if (null? l) '()
|
||||||
|
(cons (f (car l)) (simple-map f (cdr l)))))
|
||||||
|
|
||||||
|
(define-macro (simple-let bindings . rest)
|
||||||
|
(cons (cons 'lambda (cons (simple-map car bindings) rest))
|
||||||
|
(simple-map cadr bindings)))
|
||||||
|
|
||||||
|
(define-macro (let bindings . rest)
|
||||||
|
(cons 'simple-let (cons bindings rest)))
|
||||||
|
|
||||||
|
(define blub? #t)
|
||||||
|
;; (define result
|
||||||
|
;; (let ((pass 0)
|
||||||
|
;; (fail 0))
|
||||||
|
;; (lambda (. t)
|
||||||
|
;; (display 'result:) (display t) (newline)
|
||||||
|
;; (set! pass (+ pass 1)))))
|
||||||
|
|
||||||
|
(display "OKAY\n")
|
||||||
|
|
||||||
|
(define-macro (or . x)
|
||||||
|
(if (null? x) #f
|
||||||
|
(if (null? (cdr x)) (car x)
|
||||||
|
(list 'if (car x) (car x)
|
||||||
|
(cons 'or (cdr x))))))
|
||||||
|
|
||||||
|
(define-macro (cond . clauses)
|
||||||
|
(list 'if (null? clauses) *unspecified*
|
||||||
|
(if (null? (cdr clauses))
|
||||||
|
(list 'if (car (car clauses))
|
||||||
|
(list (cons 'lambda (cons '() (cons (car (car clauses)) (cdr (car clauses))))))
|
||||||
|
*unspecified*)
|
||||||
|
(if (eq? (car (cadr clauses)) 'else)
|
||||||
|
(list 'if (car (car clauses))
|
||||||
|
(list (cons 'lambda (cons '() (car clauses))))
|
||||||
|
(list (cons 'lambda (cons '() (cons *unspecified* (cdr (cadr clauses)))))))
|
||||||
|
(list 'if (car (car clauses))
|
||||||
|
(list (cons 'lambda (cons '() (car clauses))))
|
||||||
|
(cons 'cond (cdr clauses)))))))
|
||||||
|
|
||||||
|
(define result
|
||||||
|
(let ((pass 0)
|
||||||
|
(fail 0))
|
||||||
|
(lambda (. t)
|
||||||
|
(display 'result:) (display t) (newline)
|
||||||
|
(set! pass (+ pass 1)))))
|
||||||
|
|
||||||
|
(define result
|
||||||
|
(let ((pass 0)
|
||||||
|
(fail 0))
|
||||||
|
(lambda (. t)
|
||||||
|
(cond ((or (null? t) (eq? (car t) result)) (list pass fail))
|
||||||
|
((eq? (car t) 'report)
|
||||||
|
(newline)
|
||||||
|
(display "passed: ") (display pass) (newline)
|
||||||
|
(display "failed: ") (display fail) (newline)
|
||||||
|
(display "total: ") (display (+ pass fail)) (newline)
|
||||||
|
;;(exit fail)
|
||||||
|
)
|
||||||
|
((car t)
|
||||||
|
#t
|
||||||
|
#t
|
||||||
|
#t
|
||||||
|
;;(blaat)
|
||||||
|
(display ": pass")
|
||||||
|
;;(newline)
|
||||||
|
;;(set! pass (+ pass 1))
|
||||||
|
#t
|
||||||
|
)
|
||||||
|
(#t (display ": fail") (newline) (set! fail (+ fail 1)))))))
|
||||||
|
|
||||||
|
(define-macro (pass-if name t)
|
||||||
|
(list
|
||||||
|
'begin
|
||||||
|
(list display ''xxxtest:) (list display name)
|
||||||
|
(list result t)))
|
||||||
|
|
||||||
|
(display 'foo-test:) (newline)
|
||||||
|
(display 1)(newline)
|
||||||
|
(display 2)(newline)
|
||||||
|
(display 3)(newline)
|
||||||
|
(display 4)(newline)
|
||||||
|
(display 5)(newline)
|
||||||
|
(display 6)(newline)
|
||||||
|
(display 7)(newline)
|
||||||
|
(display 8)(newline)
|
||||||
|
(display 9)(newline)
|
||||||
|
|
||||||
|
(pass-if "if" (eq? (if #t 'true) 'true))
|
||||||
|
(pass-if "if 2" (eq? (if #f #f) *unspecified*))
|
||||||
|
(pass-if "if 3" (eq? (if (eq? 0 '0) 'true 'false) 'true))
|
||||||
|
(pass-if "if 4" (eq? (if (= 1 2) 'true 'false) 'false))
|
||||||
|
|
||||||
|
(display 10)(newline)
|
||||||
|
(display 11)(newline)
|
||||||
|
(display 12)(newline)
|
||||||
|
(display 13)(newline)
|
||||||
|
(display 14)(newline)
|
||||||
|
(display 15)(newline)
|
||||||
|
(display 16)(newline)
|
||||||
|
(display 17)(newline)
|
||||||
|
(display 18)(newline)
|
||||||
|
(display 19)(newline)
|
||||||
|
|
||||||
|
(display 14)(newline)
|
||||||
|
(display 15)(newline)
|
||||||
|
(display 16)(newline)
|
||||||
|
(display 17)(newline)
|
||||||
|
(display 18)(newline)
|
||||||
|
(display 19)(newline)
|
||||||
|
|
||||||
|
(define (m x) (* 2 x))
|
||||||
|
(display 'multiply:)
|
||||||
|
(display (m 1)) (newline)
|
||||||
|
(display (m 2)) (newline)
|
||||||
|
(display (m 3)) (newline)
|
||||||
|
(display (m 4)) (newline)
|
||||||
|
|
||||||
|
;; (define (result r)
|
||||||
|
;; (display 'result:) (display r) (newline))
|
||||||
|
|
||||||
|
(define-macro (pass-if name t)
|
||||||
|
(list
|
||||||
|
'begin
|
||||||
|
(list display ''xxxtest:) (list display name)
|
||||||
|
(list result t)))
|
||||||
|
|
||||||
|
(pass-if 'first-dummy: #t)
|
||||||
|
|
||||||
|
(display 20)(newline)
|
||||||
|
(display 21)(newline)
|
||||||
|
(display 22)(newline)
|
||||||
|
(display 23)(newline)
|
||||||
|
(display 24)(newline)
|
||||||
|
(display 25)(newline)
|
||||||
|
(display 26)(newline)
|
||||||
|
(display 27)(newline)
|
||||||
|
(display 28)(newline)
|
||||||
|
(display 29)(newline)
|
||||||
|
(display 30)(newline)
|
||||||
|
|
||||||
|
(define *top-define-a* '*top-define-a*)
|
||||||
|
(display (eq? *top-define-a* '*top-define-a*))
|
||||||
|
(newline)
|
||||||
|
(begin (define *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
(display (eq? *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display 31)(newline)
|
||||||
|
(display 32)(newline)
|
||||||
|
(display 33)(newline)
|
||||||
|
(display 34)(newline)
|
||||||
|
(display 35)(newline)
|
||||||
|
(display 36)(newline)
|
||||||
|
(display 37)(newline)
|
||||||
|
(display 38)(newline)
|
||||||
|
(display 39)(newline)
|
||||||
|
(display 40)(newline)
|
||||||
|
|
||||||
|
;; (display 41)(newline)
|
||||||
|
;; (display 42)(newline)
|
||||||
|
;; (display 43)(newline)
|
||||||
|
;; (display 44)(newline)
|
||||||
|
;; (display 45)(newline)
|
||||||
|
;; (display 46)(newline)
|
||||||
|
;; (display 47)(newline)
|
||||||
|
;; (display 48)(newline)
|
||||||
|
;; (display 49)(newline)
|
||||||
|
;; (display 50)(newline)
|
||||||
|
;; (display 51)(newline)
|
||||||
|
;; (display 52)(newline)
|
||||||
|
;; (display 53)(newline)
|
||||||
|
;; (display 54)(newline)
|
||||||
|
;; (display 55)(newline)
|
||||||
|
;; (display 56)(newline)
|
||||||
|
;; (display 57)(newline)
|
||||||
|
;; (display 58)(newline)
|
||||||
|
;; (display 59)(newline)
|
||||||
|
;; (display 60)(newline)
|
||||||
|
;; (display 61)(newline)
|
||||||
|
;; (display 62)(newline)
|
||||||
|
;; (display 63)(newline)
|
||||||
|
;; (display 64)(newline)
|
||||||
|
;; (display 65)(newline)
|
||||||
|
;; (display 66)(newline)
|
||||||
|
;; (display 67)(newline)
|
||||||
|
;; (display 68)(newline)
|
||||||
|
;; (display 69)(newline)
|
||||||
|
;; (display 70)(newline)
|
||||||
|
;; (display 71)(newline)
|
||||||
|
;; (display 72)(newline)
|
||||||
|
;; (display 73)(newline)
|
||||||
|
;; (display 74)(newline)
|
||||||
|
;; (display 75)(newline)
|
||||||
|
;; (display 76)(newline)
|
||||||
|
;; (display 77)(newline)
|
||||||
|
;; (display 78)(newline)
|
||||||
|
;; (display 79)(newline)
|
||||||
|
;; (display 80)(newline)
|
||||||
|
;; (display 81)(newline)
|
||||||
|
;; (display 82)(newline)
|
||||||
|
;; (display 83)(newline)
|
||||||
|
;; (display 84)(newline)
|
||||||
|
;; (display 85)(newline)
|
||||||
|
;; (display 86)(newline)
|
||||||
|
;; (display 87)(newline)
|
||||||
|
;; (display 88)(newline)
|
||||||
|
;; (display 89)(newline)
|
||||||
|
;; (display 90)(newline)
|
||||||
|
;; (display 91)(newline)
|
||||||
|
;; (display 92)(newline)
|
||||||
|
;; (display 93)(newline)
|
||||||
|
;; (display 94)(newline)
|
||||||
|
;; (display 95)(newline)
|
||||||
|
;; (display 96)(newline)
|
||||||
|
;; (display 97)(newline)
|
||||||
|
;; (display 98)(newline)
|
||||||
|
;; (display 99)(newline)
|
||||||
|
;; (display 100)(newline)
|
||||||
|
;; (display 101)(newline)
|
||||||
|
;; (display 102)(newline)
|
||||||
|
;; (display 103)(newline)
|
||||||
|
;; (display 104)(newline)
|
||||||
|
;; (display 105)(newline)
|
||||||
|
;; (display 106)(newline)
|
||||||
|
;; (display 107)(newline)
|
||||||
|
;; (display 108)(newline)
|
||||||
|
;; (display 109)(newline)
|
||||||
|
;; (display 110)(newline)
|
||||||
|
;; (display 111)(newline)
|
||||||
|
;; (display 112)(newline)
|
||||||
|
;; (display 113)(newline)
|
||||||
|
;; (display 114)(newline)
|
||||||
|
;; (display 115)(newline)
|
||||||
|
;; (display 116)(newline)
|
||||||
|
;; (display 117)(newline)
|
||||||
|
;; (display 118)(newline)
|
||||||
|
;; (display 119)(newline)
|
||||||
|
;; (display 120)(newline)
|
||||||
|
;; (display 121)(newline)
|
||||||
|
;; (display 122)(newline)
|
||||||
|
;; (display 123)(newline)
|
||||||
|
;; (display 124)(newline)
|
||||||
|
;; (display 125)(newline)
|
||||||
|
;; (display 126)(newline)
|
||||||
|
;; (display 127)(newline)
|
||||||
|
;; (display 128)(newline)
|
||||||
|
;; (display 129)(newline)
|
||||||
|
;; (display 130)(newline)
|
||||||
|
;; (display 131)(newline)
|
||||||
|
;; (display 132)(newline)
|
||||||
|
;; (display 133)(newline)
|
||||||
|
;; (display 134)(newline)
|
||||||
|
;; (display 135)(newline)
|
||||||
|
;; (display 136)(newline)
|
||||||
|
;; (display 137)(newline)
|
||||||
|
;; (display 138)(newline)
|
||||||
|
;; (display 139)(newline)
|
||||||
|
;; (display 140)(newline)
|
||||||
|
;; (display 141)(newline)
|
||||||
|
;; (display 142)(newline)
|
||||||
|
;; (display 143)(newline)
|
||||||
|
;; (display 144)(newline)
|
||||||
|
;; (display 145)(newline)
|
||||||
|
;; (display 146)(newline)
|
||||||
|
;; (display 147)(newline)
|
||||||
|
;; (display 148)(newline)
|
||||||
|
;; (display 149)(newline)
|
||||||
|
;; (display 150)(newline)
|
||||||
|
;; (display 151)(newline)
|
||||||
|
;; (display 152)(newline)
|
||||||
|
;; (display 153)(newline)
|
||||||
|
;; (display 154)(newline)
|
||||||
|
;; (display 155)(newline)
|
||||||
|
;; (display 156)(newline)
|
||||||
|
;; (display 157)(newline)
|
||||||
|
;; (display 158)(newline)
|
||||||
|
;; (display 159)(newline)
|
||||||
|
;; (display 160)(newline)
|
||||||
|
;; (display 161)(newline)
|
||||||
|
;; (display 162)(newline)
|
||||||
|
;; (display 163)(newline)
|
||||||
|
;; (display 164)(newline)
|
||||||
|
;; (display 165)(newline)
|
||||||
|
;; (display 166)(newline)
|
||||||
|
;; (display 167)(newline)
|
||||||
|
;; (display 168)(newline)
|
||||||
|
;; (display 169)(newline)
|
||||||
|
;; (display 170)(newline)
|
||||||
|
;; (display 171)(newline)
|
||||||
|
;; (display 172)(newline)
|
||||||
|
;; (display 173)(newline)
|
||||||
|
;; (display 174)(newline)
|
||||||
|
;; (display 175)(newline)
|
||||||
|
;; (display 176)(newline)
|
||||||
|
;; (display 177)(newline)
|
||||||
|
;; (display 178)(newline)
|
||||||
|
;; (display 179)(newline)
|
||||||
|
;; (display 180)(newline)
|
||||||
|
;; (display 181)(newline)
|
||||||
|
;; (display 182)(newline)
|
||||||
|
;; (display 183)(newline)
|
||||||
|
;; (display 184)(newline)
|
||||||
|
;; (display 185)(newline)
|
||||||
|
;; (display 186)(newline)
|
||||||
|
;; (display 187)(newline)
|
||||||
|
;; (display 188)(newline)
|
||||||
|
;; (display 189)(newline)
|
||||||
|
;; (display 190)(newline)
|
||||||
|
;; (display 191)(newline)
|
||||||
|
;; (display 192)(newline)
|
||||||
|
;; (display 193)(newline)
|
||||||
|
;; (display 194)(newline)
|
||||||
|
;; (display 195)(newline)
|
||||||
|
;; (display 196)(newline)
|
||||||
|
;; (display 197)(newline)
|
||||||
|
;; (display 198)(newline)
|
||||||
|
;; (display 199)(newline)
|
||||||
|
;; (display 200)(newline)
|
||||||
324
tests/gc-2a.test
Executable file
324
tests/gc-2a.test
Executable file
|
|
@ -0,0 +1,324 @@
|
||||||
|
#! /bin/sh
|
||||||
|
# -*-scheme-*-
|
||||||
|
set -x
|
||||||
|
echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
|
||||||
|
#paredit:||
|
||||||
|
exit $?
|
||||||
|
!#
|
||||||
|
|
||||||
|
;;; -*-scheme-*-
|
||||||
|
|
||||||
|
;;; Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of Mes.
|
||||||
|
;;;
|
||||||
|
;;; Mes is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Mes is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;; (cons 0 1)
|
||||||
|
;; (display 1)(newline)
|
||||||
|
|
||||||
|
(define (blup?)
|
||||||
|
#t)
|
||||||
|
(blup?)
|
||||||
|
|
||||||
|
(define a 'a)
|
||||||
|
(display a)
|
||||||
|
(display 2)(newline)
|
||||||
|
(display 3)(newline)
|
||||||
|
(display 4)(newline)
|
||||||
|
(display 5)(newline)
|
||||||
|
(display 6)(newline)
|
||||||
|
(display 7)(newline)
|
||||||
|
(display 8)(newline)
|
||||||
|
(display 9)(newline)
|
||||||
|
|
||||||
|
(define *top-define-a* '*top-define-a*)
|
||||||
|
(display (eq? *top-define-a* '*top-define-a*))
|
||||||
|
(newline)
|
||||||
|
(begin (define *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
(display (eq? *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(define (blup?) #t)
|
||||||
|
(display 'HALLO) (newline)
|
||||||
|
(blup?)
|
||||||
|
(define *top-define-a* '*top-define-a*)
|
||||||
|
(define *top-define-b* '*top-define-b*)
|
||||||
|
(display (eq? *top-define-a* '*top-define-a*))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display 'HALLO2) (newline)
|
||||||
|
|
||||||
|
(define (bla? x y) (eq? x y))
|
||||||
|
|
||||||
|
(begin (define *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
(display (eq? *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
(newline)
|
||||||
|
|
||||||
|
(display 'HALLO3) (newline)
|
||||||
|
|
||||||
|
(display "OKAY\n")
|
||||||
|
|
||||||
|
(define (m x) (* 2 x))
|
||||||
|
(display 'multiply:)
|
||||||
|
(display (m 1)) (newline)
|
||||||
|
(display (m 2)) (newline)
|
||||||
|
(display (m 3)) (newline)
|
||||||
|
(display (m 4)) (newline)
|
||||||
|
|
||||||
|
(define (result r)
|
||||||
|
(display 'result:) (display r) (newline))
|
||||||
|
|
||||||
|
(define-macro (pass-if name t)
|
||||||
|
(list
|
||||||
|
'begin
|
||||||
|
(list display ''xxxtest:) (list display name)
|
||||||
|
(list result t)))
|
||||||
|
|
||||||
|
(display 'foo-test:) (newline)
|
||||||
|
(display 1)(newline)
|
||||||
|
(display 2)(newline)
|
||||||
|
(display 3)(newline)
|
||||||
|
(display 4)(newline)
|
||||||
|
(display 5)(newline)
|
||||||
|
(display 6)(newline)
|
||||||
|
(display 7)(newline)
|
||||||
|
(display 8)(newline)
|
||||||
|
(display 9)(newline)
|
||||||
|
|
||||||
|
(pass-if "if" (eq? (if #t 'true) 'true))
|
||||||
|
(pass-if "if 2" (eq? (if #f #f) *unspecified*))
|
||||||
|
(pass-if "if 3" (eq? (if (eq? 0 '0) 'true 'false) 'true))
|
||||||
|
(pass-if "if 4" (eq? (if (= 1 2) 'true 'false) 'false))
|
||||||
|
|
||||||
|
;; (display 10)(newline)
|
||||||
|
;; (display 11)(newline)
|
||||||
|
;; (display 12)(newline)
|
||||||
|
;; (display 13)(newline)
|
||||||
|
;; (display 14)(newline)
|
||||||
|
;; (display 15)(newline)
|
||||||
|
;; (display 16)(newline)
|
||||||
|
;; (display 17)(newline)
|
||||||
|
;; (display 18)(newline)
|
||||||
|
;; (display 19)(newline)
|
||||||
|
|
||||||
|
;; (display 14)(newline)
|
||||||
|
;; (display 15)(newline)
|
||||||
|
;; (display 16)(newline)
|
||||||
|
;; (display 17)(newline)
|
||||||
|
;; (display 18)(newline)
|
||||||
|
;; (display 19)(newline)
|
||||||
|
|
||||||
|
;; (define (result r)
|
||||||
|
;; (display 'result:) (display r) (newline))
|
||||||
|
|
||||||
|
;; (define-macro (pass-if name t)
|
||||||
|
;; (list
|
||||||
|
;; 'begin
|
||||||
|
;; (list display ''xxxtest:) (list display name)
|
||||||
|
;; (list result t)))
|
||||||
|
|
||||||
|
;; (pass-if 'first-dummy: #t)
|
||||||
|
|
||||||
|
;; (display 20)(newline)
|
||||||
|
;; (display 21)(newline)
|
||||||
|
;; (display 22)(newline)
|
||||||
|
;; (display 23)(newline)
|
||||||
|
;; (display 24)(newline)
|
||||||
|
;; (display 25)(newline)
|
||||||
|
;; (display 26)(newline)
|
||||||
|
;; (display 27)(newline)
|
||||||
|
;; (display 28)(newline)
|
||||||
|
;; (display 29)(newline)
|
||||||
|
;; (display 30)(newline)
|
||||||
|
|
||||||
|
;; (define *top-define-a* '*top-define-a*)
|
||||||
|
;; (display (eq? *top-define-a* '*top-define-a*))
|
||||||
|
;; (newline)
|
||||||
|
;; (begin (define *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
;; (display (eq? *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
;; (newline)
|
||||||
|
|
||||||
|
;; (display 31)(newline)
|
||||||
|
;; (display 32)(newline)
|
||||||
|
;; (display 33)(newline)
|
||||||
|
;; (display 34)(newline)
|
||||||
|
;; (display 35)(newline)
|
||||||
|
;; (display 36)(newline)
|
||||||
|
;; (display 37)(newline)
|
||||||
|
;; (display 38)(newline)
|
||||||
|
;; (display 39)(newline)
|
||||||
|
;; (display 40)(newline)
|
||||||
|
|
||||||
|
;; (display 41)(newline)
|
||||||
|
;; (display 42)(newline)
|
||||||
|
;; (display 43)(newline)
|
||||||
|
;; (display 44)(newline)
|
||||||
|
;; (display 45)(newline)
|
||||||
|
;; (display 46)(newline)
|
||||||
|
;; (display 47)(newline)
|
||||||
|
;; (display 48)(newline)
|
||||||
|
;; (display 49)(newline)
|
||||||
|
;; (display 50)(newline)
|
||||||
|
;; (display 51)(newline)
|
||||||
|
;; (display 52)(newline)
|
||||||
|
;; (display 53)(newline)
|
||||||
|
;; (display 54)(newline)
|
||||||
|
;; (display 55)(newline)
|
||||||
|
;; (display 56)(newline)
|
||||||
|
;; (display 57)(newline)
|
||||||
|
;; (display 58)(newline)
|
||||||
|
;; (display 59)(newline)
|
||||||
|
;; (display 60)(newline)
|
||||||
|
;; (display 61)(newline)
|
||||||
|
;; (display 62)(newline)
|
||||||
|
;; (display 63)(newline)
|
||||||
|
;; (display 64)(newline)
|
||||||
|
;; (display 65)(newline)
|
||||||
|
;; (display 66)(newline)
|
||||||
|
;; (display 67)(newline)
|
||||||
|
;; (display 68)(newline)
|
||||||
|
;; (display 69)(newline)
|
||||||
|
;; (display 70)(newline)
|
||||||
|
;; (display 71)(newline)
|
||||||
|
;; (display 72)(newline)
|
||||||
|
;; (display 73)(newline)
|
||||||
|
;; (display 74)(newline)
|
||||||
|
;; (display 75)(newline)
|
||||||
|
;; (display 76)(newline)
|
||||||
|
;; (display 77)(newline)
|
||||||
|
;; (display 78)(newline)
|
||||||
|
;; (display 79)(newline)
|
||||||
|
;; (display 80)(newline)
|
||||||
|
;; (display 81)(newline)
|
||||||
|
;; (display 82)(newline)
|
||||||
|
;; (display 83)(newline)
|
||||||
|
;; (display 84)(newline)
|
||||||
|
;; (display 85)(newline)
|
||||||
|
;; (display 86)(newline)
|
||||||
|
;; (display 87)(newline)
|
||||||
|
;; (display 88)(newline)
|
||||||
|
;; (display 89)(newline)
|
||||||
|
;; (display 90)(newline)
|
||||||
|
;; (display 91)(newline)
|
||||||
|
;; (display 92)(newline)
|
||||||
|
;; (display 93)(newline)
|
||||||
|
;; (display 94)(newline)
|
||||||
|
;; (display 95)(newline)
|
||||||
|
;; (display 96)(newline)
|
||||||
|
;; (display 97)(newline)
|
||||||
|
;; (display 98)(newline)
|
||||||
|
;; (display 99)(newline)
|
||||||
|
;; (display 100)(newline)
|
||||||
|
;; (display 101)(newline)
|
||||||
|
;; (display 102)(newline)
|
||||||
|
;; (display 103)(newline)
|
||||||
|
;; (display 104)(newline)
|
||||||
|
;; (display 105)(newline)
|
||||||
|
;; (display 106)(newline)
|
||||||
|
;; (display 107)(newline)
|
||||||
|
;; (display 108)(newline)
|
||||||
|
;; (display 109)(newline)
|
||||||
|
;; (display 110)(newline)
|
||||||
|
;; (display 111)(newline)
|
||||||
|
;; (display 112)(newline)
|
||||||
|
;; (display 113)(newline)
|
||||||
|
;; (display 114)(newline)
|
||||||
|
;; (display 115)(newline)
|
||||||
|
;; (display 116)(newline)
|
||||||
|
;; (display 117)(newline)
|
||||||
|
;; (display 118)(newline)
|
||||||
|
;; (display 119)(newline)
|
||||||
|
;; (display 120)(newline)
|
||||||
|
;; (display 121)(newline)
|
||||||
|
;; (display 122)(newline)
|
||||||
|
;; (display 123)(newline)
|
||||||
|
;; (display 124)(newline)
|
||||||
|
;; (display 125)(newline)
|
||||||
|
;; (display 126)(newline)
|
||||||
|
;; (display 127)(newline)
|
||||||
|
;; (display 128)(newline)
|
||||||
|
;; (display 129)(newline)
|
||||||
|
;; (display 130)(newline)
|
||||||
|
;; (display 131)(newline)
|
||||||
|
;; (display 132)(newline)
|
||||||
|
;; (display 133)(newline)
|
||||||
|
;; (display 134)(newline)
|
||||||
|
;; (display 135)(newline)
|
||||||
|
;; (display 136)(newline)
|
||||||
|
;; (display 137)(newline)
|
||||||
|
;; (display 138)(newline)
|
||||||
|
;; (display 139)(newline)
|
||||||
|
;; (display 140)(newline)
|
||||||
|
;; (display 141)(newline)
|
||||||
|
;; (display 142)(newline)
|
||||||
|
;; (display 143)(newline)
|
||||||
|
;; (display 144)(newline)
|
||||||
|
;; (display 145)(newline)
|
||||||
|
;; (display 146)(newline)
|
||||||
|
;; (display 147)(newline)
|
||||||
|
;; (display 148)(newline)
|
||||||
|
;; (display 149)(newline)
|
||||||
|
;; (display 150)(newline)
|
||||||
|
;; (display 151)(newline)
|
||||||
|
;; (display 152)(newline)
|
||||||
|
;; (display 153)(newline)
|
||||||
|
;; (display 154)(newline)
|
||||||
|
;; (display 155)(newline)
|
||||||
|
;; (display 156)(newline)
|
||||||
|
;; (display 157)(newline)
|
||||||
|
;; (display 158)(newline)
|
||||||
|
;; (display 159)(newline)
|
||||||
|
;; (display 160)(newline)
|
||||||
|
;; (display 161)(newline)
|
||||||
|
;; (display 162)(newline)
|
||||||
|
;; (display 163)(newline)
|
||||||
|
;; (display 164)(newline)
|
||||||
|
;; (display 165)(newline)
|
||||||
|
;; (display 166)(newline)
|
||||||
|
;; (display 167)(newline)
|
||||||
|
;; (display 168)(newline)
|
||||||
|
;; (display 169)(newline)
|
||||||
|
;; (display 170)(newline)
|
||||||
|
;; (display 171)(newline)
|
||||||
|
;; (display 172)(newline)
|
||||||
|
;; (display 173)(newline)
|
||||||
|
;; (display 174)(newline)
|
||||||
|
;; (display 175)(newline)
|
||||||
|
;; (display 176)(newline)
|
||||||
|
;; (display 177)(newline)
|
||||||
|
;; (display 178)(newline)
|
||||||
|
;; (display 179)(newline)
|
||||||
|
;; (display 180)(newline)
|
||||||
|
;; (display 181)(newline)
|
||||||
|
;; (display 182)(newline)
|
||||||
|
;; (display 183)(newline)
|
||||||
|
;; (display 184)(newline)
|
||||||
|
;; (display 185)(newline)
|
||||||
|
;; (display 186)(newline)
|
||||||
|
;; (display 187)(newline)
|
||||||
|
;; (display 188)(newline)
|
||||||
|
;; (display 189)(newline)
|
||||||
|
;; (display 190)(newline)
|
||||||
|
;; (display 191)(newline)
|
||||||
|
;; (display 192)(newline)
|
||||||
|
;; (display 193)(newline)
|
||||||
|
;; (display 194)(newline)
|
||||||
|
;; (display 195)(newline)
|
||||||
|
;; (display 196)(newline)
|
||||||
|
;; (display 197)(newline)
|
||||||
|
;; (display 198)(newline)
|
||||||
|
;; (display 199)(newline)
|
||||||
|
;; (display 200)(newline)
|
||||||
241
tests/gc-3.test
Executable file
241
tests/gc-3.test
Executable file
|
|
@ -0,0 +1,241 @@
|
||||||
|
#! /bin/sh
|
||||||
|
# -*-scheme-*-
|
||||||
|
set -x
|
||||||
|
echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
|
||||||
|
#paredit:||
|
||||||
|
exit $?
|
||||||
|
!#
|
||||||
|
|
||||||
|
;;; -*-scheme-*-
|
||||||
|
|
||||||
|
;;; Mes --- Maxwell Equations of Software
|
||||||
|
;;; Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||||
|
;;;
|
||||||
|
;;; This file is part of Mes.
|
||||||
|
;;;
|
||||||
|
;;; Mes is free software; you can redistribute it and/or modify it
|
||||||
|
;;; under the terms of the GNU General Public License as published by
|
||||||
|
;;; the Free Software Foundation; either version 3 of the License, or (at
|
||||||
|
;;; your option) any later version.
|
||||||
|
;;;
|
||||||
|
;;; Mes is distributed in the hope that it will be useful, but
|
||||||
|
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;;; GNU General Public License for more details.
|
||||||
|
;;;
|
||||||
|
;;; You should have received a copy of the GNU General Public License
|
||||||
|
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
;; (define *top-define-a* '*top-define-a*)
|
||||||
|
;; (display (eq? *top-define-a* '*top-define-a*))
|
||||||
|
;; (newline)
|
||||||
|
;; (begin (define *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
;; (display (eq? *top-begin-define-a* '*top-begin-define-a*))
|
||||||
|
;; (newline)
|
||||||
|
|
||||||
|
(display 'HALLO) (newline)
|
||||||
|
(display 'foo-test:) (newline)
|
||||||
|
(display 1)(newline)
|
||||||
|
(display 2)(newline)
|
||||||
|
(display 3)(newline)
|
||||||
|
(display 4)(newline)
|
||||||
|
(display 5)(newline)
|
||||||
|
(display 6)(newline)
|
||||||
|
(display 7)(newline)
|
||||||
|
(display 8)(newline)
|
||||||
|
(display 9)(newline)
|
||||||
|
|
||||||
|
(display 10)(newline)
|
||||||
|
(display 11)(newline)
|
||||||
|
(display 12)(newline)
|
||||||
|
(display 13)(newline)
|
||||||
|
(display 14)(newline)
|
||||||
|
(display 15)(newline)
|
||||||
|
(display 16)(newline)
|
||||||
|
(display 17)(newline)
|
||||||
|
(display 18)(newline)
|
||||||
|
(display 19)(newline)
|
||||||
|
|
||||||
|
(display 20)(newline)
|
||||||
|
(display 21)(newline)
|
||||||
|
(display 22)(newline)
|
||||||
|
(display 23)(newline)
|
||||||
|
(display 24)(newline)
|
||||||
|
(display 25)(newline)
|
||||||
|
(display 26)(newline)
|
||||||
|
(display 27)(newline)
|
||||||
|
(display 28)(newline)
|
||||||
|
(display 29)(newline)
|
||||||
|
(display 30)(newline)
|
||||||
|
|
||||||
|
(display 31)(newline)
|
||||||
|
(display 32)(newline)
|
||||||
|
(display 33)(newline)
|
||||||
|
(display 34)(newline)
|
||||||
|
(display 35)(newline)
|
||||||
|
(display 36)(newline)
|
||||||
|
(display 37)(newline)
|
||||||
|
(display 38)(newline)
|
||||||
|
(display 39)(newline)
|
||||||
|
(display 40)(newline)
|
||||||
|
|
||||||
|
;; (display 41)(newline)
|
||||||
|
;; (display 42)(newline)
|
||||||
|
;; (display 43)(newline)
|
||||||
|
;; (display 44)(newline)
|
||||||
|
;; (display 45)(newline)
|
||||||
|
;; (display 46)(newline)
|
||||||
|
;; (display 47)(newline)
|
||||||
|
;; (display 48)(newline)
|
||||||
|
;; (display 49)(newline)
|
||||||
|
;; (display 50)(newline)
|
||||||
|
;; (display 51)(newline)
|
||||||
|
;; (display 52)(newline)
|
||||||
|
;; (display 53)(newline)
|
||||||
|
;; (display 54)(newline)
|
||||||
|
;; (display 55)(newline)
|
||||||
|
;; (display 56)(newline)
|
||||||
|
;; (display 57)(newline)
|
||||||
|
;; (display 58)(newline)
|
||||||
|
;; (display 59)(newline)
|
||||||
|
;; (display 60)(newline)
|
||||||
|
;; (display 61)(newline)
|
||||||
|
;; (display 62)(newline)
|
||||||
|
;; (display 63)(newline)
|
||||||
|
;; (display 64)(newline)
|
||||||
|
;; (display 65)(newline)
|
||||||
|
;; (display 66)(newline)
|
||||||
|
;; (display 67)(newline)
|
||||||
|
;; (display 68)(newline)
|
||||||
|
;; (display 69)(newline)
|
||||||
|
;; (display 70)(newline)
|
||||||
|
;; (display 71)(newline)
|
||||||
|
;; (display 72)(newline)
|
||||||
|
;; (display 73)(newline)
|
||||||
|
;; (display 74)(newline)
|
||||||
|
;; (display 75)(newline)
|
||||||
|
;; (display 76)(newline)
|
||||||
|
;; (display 77)(newline)
|
||||||
|
;; (display 78)(newline)
|
||||||
|
;; (display 79)(newline)
|
||||||
|
;; (display 80)(newline)
|
||||||
|
;; (display 81)(newline)
|
||||||
|
;; (display 82)(newline)
|
||||||
|
;; (display 83)(newline)
|
||||||
|
;; (display 84)(newline)
|
||||||
|
;; (display 85)(newline)
|
||||||
|
;; (display 86)(newline)
|
||||||
|
;; (display 87)(newline)
|
||||||
|
;; (display 88)(newline)
|
||||||
|
;; (display 89)(newline)
|
||||||
|
;; (display 90)(newline)
|
||||||
|
;; (display 91)(newline)
|
||||||
|
;; (display 92)(newline)
|
||||||
|
;; (display 93)(newline)
|
||||||
|
;; (display 94)(newline)
|
||||||
|
;; (display 95)(newline)
|
||||||
|
;; (display 96)(newline)
|
||||||
|
;; (display 97)(newline)
|
||||||
|
;; (display 98)(newline)
|
||||||
|
;; (display 99)(newline)
|
||||||
|
;; (display 100)(newline)
|
||||||
|
;; (display 101)(newline)
|
||||||
|
;; (display 102)(newline)
|
||||||
|
;; (display 103)(newline)
|
||||||
|
;; (display 104)(newline)
|
||||||
|
;; (display 105)(newline)
|
||||||
|
;; (display 106)(newline)
|
||||||
|
;; (display 107)(newline)
|
||||||
|
;; (display 108)(newline)
|
||||||
|
;; (display 109)(newline)
|
||||||
|
;; (display 110)(newline)
|
||||||
|
;; (display 111)(newline)
|
||||||
|
;; (display 112)(newline)
|
||||||
|
;; (display 113)(newline)
|
||||||
|
;; (display 114)(newline)
|
||||||
|
;; (display 115)(newline)
|
||||||
|
;; (display 116)(newline)
|
||||||
|
;; (display 117)(newline)
|
||||||
|
;; (display 118)(newline)
|
||||||
|
;; (display 119)(newline)
|
||||||
|
;; (display 120)(newline)
|
||||||
|
;; (display 121)(newline)
|
||||||
|
;; (display 122)(newline)
|
||||||
|
;; (display 123)(newline)
|
||||||
|
;; (display 124)(newline)
|
||||||
|
;; (display 125)(newline)
|
||||||
|
;; (display 126)(newline)
|
||||||
|
;; (display 127)(newline)
|
||||||
|
;; (display 128)(newline)
|
||||||
|
;; (display 129)(newline)
|
||||||
|
;; (display 130)(newline)
|
||||||
|
;; (display 131)(newline)
|
||||||
|
;; (display 132)(newline)
|
||||||
|
;; (display 133)(newline)
|
||||||
|
;; (display 134)(newline)
|
||||||
|
;; (display 135)(newline)
|
||||||
|
;; (display 136)(newline)
|
||||||
|
;; (display 137)(newline)
|
||||||
|
;; (display 138)(newline)
|
||||||
|
;; (display 139)(newline)
|
||||||
|
;; (display 140)(newline)
|
||||||
|
;; (display 141)(newline)
|
||||||
|
;; (display 142)(newline)
|
||||||
|
;; (display 143)(newline)
|
||||||
|
;; (display 144)(newline)
|
||||||
|
;; (display 145)(newline)
|
||||||
|
;; (display 146)(newline)
|
||||||
|
;; (display 147)(newline)
|
||||||
|
;; (display 148)(newline)
|
||||||
|
;; (display 149)(newline)
|
||||||
|
;; (display 150)(newline)
|
||||||
|
;; (display 151)(newline)
|
||||||
|
;; (display 152)(newline)
|
||||||
|
;; (display 153)(newline)
|
||||||
|
;; (display 154)(newline)
|
||||||
|
;; (display 155)(newline)
|
||||||
|
;; (display 156)(newline)
|
||||||
|
;; (display 157)(newline)
|
||||||
|
;; (display 158)(newline)
|
||||||
|
;; (display 159)(newline)
|
||||||
|
;; (display 160)(newline)
|
||||||
|
;; (display 161)(newline)
|
||||||
|
;; (display 162)(newline)
|
||||||
|
;; (display 163)(newline)
|
||||||
|
;; (display 164)(newline)
|
||||||
|
;; (display 165)(newline)
|
||||||
|
;; (display 166)(newline)
|
||||||
|
;; (display 167)(newline)
|
||||||
|
;; (display 168)(newline)
|
||||||
|
;; (display 169)(newline)
|
||||||
|
;; (display 170)(newline)
|
||||||
|
;; (display 171)(newline)
|
||||||
|
;; (display 172)(newline)
|
||||||
|
;; (display 173)(newline)
|
||||||
|
;; (display 174)(newline)
|
||||||
|
;; (display 175)(newline)
|
||||||
|
;; (display 176)(newline)
|
||||||
|
;; (display 177)(newline)
|
||||||
|
;; (display 178)(newline)
|
||||||
|
;; (display 179)(newline)
|
||||||
|
;; (display 180)(newline)
|
||||||
|
;; (display 181)(newline)
|
||||||
|
;; (display 182)(newline)
|
||||||
|
;; (display 183)(newline)
|
||||||
|
;; (display 184)(newline)
|
||||||
|
;; (display 185)(newline)
|
||||||
|
;; (display 186)(newline)
|
||||||
|
;; (display 187)(newline)
|
||||||
|
;; (display 188)(newline)
|
||||||
|
;; (display 189)(newline)
|
||||||
|
;; (display 190)(newline)
|
||||||
|
;; (display 191)(newline)
|
||||||
|
;; (display 192)(newline)
|
||||||
|
;; (display 193)(newline)
|
||||||
|
;; (display 194)(newline)
|
||||||
|
;; (display 195)(newline)
|
||||||
|
;; (display 196)(newline)
|
||||||
|
;; (display 197)(newline)
|
||||||
|
;; (display 198)(newline)
|
||||||
|
;; (display 199)(newline)
|
||||||
|
;; (display 200)(newline)
|
||||||
Loading…
Reference in a new issue