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 2016-10-28 18:42:03 +02:00
parent c035a59094
commit 25c29ecb6d
9 changed files with 1294 additions and 174 deletions

View File

@ -20,33 +20,41 @@
#if !BOOT
scm *
define_env (scm *x, scm *a)
define_env (scm *e, scm *a)
{
scm *e;
scm *name = cadr (x);
return vm_call (vm_define_env, e, &scm_undefined, a);
}
scm *
vm_define_env ()
{
scm *x;
scm *name = cadr (r1);
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 {
name = car (name);
scm *p = pairlis (cadr (x), cadr (x), a);
cache_invalidate_range (p, a);
e = eval_env (make_lambda (cdadr (x), cddr (x)), p);
scm *p = pairlis (cadr (r1), cadr (r1), r0);
cache_invalidate_range (p, r0);
x = eval_env (make_lambda (cdadr (r1), cddr (r1)), p);
}
if (eq_p (car (x), &symbol_define_macro) == &scm_t)
e = make_macro (name, e);
scm *entry = cons (name, e);
if (eq_p (car (r1), &symbol_define_macro) == &scm_t)
x = make_macro (name, x);
scm *entry = cons (name, x);
scm *aa = cons (entry, &scm_nil);
set_cdr_x (aa, cdr (a));
set_cdr_x (a, aa);
scm *cl = assq (&scm_closure, a);
set_cdr_x (aa, cdr (r0));
set_cdr_x (r0, aa);
scm *cl = assq (&scm_closure, r0);
set_cdr_x (cl, aa);
return entry;
}
#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
scm *
define_macro (scm *x, scm *a)
define_macro (scm *r1, scm *a)
{
}

1
lib.c
View File

@ -29,6 +29,7 @@ scm *cdadr (scm *x) {return cdr (car (cdr (x)));}
scm *cadar (scm *x) {return car (cdr (car (x)));}
scm *cddar (scm *x) {return cdr (cdr (car (x)));}
scm *cdddr (scm *x) {return cdr (cdr (cdr (x)));}
scm *cadddr (scm *x) {return car (cdr (cdr (cdr (x))));}
scm *
length (scm *x)

465
mes.c
View File

@ -30,19 +30,29 @@
#define DEBUG 0
#define QUASIQUOTE 1
//#define QUASISYNTAX 0
#define GC 1
#if GC // call gc from builtin_eval () -- dumps core
//int ARENA_SIZE = 1024 * 1024 * 1024;
/* 28000 cells triggers a gc for mes-check just afre passing the first test */
int ARENA_SIZE = 28000; // sizeof(scm) = 24
#define MES_FULL 1
#define MES_MINI 0 // 1 for gc-2a.test, gc-3.test
#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;
#else // testing
int ARENA_SIZE = 11;
int GC_SAFETY = 0;
int GC_FREE = 1000;
#endif
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* (*function1_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_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_dot = {SCM, "."};
scm scm_f = {SCM, "#f"};
@ -102,7 +119,7 @@ scm scm_circular = {SCM, "*circular*"};
scm scm_label = {
SCM, "label"};
#endif
scm scm_begin = {SCM, "begin"};
scm scm_begin = {SCM, "*begin*"};
scm symbol_lambda = {SYMBOL, "lambda"};
scm symbol_begin = {SYMBOL, "begin"};
@ -162,8 +179,6 @@ scm *
alloc (int n)
{
#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);
scm* x = &g_cells[g_free.value];
g_free.value += n;
@ -185,33 +200,36 @@ gc_alloc (int n)
scm *
gc (scm *a)
{
fprintf (stderr, "***GC***\n");
fprintf (stderr, "***gc[%d]...", g_free.value);
g_free.value = 0;
//gc_show ();
scm *new = gc_copy (a);
scm *new = gc_copy (stack);
gc_copy (symbols);
return gc_loop (new);
}
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 (new->type == PAIR
|| new->type == REF
|| new->type == STRING
|| new->type == SYMBOL)
if (scan->type == MACRO
|| scan->type == PAIR
|| scan->type == REF
|| (scan->type == SCM && scan->car->type == PAIR)
|| (scan->type == STRING && scan->car->type == PAIR)
|| (scan->type == SYMBOL && scan->car->type == PAIR))
{
scm *car = gc_copy (new->car);
gc_relocate_car (new, car);
scm *car = gc_copy (scan->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);
gc_relocate_cdr (new, cdr);
scm *cdr = gc_copy (scan->cdr);
gc_relocate_cdr (scan, cdr);
}
new++;
scan++;
}
return gc_flip ();
}
@ -220,7 +238,9 @@ scm *
gc_copy (scm *old)
{
if (old->type == BROKEN_HEART) return old->car;
if (old->type == FUNCTION) return old;
if (old->type == SCM) return old;
if (old < g_cells && old < g_news) return old;
scm *new = &g_news[g_free.value++];
*new = *old;
if (new->type == VECTOR)
@ -231,12 +251,6 @@ gc_copy (scm *old)
return new;
}
scm *
gc_move (scm* dest, scm *src)
{
*dest = *src;
}
scm *
gc_relocate_car (scm *new, scm *car)
{
@ -259,6 +273,24 @@ gc_flip ()
g_news = cells;
(g_cells-1)->vector = g_news;
(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;
}
@ -391,7 +423,12 @@ pairlis (scm *x, scm *y, scm *a)
scm *
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;
}
@ -501,48 +538,145 @@ assert_defined (scm *x, scm *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 *
evlis_env (scm *m, scm *a)
{
if (m == &scm_nil) return &scm_nil;
if (m->type != PAIR) return eval_env (m, a);
scm *e = eval_env (car (m), a);
return cons (e, evlis_env (cdr (m), a));
return vm_call (vm_evlis_env, m, &scm_undefined, a);
}
scm *
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)
{
return vm_call (vm_eval_env, e, &scm_undefined, a);
}
scm *
expand_macro_env (scm *e, scm *a)
{
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;
}
scm *
vm_evlis_env ()
{
if (r1 == &scm_nil) return &scm_nil;
if (r1->type != PAIR) return eval_env (r1, r0);
r2 = eval_env (car (r1), r0);
r1 = evlis_env (cdr (r1), r0);
return cons (r2, r1);
}
scm *
vm_call_lambda ()
{
return vm_call (vm_begin_env, r1, &scm_undefined, r0);
}
scm *
vm_apply_env ()
{
if (r1->type != PAIR)
{
if (fn->type == FUNCTION) return call (fn, x);
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;
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 (fn->car == &symbol_lambda) {
scm *p = pairlis (cadr (fn), x, a);
cache_invalidate_range (p, a->cdr);
scm *r = begin_env (cddr (fn), cons (cons (&scm_closure, p), p));
cache_invalidate_range (p, a->cdr);
return r;
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 (fn->car == &scm_closure) {
scm *args = caddr (fn);
scm *body = cdddr (fn);
a = cdadr (fn);
a = cdr (a);
scm *p = pairlis (args, x, a);
cache_invalidate_range (p, a->cdr);
scm *r = begin_env (body, cons (cons (&scm_closure, p), p));
cache_invalidate_range (p, a->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
else if (fn->car == &scm_label)
return apply_env (caddr (fn), x, cons (cons (cadr (fn), caddr (fn)), a));
else if (r1->car == &scm_label)
return apply_env (caddr (r1), r2, cons (cons (cadr (r1), caddr (r1)), r0));
#endif
scm *e = eval_env (fn, a);
scm *e = eval_env (r1, r0);
char const* type = 0;
if (e == &scm_f || e == &scm_t) type = "bool";
if (e->type == CHAR) type = "char";
@ -554,122 +688,129 @@ apply_env (scm *fn, scm *x, scm *a)
{
fprintf (stderr, "cannot apply: %s: ", type);
display_ (stderr, e);
fprintf (stderr, " (");
display_ (stderr, fn);
fprintf (stderr, ")\n");
fprintf (stderr, " [");
display_ (stderr, r1);
fprintf (stderr, "]\n");
assert (!"cannot apply");
}
return apply_env (e, x, a);
return apply_env (e, r2, r0);
}
scm*cstring_to_list (char const* s);
scm *
eval_env (scm *e, scm *a)
vm_eval_env ()
{
#if GC
if (g_free.value + GC_SAFETY > ARENA_SIZE) gc (a);
#endif
switch (e->type)
switch (r1->type)
{
case PAIR:
{
if (e->car == &symbol_quote)
return cadr (e);
if (r1->car == &symbol_quote)
return cadr (r1);
#if QUASISYNTAX
if (e->car == &symbol_syntax)
return e;
if (r1->car == &symbol_syntax)
return r1;
#endif
if (e->car == &symbol_begin)
return begin_env (e, a);
if (e->car == &symbol_lambda)
return make_closure (cadr (e), cddr (e), assq (&scm_closure, a));
if (e->car == &scm_closure)
return e;
if (e->car == &symbol_if)
return builtin_if (cdr (e), a);
if (r1->car == &symbol_begin)
return begin_env (r1, r0);
if (r1->car == &symbol_lambda)
return make_closure (cadr (r1), cddr (r1), assq (&scm_closure, r0));
if (r1->car == &scm_closure)
return r1;
if (r1->car == &symbol_if)
return if_env (cdr (r1), r0);
#if !BOOT
if (e->car == &symbol_define)
return define_env (e, a);
if (e->car == &symbol_define_macro)
return define_env (e, a);
if (e->car == &symbol_primitive_load)
return load_env (a);
if (r1->car == &symbol_define)
return define_env (r1, r0);
if (r1->car == &symbol_define_macro)
return define_env (r1, r0);
if (r1->car == &symbol_primitive_load)
return load_env (r0);
#else
if (e->car == &symbol_define) {
if (r1->car == &symbol_define) {
fprintf (stderr, "C DEFINE: ");
display_ (stderr,
e->cdr->car->type == SYMBOL
? e->cdr->car->string
: e->cdr->car->car->string);
r1->cdr->car->type == SYMBOL
? r1->cdr->car->string
: r1->cdr->car->car->string);
fprintf (stderr, "\n");
}
assert (e->car != &symbol_define);
assert (e->car != &symbol_define_macro);
assert (r1->car != &symbol_define);
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
if (e->car == &symbol_set_x)
return set_env_x (cadr (e), eval_env (caddr (e), a), a);
#if QUASIQUOTE
if (e->car == &symbol_unquote)
return eval_env (cadr (e), a);
if (e->car == &symbol_quasiquote)
return eval_quasiquote (cadr (e), add_unquoters (a));
if (r1->car == &symbol_unquote)
return eval_env (cadr (r1), r0);
if (r1->car == &symbol_quasiquote)
return eval_quasiquote (cadr (r1), add_unquoters (r0));
#endif //QUASIQUOTE
#if QUASISYNTAX
if (e->car == &symbol_unsyntax)
return eval_env (cadr (e), a);
if (e->car == &symbol_quasisyntax)
return eval_quasisyntax (cadr (e), add_unsyntaxers (a));
if (r1->car == &symbol_unsyntax)
return eval_env (cadr (r1), r0);
if (r1->car == &symbol_quasisyntax)
return eval_quasisyntax (cadr (r1), add_unsyntaxers (r0));
#endif //QUASISYNTAX
scm *x = expand_macro_env (e, a);
if (x != e) return eval_env (x, a);
return apply_env (e->car, evlis_env (e->cdr, a), a);
scm *x = expand_macro_env (r1, r0);
if (x != r1)
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));
default: return e;
case SYMBOL: return assert_defined (r1, assq_ref_cache (r1, r0));
default: return r1;
}
}
scm *
expand_macro_env (scm *e, scm *a)
vm_expand_macro_env ()
{
if (car (e)->type == STRING && string_to_symbol (car (e)) == &symbol_noexpand)
return cadr (e);
if (car (r1)->type == STRING && string_to_symbol (car (r1)) == &symbol_noexpand)
return cadr (r1);
scm *macro;
if (e->type == PAIR
&& (macro = lookup_macro (e->car, a)) != &scm_f)
return apply_env (macro, e->cdr, a);
scm *expanders;
if (e->type == PAIR
&& car (e)->type == SYMBOL
&& ((expanders = assq_ref_cache (&symbol_sc_expander_alist, a)) != &scm_undefined)
&& ((macro = assq (car (e), expanders)) != &scm_f))
if (r1->type == PAIR
&& (macro = lookup_macro (r1->car, r0)) != &scm_f)
return apply_env (macro, r1->cdr, r0);
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)
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 *
begin_env (scm *e, scm *a)
vm_begin_env ()
{
scm *r = &scm_unspecified;
while (e != &scm_nil) {
r = eval_env (e->car, a);
e = e->cdr;
while (r1 != &scm_nil) {
if (car (r1)->type == PAIR && caar (r1) == &symbol_begin)
r1 = append2 (cdar (r1), cdr (r1));
r = eval_env (r1->car, r0);
r1 = r1->cdr;
}
return r;
}
scm *
builtin_if (scm *e, scm *a)
vm_if_env ()
{
if (eval_env (car (e), a) != &scm_f)
return eval_env (cadr (e), a);
if (cddr (e) != &scm_nil)
return eval_env (caddr (e), a);
scm *x = eval_env (car (r1), r0);
if (x != &scm_f)
return eval_env (cadr (r1), r0);
if (cddr (r1) != &scm_nil)
return eval_env (caddr (r1), r0);
return &scm_unspecified;
}
@ -773,8 +914,6 @@ cstring_to_list (char const* s)
return p;
}
scm *symbols = 0;
scm *
list_of_char_equal_p (scm *a, scm *b)
{
@ -965,12 +1104,9 @@ force_output (scm *p) ///((arity . n))
fflush (f);
}
int display_depth = 1000;
scm *
display_helper (FILE* f, scm *x, bool cont, char const *sep, bool quote)
{
//if (!display_depth) return &scm_unspecified;
display_depth--;
scm *r;
fprintf (f, "%s", sep);
switch (x->type)
@ -1012,7 +1148,7 @@ display_helper (FILE* f, scm *x, bool cont, char const *sep, bool quote)
}
if (!cont) fprintf (f, "(");
display_ (f, car (x));
if (cdr (x)->type == PAIR)
if (cdr (x) && cdr (x)->type == PAIR)
display_helper (f, cdr (x), true, " ", false);
else if (cdr (x) != &scm_nil) {
fprintf (f, " . ");
@ -1271,10 +1407,16 @@ read_env (scm *a)
return readword (getchar (), &scm_nil, a);
}
scm *
acons (scm *key, scm *value, scm *alist)
{
return cons (cons (key, value), alist);
}
scm *
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 *
@ -1292,9 +1434,11 @@ mes_environment () ///((internal))
g_news[0].length = ARENA_SIZE - 1;
g_news[0].vector = &g_news[1];
a = add_environment (a, "%free", &g_free);
a = add_environment (a, "%the-cells", g_cells++);
a = add_environment (a, "%new-cells", g_news++);
g_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"
@ -1304,6 +1448,7 @@ mes_environment () ///((internal))
#endif
a = cons (cons (&symbol_begin, &scm_begin), a);
#if MES_FULL
#include "posix.environment.i"
#include "string.environment.i"
#include "math.environment.i"
@ -1312,10 +1457,43 @@ mes_environment () ///((internal))
//#include "quasiquote.environment.i"
#include "define.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 = 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;
}
@ -1370,5 +1548,6 @@ main (int argc, char *argv[])
scm *a = mes_environment ();
display_ (stderr, load_env (a));
fputs ("", stderr);
fprintf (stderr, "\nstats: [%d]\n", g_free.value);
return 0;
}

View File

@ -37,7 +37,7 @@
((label loop-0
(lambda (r e a)
;; (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 (eq? (car e) 'define)
((lambda (aa) ; env:define

View File

@ -36,14 +36,24 @@ unquote_splicing (scm *x) ///((no-environment))
scm *
eval_quasiquote (scm *e, scm *a)
{
if (e == &scm_nil) return e;
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);
else if (e->type == PAIR && e->car->type == PAIR
&& eq_p (caar (e), &symbol_unquote_splicing) == &scm_t)
return append2 (eval_env (cadar (e), a), eval_quasiquote (cdr (e), a));
return cons (eval_quasiquote (car (e), a), eval_quasiquote (cdr (e), a));
return vm_call (vm_eval_quasiquote, e, &scm_undefined, a);
}
scm *
vm_eval_quasiquote ()
{
if (r1 == &scm_nil) return r1;
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 *

View File

@ -1,6 +1,5 @@
#! /bin/sh
# -*-scheme-*-
set -x
echo ' ()' | cat $($(dirname $0)/../scripts/include.mes $0) $0 /dev/stdin | $(dirname $0)/../scripts/mes "$@"
#paredit:||
exit $?
@ -37,12 +36,11 @@ exit $?
(pass-if "begin" (seq? (begin 'a 'b (+ 1 2)) 3))
(pass-if "lambda" (symbol? 'lambda))
(begin (define *top-begin-a* '*top-begin-a*))
(pass-if "top begin " (seq? *top-begin-a* '*top-begin-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*))
(define *top-define-a* '*top-define-a*)
(pass-if "top define " (seq? *top-define-a* '*top-define-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 2" (seq? (if #f #f) *unspecified*))
(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 2" (sequal? (apply list 1 '(2)) '(1 2)))
(pass-if "apply 3" (sequal? (apply list 1 2 '(3)) '(1 2 3)))
(begin
(define local-answer 41))
(pass-if-equal "begin 2" 41 (begin local-answer))

360
tests/gc-2.test Executable file
View 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
View 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
View 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)