* scaffold/mini-mes.c (lookup_): Remove.
* mes.c: Likewise.
* reader.c (lookup_): Enable.
* mlib.c (putc): New function.
* module/mes/libc.mes (putc): New function.
mes-32: mes.c lib.c
rm -f mes mes.o
guix environment --system=i686-linux --ad-hoc gcc-toolchain -- bash -c 'make mes CC=i686-unknown-linux-gnu-gcc LIBRARY_PATH=$${PATH%%/bin:*}/lib'
+ rm -f mes.o
mv mes mes-32
module/mes/read-0-32.mo: module/mes/read-0.mes mes-32
rm -f $@
# gcc -nostdlib --std=gnu99 -m32 -g -o $@ '-DPREFIX=' '-DVERSION='"$(VERSION)"' $<
gcc -nostdlib -I. --std=gnu99 -m32 -g -I. -o $@ $(CPPFLAGS) $<
+ rm -f mes.o
chmod +x $@
guile-mini-mes: mini-mes.h mini-mes.i mini-mes.environment.i mini-mes.symbols.i
(regexp-replace "_" "-")
(regexp-replace "_" "-")
(regexp-replace "_" "-")
- (regexp-replace "^builtin_" "")
(regexp-replace "_to_" "->")
(regexp-replace "_x$" "!")
- (regexp-replace "_p$" "?"))
+ (regexp-replace "_p$" "?")
+ (regexp-replace "___" "***")
+ (regexp-replace "___" "***"))
(.name f))))
(if (not (string-suffix? "-" name)) name
(string-append "core:" (string-drop-right name 1))))))
(format #f "g_cells[cell_~a].string = MAKE_STRING (scm_~a.string);\n" (.name f) (.name f))
(format #f "g_cells[cell_~a].car = MAKE_STRING (scm_~a.car);\n" (.name f) (.name f)))
(if GCC?
- (format #f "a = acons (make_symbol (scm_~a.string), ~a, a);\n\n" (.name f) (function-cell-name f))
- (format #f "a = acons (make_symbol (scm_~a.car), ~a, a);\n\n" (.name f) (function-cell-name f)))))
+ (format #f "a = acons (lookup_symbol_ (scm_~a.string), ~a, a);\n\n" (.name f) (function-cell-name f))
+ (format #f "a = acons (lookup_symbol_ (scm_~a.car), ~a, a);\n\n" (.name f) (function-cell-name f)))))
(define (snarf-symbols string)
(let* ((matches (list-matches "\nstruct scm scm_([a-z_0-9]+) = [{](TSPECIAL|TSYMBOL)," string)))
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
- * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
// return MAKE_NUMBER (n);
// }
+SCM fdisplay_ (SCM,FILE*);
+
+int g_depth;
+
+SCM
+display_helper (SCM x, int cont, char* sep, FILE *fd)
+{
+ fputs (sep, fd);
+ if (g_depth == 0) return cell_unspecified;
+ g_depth = g_depth - 1;
+
+ switch (TYPE (x))
+ {
+ case TCHAR:
+ {
+ fputs ("#\\", fd);
+ putc (VALUE (x), fd);
+ break;
+ }
+ case TFUNCTION:
+ {
+ fputs ("#<procedure ", fd);
+ char *p = "?";
+ if (FUNCTION (x).name != 0)
+ p = FUNCTION (x).name;
+ fputs (p, fd);
+ fputs ("[", fd);
+ fputs (itoa (CDR (x)), fd);
+ fputs (",", fd);
+ fputs (itoa (x), fd);
+ fputs ("]>", fd);
+ break;
+ }
+ case TMACRO:
+ {
+ fputs ("#<macro ", fd);
+ display_helper (cdr (x), cont, "", fd);
+ fputs (">", fd);
+ break;
+ }
+ case TNUMBER:
+ {
+ fputs (itoa (VALUE (x)), fd);
+ break;
+ }
+ case TPAIR:
+ {
+ if (!cont) fputs ("(", fd);
+ if (x && x != cell_nil) fdisplay_ (CAR (x), fd);
+ if (CDR (x) && TYPE (CDR (x)) == TPAIR)
+ display_helper (CDR (x), 1, " ", fd);
+ else if (CDR (x) && CDR (x) != cell_nil)
+ {
+ if (TYPE (CDR (x)) != TPAIR)
+ fputs (" . ", fd);
+ fdisplay_ (CDR (x), fd);
+ }
+ if (!cont) fputs (")", fd);
+ break;
+ }
+ case TSPECIAL:
+#if __NYACC__
+ // FIXME
+ //{}
+ {
+ SCM t = CAR (x);
+ while (t && t != cell_nil)
+ {
+ putc (VALUE (CAR (t)), fd);
+ t = CDR (t);
+ }
+ break;
+ }
+#endif
+ case TSTRING:
+#if __NYACC__
+ // FIXME
+ {
+ SCM t = CAR (x);
+ while (t && t != cell_nil)
+ {
+ putc (VALUE (CAR (t)), fd);
+ t = CDR (t);
+ }
+ break;
+ }
+#endif
+ case TSYMBOL:
+ {
+ SCM t = CAR (x);
+ while (t && t != cell_nil)
+ {
+ putc (VALUE (CAR (t)), fd);
+ t = CDR (t);
+ }
+ break;
+ }
+ default:
+ {
+ fputs ("<", fd);
+ fputs (itoa (TYPE (x)), fd);
+ fputs (":", fd);
+ fputs (itoa (x), fd);
+ fputs (">", fd);
+ break;
+ }
+ }
+ return 0;
+}
+
+SCM
+display_ (SCM x)
+{
+ g_depth = 5;
+ return display_helper (x, 0, "", stdout);
+}
+
+SCM
+display_error_ (SCM x)
+{
+ g_depth = 5;
+ return display_helper (x, 0, "", stderr);
+}
+
+SCM
+fdisplay_ (SCM x, FILE *fd) ///((internal))
+{
+ g_depth = 5;
+ return display_helper (x, 0, "", fd);
+}
+
SCM
exit_ (SCM x) ///((name . "exit"))
{
char buf[1024];
sprintf (buf, "cannot apply: %s:", type);
fprintf (stderr, " [");
- stderr_ (e);
+ display_error_ (e);
fprintf (stderr, "]\n");
SCM e = MAKE_STRING (cstring_to_list (buf));
return error (cell_symbol_wrong_type_arg, cons (e, f));
dump ()
{
fputs ("program r2=", stderr);
- stderr_ (r2);
+ display_error_ (r2);
fputs ("\n", stderr);
r1 = g_symbols;
return r2;
}
-SCM
-values (SCM x) ///((arity . n))
-{
- SCM v = cons (0, x);
- TYPE (v) = TVALUES;
- return v;
-}
-
-SCM
-arity_ (SCM x)
-{
- assert (TYPE (x) == TFUNCTION);
- return MAKE_NUMBER (FUNCTION (x).arity);
-}
-
SCM
xassq (SCM x, SCM a) ///for speed in core only
{
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
- * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
#define NTYPE(x) g_news[x].type
#define CAAR(x) CAR (CAR (x))
+#define CADR(x) CAR (CDR (x))
#define CDAR(x) CDR (CAR (x))
-#define CAAR(x) CAR (CAR (x))
+#define CDDR(x) CDR (CDR (x))
#define CADAR(x) CAR (CDR (CAR (x)))
#define CADDR(x) CAR (CDR (CDR (x)))
#define CDDDR(x) CDR (CDR (CDR (x)))
#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
-#define CADR(x) CAR (CDR (x))
-#define MAKE_CHAR(n) make_cell (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
-#define MAKE_CONTINUATION(n) make_cell (tmp_num_ (TCONTINUATION), n, g_stack)
-#define MAKE_NUMBER(n) make_cell (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
-#define MAKE_REF(n) make_cell (tmp_num_ (TREF), n, 0)
-#define MAKE_STRING(x) make_cell (tmp_num_ (TSTRING), x, 0)
+#define MAKE_CHAR(n) make_cell_ (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
+#define MAKE_CONTINUATION(n) make_cell_ (tmp_num_ (TCONTINUATION), n, g_stack)
+#define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
+#define MAKE_REF(n) make_cell_ (tmp_num_ (TREF), n, 0)
+#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
SCM vm_call (function0_t f, SCM p1, SCM a);
char const* itoa(int);
}
SCM
-make_cell (SCM type, SCM car, SCM cdr)
+make_cell_ (SCM type, SCM car, SCM cdr)
{
SCM x = alloc (1);
assert (TYPE (type) == TNUMBER);
return x;
}
+SCM
+make_symbol_ (SCM s)
+{
+ g_cells[tmp_num].value = TSYMBOL;
+ SCM x = make_cell_ (tmp_num, s, 0);
+ g_symbols = cons (x, g_symbols);
+ return x;
+}
+
+SCM
+list_of_char_equal_p (SCM a, SCM b) ///((internal))
+{
+ while (a != cell_nil && b != cell_nil && VALUE (car (a)) == VALUE (car (b))) {
+ assert (TYPE (car (a)) == TCHAR);
+ assert (TYPE (car (b)) == TCHAR);
+ a = cdr (a);
+ b = cdr (b);
+ }
+ return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
+}
+
+SCM
+lookup_symbol_ (SCM s)
+{
+ SCM x = g_symbols;
+ while (x) {
+ if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) break;
+ x = cdr (x);
+ }
+ if (x) x = car (x);
+ if (!x) x = make_symbol_ (s);
+ return x;
+}
+
+SCM
+type_ (SCM x)
+{
+ return MAKE_NUMBER (TYPE (x));
+}
+
+SCM
+car_ (SCM x)
+{
+ return (TYPE (x) != TCONTINUATION
+ && (TYPE (CAR (x)) == TPAIR // FIXME: this is weird
+ || TYPE (CAR (x)) == TREF
+ || TYPE (CAR (x)) == TSPECIAL
+ || TYPE (CAR (x)) == TSYMBOL
+ || TYPE (CAR (x)) == TSTRING)) ? CAR (x) : MAKE_NUMBER (CAR (x));
+}
+
+SCM
+cdr_ (SCM x)
+{
+ return (TYPE (CDR (x)) == TPAIR
+ || TYPE (CDR (x)) == TREF
+ || TYPE (CAR (x)) == TSPECIAL
+ || TYPE (CDR (x)) == TSYMBOL
+ || TYPE (CDR (x)) == TSTRING) ? CDR (x) : MAKE_NUMBER (CDR (x));
+}
+
+SCM
+arity_ (SCM x)
+{
+ assert (TYPE (x) == TFUNCTION);
+ return MAKE_NUMBER (FUNCTION (x).arity);
+}
+
SCM
cons (SCM x, SCM y)
{
g_cells[tmp_num].value = TPAIR;
- return make_cell (tmp_num, x, y);
+ return make_cell_ (tmp_num, x, y);
}
SCM
}
SCM
-type_ (SCM x)
+values (SCM x) ///((arity . n))
{
- return MAKE_NUMBER (TYPE (x));
+ SCM v = cons (0, x);
+ TYPE (v) = TVALUES;
+ return v;
}
SCM
-car_ (SCM x)
-{
- return (TYPE (x) != TCONTINUATION
- && (TYPE (CAR (x)) == TPAIR // FIXME: this is weird
- || TYPE (CAR (x)) == TREF
- || TYPE (CAR (x)) == TSPECIAL
- || TYPE (CAR (x)) == TSYMBOL
- || TYPE (CAR (x)) == TSTRING)) ? CAR (x) : MAKE_NUMBER (CAR (x));
-}
-
-SCM
-cdr_ (SCM x)
+acons (SCM key, SCM value, SCM alist)
{
- return (TYPE (CDR (x)) == TPAIR
- || TYPE (CDR (x)) == TREF
- || TYPE (CAR (x)) == TSPECIAL
- || TYPE (CDR (x)) == TSYMBOL
- || TYPE (CDR (x)) == TSTRING) ? CDR (x) : MAKE_NUMBER (CDR (x));
+ return cons (cons (key, value), alist);
}
// MIMI_MES lib.c?
SCM throw;
if ((throw = assq_ref_env (cell_symbol_throw, r0)) != cell_undefined)
return apply (throw, cons (key, cons (x, cell_nil)), r0);
+ display_error_ (key);
+ fputs (": ", stderr);
+ display_error_ (x);
assert (!"error");
}
if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
&& x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
-#if 0
- eputs ("call: ");
- if (FUNCTION (fn).name) eputs (FUNCTION (fn).name);
- else eputs (itoa (CDR (fn)));
- eputs ("\n");
-#endif
switch (FUNCTION (fn).arity)
{
case 0: return FUNCTION (fn).function0 ();
case 1: return FUNCTION (fn).function1 (car (x));
- case 2: return FUNCTION (fn).function2 (car (x), cadr (x));
- case 3: return FUNCTION (fn).function3 (car (x), cadr (x), car (cddr (x)));
+ case 2: return FUNCTION (fn).function2 (car (x), CADR (x));
+ case 3: return FUNCTION (fn).function3 (car (x), CADR (x), car (CDDR (x)));
case -1: return FUNCTION (fn).functionn (x);
}
assq (SCM x, SCM a)
{
while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
- return a != cell_nil ? car (a) : cell_f;
+ return a != cell_nil ? CAR (a) : cell_f;
}
SCM
{
x = assq (x, a);
if (x == cell_f) return cell_undefined;
- return cdr (x);
+ return CDR (x);
}
SCM
}
SCM
-make_closure (SCM args, SCM body, SCM a)
+make_closure_ (SCM args, SCM body, SCM a) ///((internal))xs
{
- return make_cell (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
+ return make_cell_ (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
}
SCM
-lookup_macro (SCM x, SCM a)
+lookup_macro_ (SCM x, SCM a) ///((internal))
{
if (TYPE (x) != TSYMBOL) return cell_f;
SCM m = assq_ref_env (x, a);
-#if 0
- if (TYPE (m) == TMACRO)
- {
- fputs ("XXmacro: ", stdout);
- fputs ("[", stdout);
- fputs (itoa (m), stdout);
- fputs ("]: ", stdout);
- display_ (m);
- fputs ("\n", stdout);
-
- }
-#endif
if (TYPE (m) == TMACRO) return MACRO (m);
return cell_f;
}
return cell_unspecified;
}
-SCM caar (SCM x) {return car (car (x));}
-SCM cadr (SCM x) {return car (cdr (x));}
-SCM cdar (SCM x) {return cdr (car (x));}
-SCM cddr (SCM x) {return cdr (cdr (x));}
-
SCM
eval_apply ()
{
case TCLOSURE:
{
SCM cl = CLOSURE (car (r1));
- SCM formals = cadr (cl);
- SCM body = cddr (cl);
- SCM aa = cdar (cl);
+ SCM formals = CADR (cl);
+ SCM body = CDDR (cl);
+ SCM aa = CDAR (cl);
aa = cdr (aa);
check_formals (car (r1), formals, cdr (r1));
SCM p = pairlis (formals, cdr (r1), aa);
x = r1;
g_stack = CONTINUATION (CAR (r1));
gc_pop_frame ();
- r1 = cadr (x);
+ r1 = CADR (x);
goto eval_apply;
}
case TSPECIAL:
}
case TPAIR:
{
- switch (caar (r1))
+ switch (CAAR (r1))
{
case cell_symbol_lambda:
{
- SCM formals = cadr (car (r1));
- SCM body = cddr (car (r1));
+ SCM formals = CADR (car (r1));
+ SCM body = CDDR (car (r1));
SCM p = pairlis (formals, cdr (r1), r0);
check_formals (r1, formals, cdr (r1));
call_lambda (body, p, p, r0);
#endif // FIXED_PRIMITIVES
case cell_symbol_quote:
{
- x = r1; gc_pop_frame (); r1 = cadr (x); goto eval_apply;
+ x = r1; gc_pop_frame (); r1 = CADR (x); goto eval_apply;
}
case cell_symbol_begin: goto begin;
case cell_symbol_lambda:
{
- r1 = make_closure (cadr (r1), cddr (r1), assq (cell_closure, r0));
+ r1 = make_closure_ (CADR (r1), CDDR (r1), assq (cell_closure, r0));
goto vm_return;
}
case cell_symbol_if: {r1=cdr (r1); goto vm_if;}
case cell_symbol_set_x:
{
- push_cc (car (cddr (r1)), r1, r0, cell_vm_eval_set_x);
+ push_cc (car (CDDR (r1)), r1, r0, cell_vm_eval_set_x);
goto eval;
eval_set_x:
x = r2;
- r1 = set_env_x (cadr (x), r1, r0);
+ r1 = set_env_x (CADR (x), r1, r0);
goto vm_return;
}
case cell_vm_macro_expand:
{
- push_cc (cadr (r1), r1, r0, cell_vm_return);
+ push_cc (CADR (r1), r1, r0, cell_vm_return);
goto macro_expand;
}
default: {
SCM expanders;
macro_expand:
if (TYPE (r1) == TPAIR
- && (macro = lookup_macro (car (r1), r0)) != cell_f)
+ && (macro = lookup_macro_ (car (r1), r0)) != cell_f)
{
r1 = cons (macro, CDR (r1));
-#if 0
- fputs ("macro: ", stdout);
- display_ (macro);
- fputs ("\n", stdout);
- fputs ("r1: ", stdout);
- display_ (r1);
- fputs ("\n", stdout);
-#endif
goto apply;
}
else if (TYPE (r1) == TPAIR
while (r1 != cell_nil) {
if (TYPE (r1) == TPAIR && TYPE (CAR (r1)) == TPAIR)
{
- if (caar (r1) == cell_symbol_begin)
- r1 = append2 (cdar (r1), cdr (r1));
- else if (caar (r1) == cell_symbol_primitive_load)
+ if (CAAR (r1) == cell_symbol_begin)
+ r1 = append2 (CDAR (r1), cdr (r1));
+ else if (CAAR (r1) == cell_symbol_primitive_load)
{
push_cc (cons (cell_symbol_read_input_file, cell_nil), r1, r0, cell_vm_begin_read_input_file);
goto apply;
if (CDR (r1) == cell_nil)
{
r1 = car (r1);
-#if 0
- fputs ("begin: ", stdout);
- display_ (r1);
- fputs ("\n", stdout);
-#endif
goto eval;
}
push_cc (CAR (r1), r1, r0, cell_vm_begin2);
r1 = r2;
if (x != cell_f)
{
- r1 = cadr (r1);
+ r1 = CADR (r1);
goto eval;
}
- if (cddr (r1) != cell_nil)
+ if (CDDR (r1) != cell_nil)
{
- r1 = car (cddr (r1));
+ r1 = car (CDDR (r1));
goto eval;
}
r1 = cell_unspecified;
call_with_values2:
if (TYPE (r1) == TVALUES)
r1 = CDR (r1);
- r1 = cons (cadr (r2), r1);
+ r1 = cons (CADR (r2), r1);
goto apply;
vm_return:
{
SCM frame = car (g_stack);
r1 = car (frame);
- r2 = cadr (frame);
- r3 = car (cddr (frame));
- r0 = cadr (cddr (frame));
+ r2 = CADR (frame);
+ r3 = car (CDDR (frame));
+ r0 = CADR (CDDR (frame));
return frame;
}
return eval_apply ();
}
-SCM
-make_symbol_ (SCM s)
-{
- g_cells[tmp_num].value = TSYMBOL;
- SCM x = make_cell (tmp_num, s, 0);
- g_symbols = cons (x, g_symbols);
- return x;
-}
-
-SCM
-list_of_char_equal_p (SCM a, SCM b)
-{
- while (a != cell_nil && b != cell_nil && VALUE (car (a)) == VALUE (car (b))) {
- assert (TYPE (car (a)) == TCHAR);
- assert (TYPE (car (b)) == TCHAR);
- a = cdr (a);
- b = cdr (b);
- }
- return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
-}
-
-SCM
-lookup_symbol_ (SCM s)
-{
- SCM x = g_symbols;
- while (x) {
- if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) break;
- x = cdr (x);
- }
- if (x) x = car (x);
- return x;
-}
-
-SCM
-make_symbol (SCM s)
-{
- SCM x = lookup_symbol_ (s);
- return x ? x : make_symbol_ (s);
-}
-
-//MINI_MES reader.c
-SCM
-lookup_ (SCM s, SCM a)
-{
- if (isdigit (VALUE (car (s))) || (VALUE (car (s)) == '-' && cdr (s) != cell_nil)) {
- SCM p = s;
- int sign = 1;
- if (VALUE (car (s)) == '-') {
- sign = -1;
- p = cdr (s);
- }
- int n = 0;
- while (p != cell_nil && isdigit (VALUE (car (p)))) {
- n *= 10;
- n += VALUE (car (p)) - '0';
- p = cdr (p);
- }
- if (p == cell_nil) return MAKE_NUMBER (n * sign);
- }
-
- SCM x = lookup_symbol_ (s);
- return x ? x : make_symbol_ (s);
-}
-
-SCM
-acons (SCM key, SCM value, SCM alist)
-{
- return cons (cons (key, value), alist);
-}
-
void
make_tmps (struct scm* cells)
{
return a;
}
-#define gputs(x) fputs(x,stdout);
-
SCM
mes_builtins (SCM a) ///((internal))
{
#include "posix.i"
#include "math.i"
#include "lib.i"
-#include "reader.i"
#include "vector.i"
#include "gc.i"
+#include "reader.i"
#include "gc.environment.i"
#include "lib.environment.i"
if (g_debug)
{
- gputs ("functions: ");
- gputs (itoa (g_function));
- gputs ("\n");
+ fputs ("functions: ", stderr);
+ fputs (itoa (g_function), stderr);
+ fputs ("\n", stderr);
for (int i = 0; i < g_function; i++)
{
- gputs ("[");
- gputs (itoa (i));
- gputs ("]: ");
- gputs (g_functions[i].name);
- gputs ("\n");
+ fputs ("[", stderr);
+ fputs (itoa (i), stderr);
+ fputs ("]: ", stderr);
+ fputs (g_functions[i].name, stderr);
+ fputs ("\n", stderr);
}
- gputs ("\n");
+ fputs ("\n", stderr);
}
return a;
for (int i=argc; i; i--) lst = cons (MAKE_STRING (cstring_to_list (argv[i-1])), lst);
r0 = acons (cell_symbol_argv, lst, r0);
+ if (g_debug) {eputs ("program: "); display_error_ (r2); eputs ("\n");}
push_cc (r2, cell_unspecified, r0, cell_unspecified);
r3 = cell_vm_begin;
r1 = eval_apply ();
- ///stderr_ (r1);
- display_ (r1);
+ display_error_ (r1);
fputs ("", stdout);
gc (g_stack);
#if __GNUC__
#define O_RDONLY 0
#define INT_MIN -2147483648
#define INT_MAX 2147483647
+#define EOF -1
+#define STDIN 0
+#define STDOUT 1
+#define STDERR 2
void
exit (int code)
return r;
}
+int
+putc (int c, int fd)
+{
+ write (fd, (char*)&c, 1);
+ return 0;
+}
+
int
putchar (int c)
{
- //write (STDOUT, s, strlen (s));
- //int i = write (STDOUT, s, strlen (s));
- write (1, (char*)&c, 1);
+ write (STDOUT, (char*)&c, 1);
return 0;
}
//munmap ((void*)p, *n);
}
-#define EOF -1
-#define STDIN 0
-#define STDOUT 1
-#define STDERR 2
-
size_t
strlen (char const* s)
{
int
eputs (char const* s)
{
- //int i = write (STDERR, s, strlen (s));
int i = strlen (s);
- write (2, s, i);
+ write (STDERR, s, i);
return 0;
}
int
fputs (char const* s, int fd)
{
- //int i = write (fd, s, strlen (s));
int i = strlen (s);
write (fd, s, i);
return 0;
int
puts (char const* s)
{
- //int i = write (STDOUT, s, strlen (s));
int i = strlen (s);
- write (1, s, i);
+ write (STDOUT, s, i);
return 0;
}
(define (primitive-eval e) (core:eval e (current-module)))
(define eval core:eval)
+(define (caar x) (car (car x)))
+(define (cadr x) (car (cdr x)))
+(define (cdar x) (cdr (car x)))
+(define (cddr x) (cdr (cdr x)))
+
(define-macro (defined? x)
(list 'assq x '(cddr (current-module))))
(list 'begin
(list 'if (list getenv "MES_DEBUG")
(list 'begin
- (list core:stderr "read ")
- (list core:stderr file)
- (list core:stderr "\n")))
+ (list core:display-error "read ")
+ (list core:display-error file)
+ (list core:display-error "\n")))
(list 'push! '*input-ports* (list current-input-port))
(list 'set-current-input-port (list open-input-file file))
(list 'primitive-load)
int
putchar (int c)
{
- //write (STDOUT, s, strlen (s));
- //int i = write (STDOUT, s, strlen (s));
write (1, (char*)&c, 1);
return 0;
}
parse-c99)))
ast))
+(define putc
+ (let* ((ast (with-input-from-string
+ "
+int
+putc (int c, int fd)
+{
+ write (fd, (char*)&c, 1);
+ return 0;
+}
+"
+;;paredit:"
+ parse-c99)))
+ ast))
+
(define eputs
(let* ((ast (with-input-from-string
"
int
eputs (char const* s)
{
- //write (STDERR, s, strlen (s));
- //write (2, s, strlen (s));
int i = strlen (s);
write (2, s, i);
return 0;
int
puts (char const* s)
{
- //write (STDOUT, s, strlen (s));
- //int i = write (STDOUT, s, strlen (s));
int i = strlen (s);
write (1, s, i);
return 0;
assert_fail
ungetc
putchar
+ putc
eputs
fputs
puts
(set! sexp:define
(lambda (e a)
- (if (atom? (cadr e)) (cons (cadr e) (core:eval (car (cddr e)) a))
- (cons (car (cadr e)) (core:eval (cons (quote lambda) (cons (cdr (cadr e)) (cddr e))) a)))))
+ (if (atom? (car (cdr e))) (cons (car (cdr e)) (core:eval (car (cdr (cdr e))) a))
+ (cons (car (car (cdr e))) (core:eval (cons (quote lambda) (cons (cdr (car (cdr e))) (cdr (cdr e)))) a)))))
(set! env:macro
(lambda (name+entry)
(cons
(cons (car name+entry)
- (make-cell <cell:macro> (core:car (car name+entry)) (cdr name+entry)))
+ (core:make-cell <cell:macro> (core:car (car name+entry)) (cdr name+entry)))
(list))))
(set! cons*
(define <cell:keyword> 4)
(define <cell:string> 10)
- (define (newline . rest) (core:stderr (list->string (list (integer->char 10)))))
- (define (display x . rest) (core:stderr x))
+ (define (newline . rest) (core:display (list->string (list (integer->char 10)))))
+ (define (display x . rest) core:display)
- (define (list->symbol lst) (make-symbol lst))
+ (define (list->symbol lst) (core:lookup-symbol lst))
(define (symbol->list s)
(core:car s))
(define (list->string lst)
- (make-cell <cell:string> lst 0))
+ (core:make-cell <cell:string> lst 0))
(define (integer->char x)
- (make-cell <cell:character> 0 x))
+ (core:make-cell <cell:character> 0 x))
(define (symbol->keyword s)
- (make-cell <cell:keyword> (symbol->list s) 0))
+ (core:make-cell <cell:keyword> (symbol->list s) 0))
(define (read)
(read-word (read-byte) (list) (current-module)))
(define-macro (cond . clauses)
(list (quote if) (pair? clauses)
(list (quote if) (car (car clauses))
- (if (pair? (cdar clauses))
- (if (eq? (car (cdar clauses)) (quote =>))
- (append2 (cdr (cdar clauses)) (list (caar clauses)))
+ (if (pair? (cdr (car clauses)))
+ (if (eq? (car (cdr (car clauses))) (quote =>))
+ (append2 (cdr (cdr (car clauses))) (list (car (car clauses))))
(list (cons (quote lambda) (cons (list) (car clauses)))))
(list (cons (quote lambda) (cons (list) (car clauses)))))
(if (pair? (cdr clauses))
(cons (f (car lst)) (map1 f (cdr lst)))))
(define (lookup w a)
- (core:lookup (map1 integer->char w) a))
+ (define (lookup-number c p s n)
+ (and (> c 47) (< c 58)
+ (if (null? p) (* s (+ (* n 10) (- c 48)))
+ (lookup-number (car p) (cdr p) s (+ (* n 10) (- c 48))))))
+ ((lambda (c p)
+ (or (cond ((and (> c 47) (< c 58)) (lookup-number c p 1 0))
+ ((and (eq? c 45) (pair? p)) (lookup-number (car p) (cdr p) -1 0))
+ (#t #f))
+ (core:lookup-symbol (map1 integer->char w))))
+ (car w) (cdr w)))
(define (read-hash c w a)
(cond
\f
;;; core: accessors
(define (string . lst)
- (make-cell <cell:string> lst 0))
+ (core:make-cell <cell:string> lst 0))
(define (string->list s)
(core:car s))
(define (string->symbol s)
(if (not (pair? (core:car s))) '()
- (make-symbol (core:car s))))
+ (core:lookup-symbol (core:car s))))
(define (symbol->list s)
(core:car s))
(apply string (apply append (map1 string->list rest))))
(define (integer->char x)
- (make-cell <cell:character> 0 x))
+ (core:make-cell <cell:character> 0 x))
(define (char->integer x)
- (make-cell <cell:number> 0 x))
+ (core:make-cell <cell:number> 0 x))
return buf;
}
-int g_depth;
-
-SCM
-display_helper (SCM x, int cont, char* sep)
-{
- gputs (sep);
- if (g_depth == 0) return cell_unspecified;
- //FIXME:
- //g_depth--;
- g_depth = g_depth - 1;
-
- // eputs ("<display>\n");
- switch (TYPE (x))
- {
- case TCHAR:
- {
- //gputs ("<char>\n");
- gputs ("#\\");
- putchar (VALUE (x));
- break;
- }
- case TFUNCTION:
- {
- gputs ("#<procedure ");
- ///gputs (FUNCTION (x).name ? FUNCTION (x).name : "?");
- char *p = "?";
- if (FUNCTION (x).name != 0)
- p = FUNCTION (x).name;
- gputs (p);
- gputs ("[");
- gputs (itoa (CDR (x)));
- gputs (",");
- gputs (itoa (x));
- gputs ("]>");
- break;
- }
- case TMACRO:
- {
- gputs ("#<macro ");
- display_helper (cdr (x), cont, "");
- gputs (">");
- break;
- }
- case TNUMBER:
- {
- //gputs ("<number>\n");
- gputs (itoa (VALUE (x)));
- break;
- }
- case TPAIR:
- {
- if (!cont) gputs ("(");
- if (x && x != cell_nil) display_ (CAR (x));
- if (CDR (x) && TYPE (CDR (x)) == TPAIR)
- display_helper (CDR (x), 1, " ");
- else if (CDR (x) && CDR (x) != cell_nil)
- {
- if (TYPE (CDR (x)) != TPAIR)
- gputs (" . ");
- display_ (CDR (x));
- }
- if (!cont) gputs (")");
- break;
- }
- case TSPECIAL:
-#if __NYACC__
- // FIXME
- //{}
- {
- SCM t = CAR (x);
- while (t && t != cell_nil)
- {
- putchar (VALUE (CAR (t)));
- t = CDR (t);
- }
- break;
- }
-#endif
- case TSTRING:
-#if __NYACC__
- // FIXME
- {}
-#endif
- case TSYMBOL:
- {
- SCM t = CAR (x);
- while (t && t != cell_nil)
- {
- putchar (VALUE (CAR (t)));
- t = CDR (t);
- }
- break;
- }
- default:
- {
- //gputs ("<default>\n");
- gputs ("<");
- gputs (itoa (TYPE (x)));
- gputs (":");
- gputs (itoa (x));
- gputs (">");
- break;
- }
- }
- return 0;
-}
-
-SCM
-display_ (SCM x)
-{
- g_depth = 5;
- return display_helper (x, 0, "");
-}
-
-SCM
-stderr_ (SCM x)
-{
- SCM write;
- if (TYPE (x) == TSTRING)
- eputs (string_to_cstring (x));
-#if __GNUC__
- else if ((write = assq_ref_env (cell_symbol_write, r0)) != cell_undefined)
- apply (assq_ref_env (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
-#endif
- else if (TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL)
- eputs (string_to_cstring (x));
- else if (TYPE (x) == TNUMBER)
- eputs (itoa (VALUE (x)));
- else
- eputs ("core:stderr: display undefined\n");
- return cell_unspecified;
-}
-
SCM
getenv_ (SCM s) ///((name . "getenv"))
{
/* -*-comment-start: "//";comment-end:""-*-
* Mes --- Maxwell Equations of Software
- * Copyright © 2016 Jan Nieuwenhuizen <janneke@gnu.org>
+ * Copyright © 2016,2017 Jan Nieuwenhuizen <janneke@gnu.org>
*
* This file is part of Mes.
*
* along with Mes. If not, see <http://www.gnu.org/licenses/>.
*/
+SCM
+___end_of_mes___ ()
+{
+ return 0;
+}
SCM
read_input_file_env_ (SCM e, SCM a)
return read_word (getchar (), cell_nil, a);
}
-//MINI_MES
-// SCM
-// lookup_ (SCM s, SCM a)
-// {
-// if (isdigit (VALUE (car (s))) || (VALUE (car (s)) == '-' && cdr (s) != cell_nil)) {
-// SCM p = s;
-// int sign = 1;
-// if (VALUE (car (s)) == '-') {
-// sign = -1;
-// p = cdr (s);
-// }
-// int n = 0;
-// while (p != cell_nil && isdigit (VALUE (car (p)))) {
-// n *= 10;
-// n += VALUE (car (p)) - '0';
-// p = cdr (p);
-// }
-// if (p == cell_nil) return MAKE_NUMBER (n * sign);
-// }
+SCM
+lookup_ (SCM s, SCM a)
+{
+ if (isdigit (VALUE (car (s))) || (VALUE (car (s)) == '-' && cdr (s) != cell_nil)) {
+ SCM p = s;
+ int sign = 1;
+ if (VALUE (car (s)) == '-') {
+ sign = -1;
+ p = cdr (s);
+ }
+ int n = 0;
+ while (p != cell_nil && isdigit (VALUE (car (p)))) {
+ n *= 10;
+ n += VALUE (car (p)) - '0';
+ p = cdr (p);
+ }
+ if (p == cell_nil) return MAKE_NUMBER (n * sign);
+ }
-// SCM x = lookup_symbol_ (s);
-// return x ? x : make_symbol_ (s);
-// }
+ return lookup_symbol_ (s);
+}
#define MES_MINI 1
#define FIXED_PRIMITIVES 0
-#if __GNUC__
-#define FIXME_NYACC 1
-#define __NYACC__ 0
-#define NYACC_CAR
-#define NYACC_CDR
-#else
-#define __NYACC__ 1
-#define NYACC_CAR nyacc_car
-#define NYACC_CDR nyacc_cdr
-#endif
-
char arena[2000];
//char buf0[400];
// continuation
SCM r3 = 0;
-#if __NYACC__ || FIXME_NYACC
-enum type_t {CHAR, CLOSURE, CONTINUATION, TFUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, TSTRING, SYMBOL, VALUES, TVECTOR, BROKEN_HEART};
-#else
-enum type_t {CHAR, CLOSURE, CONTINUATION, FUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART};
-#endif
+enum type_t {CHAR, CLOSURE, CONTINUATION, TFUNCTION, KEYWORD, MACRO, NUMBER, PAIR, REF, SPECIAL, STRING, SYMBOL, VALUES, VECTOR, BROKEN_HEART};
struct scm {
enum type_t type;
int g_function = 0;
-SCM make_cell (SCM type, SCM car, SCM cdr);
-struct function fun_make_cell = {&make_cell,3,"make-cell"};
-struct scm scm_make_cell = {TFUNCTION,0,0};
- //, "make-cell", 0};
-SCM cell_make_cell;
+SCM make_cell_ (SCM type, SCM car, SCM cdr);
+struct function fun_make_cell_ = {&make_cell_,3,"core:make-cell"};
+struct scm scm_make_cell_ = {TFUNCTION,0,0};
+ //, "core:make-cell", 0};
+SCM cell_make_cell_;
SCM cons (SCM x, SCM y);
struct function fun_cons = {&cons,2,"cons"};
#define STRING(x) g_cells[x].car
#define CDR(x) g_cells[x].cdr
-#if __GNUC__
-//#define CLOSURE(x) g_cells[x].closure
-#endif
#define CONTINUATION(x) g_cells[x].cdr
-#if __GNUC__
-//#define FUNCTION(x) g_functions[g_cells[x].function]
-#endif
#define FUNCTION(x) g_functions[g_cells[x].cdr]
#define VALUE(x) g_cells[x].cdr
#define VECTOR(x) g_cells[x].cdr
-#define MAKE_CHAR(n) make_cell (tmp_num_ (CHAR), 0, tmp_num2_ (n))
-//#define MAKE_CONTINUATION(n) make_cell (tmp_num_ (CONTINUATION), n, g_stack)
-#define MAKE_NUMBER(n) make_cell (tmp_num_ (NUMBER), 0, tmp_num2_ (n))
-//#define MAKE_REF(n) make_cell (tmp_num_ (REF), n, 0)
-
+#define MAKE_CHAR(n) make_cell_ (tmp_num_ (CHAR), 0, tmp_num2_ (n))
+#define MAKE_NUMBER(n) make_cell_ (tmp_num_ (NUMBER), 0, tmp_num2_ (n))
#define CAAR(x) CAR (CAR (x))
-// #define CDAR(x) CDR (CAR (x))
#define CADAR(x) CAR (CDR (CAR (x)))
-// #define CADDR(x) CAR (CDR (CDR (x)))
-// #define CDDDR(x) CDR (CDR (CDR (x)))
#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
#define CADR(x) CAR (CDR (x))
-
-#if __NYACC__ || FIXME_NYACC
-#define MAKE_STRING(x) make_cell (tmp_num_ (TSTRING), x, 0)
-// #else
-// #define MAKE_STRING(x) make_cell (tmp_num_ (STRING), x, 0)
-#endif
+#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
SCM
alloc (int n)
}
SCM
-make_cell (SCM type, SCM car, SCM cdr)
+make_cell_ (SCM type, SCM car, SCM cdr)
{
SCM x = alloc (1);
assert (TYPE (type) == NUMBER);
puts ("\n");
#endif
VALUE (tmp_num) = PAIR;
- return make_cell (tmp_num, x, y);
+ return make_cell_ (tmp_num, x, y);
}
SCM
make_symbol_ (SCM s)
{
VALUE (tmp_num) = SYMBOL;
- SCM x = make_cell (tmp_num, s, 0);
+ SCM x = make_cell_ (tmp_num, s, 0);
g_symbols = cons (x, g_symbols);
return x;
}
SCM
make_closure (SCM args, SCM body, SCM a)
{
- return make_cell (tmp_num_ (CLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
+ return make_cell_ (tmp_num_ (CLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
}
SCM
// #include "posix.environment.i"
// #include "reader.environment.i"
#else
-scm_make_cell.cdr = g_function;
-g_functions[g_function++] = fun_make_cell;
-cell_make_cell = g_free++;
- g_cells[cell_make_cell] = scm_make_cell;
+scm_make_cell_.cdr = g_function;
+g_functions[g_function++] = fun_make_cell_;
+cell_make_cell_ = g_free++;
+ g_cells[cell_make_cell_] = scm_make_cell_;
scm_cons.cdr = g_function;
g_functions[g_function++] = fun_cons;
TYPE (11) = TFUNCTION;
CAR (11) = 0x58585858;
- // 0 = make_cell
+ // 0 = make_cell_
// 1 = cons
// 2 = car
CDR (11) = 1;
{
//puts ("<function>\n");
if (VALUE (x) == 0)
- puts ("make-cell");
+ puts ("core:make-cell");
if (VALUE (x) == 1)
puts ("cons");
if (VALUE (x) == 2)
return r2;
}
-char string_to_cstring_buf[1024];
-char const*
-string_to_cstring (SCM s)
-{
- //static char buf[1024];
- //char *p = buf;
- char *p = string_to_cstring_buf;
- s = STRING(s);
- while (s != cell_nil)
- {
- *p++ = VALUE (car (s));
- s = cdr (s);
- }
- *p = 0;
- //return buf;
- return string_to_cstring_buf;
-}
-
-SCM
-stderr_ (SCM x)
-{
- //SCM write;
-#if __NYACC__ || FIXME_NYACC
- if (TYPE (x) == TSTRING)
-// #else
-// if (TYPE (x) == STRING)
-#endif
- eputs (string_to_cstring (x));
- // else if ((write = assq_ref_env (cell_symbol_write, r0)) != cell_undefined)
- // apply (assq_ref_env (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
-#if __NYACC__ || FIXME_NYACC
- else if (TYPE (x) == SPECIAL || TYPE (x) == TSTRING || TYPE (x) == SYMBOL)
-// #else
-// else if (TYPE (x) == SPECIAL || TYPE (x) == STRING || TYPE (x) == SYMBOL)
-#endif
- eputs (string_to_cstring (x));
- else if (TYPE (x) == NUMBER)
- eputs (itoa (VALUE (x)));
- else
- eputs ("display: undefined\n");
- return cell_unspecified;
-}
-
int
main (int argc, char *argv[])
{
#define MES_MINI 1
-#if __GNUC__
-#define __NYACC__ 0
-#define NYACC
-#define NYACC2
-#else
-#define __NYACC__ 1
-#define NYACC nyacc
-#define NYACC2 nyacc2
-#endif
-
typedef int SCM;
#if __GNUC__
push_cc (r2, cell_unspecified, r0, cell_unspecified);
r3 = cell_vm_begin;
r1 = eval_apply ();
- stderr_ (r1);
eputs ("\n");
gc (g_stack);
#endif
#define assert(x) ((x) ? (void)0 : assert_fail (#x))
-#if __MESC__
-//void *g_malloc_base = 0;
-char *g_malloc_base = 0;
-// int ungetc_char = -1;
-// char ungetc_buf[2];
-#endif
-
#define MES_MINI 1
#define FIXED_PRIMITIVES 1
-#if __GNUC__
-#define FIXME_NYACC 1
-#define __NYACC__ 0
-#define NYACC_CAR
-#define NYACC_CDR
-#else
-#define __NYACC__ 1
-#define NYACC_CAR nyacc_car
-#define NYACC_CDR nyacc_cdr
-#endif
-
-
//int ARENA_SIZE = 4000000;
int ARENA_SIZE = 1000000000;
char *arena = 0;
char *name;
};
-//struct scm *g_cells = arena;
-int *foobar = 0;
#if __GNUC__
-struct scm *g_cells;
+struct scm *g_cells = 0;
+//struct scm *g_news = 0;
#else
+int *foobar = 0;
struct scm *g_cells = foobar;
+//struct scm *g_news = foobar;
#endif
-//FIXME
-//struct scm *g_news = 0;
-
struct scm scm_nil = {TSPECIAL, "()",0};
struct scm scm_f = {TSPECIAL, "#f",0};
struct scm scm_t = {TSPECIAL, "#t",0};
#define VALUE(x) g_cells[x].cdr
#define VECTOR(x) g_cells[x].cdr
-#define MAKE_CHAR(n) make_cell (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
-#define MAKE_CONTINUATION(n) make_cell (tmp_num_ (TCONTINUATION), n, g_stack)
-#define MAKE_NUMBER(n) make_cell (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
-//#define MAKE_REF(n) make_cell (tmp_num_ (REF), n, 0)
-
+#define MAKE_CHAR(n) make_cell_ (tmp_num_ (TCHAR), 0, tmp_num2_ (n))
+#define MAKE_CONTINUATION(n) make_cell_ (tmp_num_ (TCONTINUATION), n, g_stack)
+#define MAKE_NUMBER(n) make_cell_ (tmp_num_ (TNUMBER), 0, tmp_num2_ (n))
#define CAAR(x) CAR (CAR (x))
+#define CADR(x) CAR (CDR (x))
#define CDAR(x) CDR (CAR (x))
+#define CDDR(x) CDR (CDR (x))
#define CADAR(x) CAR (CDR (CAR (x)))
#define CADDR(x) CAR (CDR (CDR (x)))
-// #define CDDDR(x) CDR (CDR (CDR (x)))
#define CDADAR(x) CAR (CDR (CAR (CDR (x))))
-#define CADR(x) CAR (CDR (x))
-#define MAKE_STRING(x) make_cell (tmp_num_ (TSTRING), x, 0)
+#define MAKE_STRING(x) make_cell_ (tmp_num_ (TSTRING), x, 0)
SCM
alloc (int n)
{
-#if 1
- //__GNUC__
assert (g_free + n < ARENA_SIZE);
-#endif
SCM x = g_free;
g_free += n;
return x;
#define DEBUG 0
SCM
-make_cell (SCM type, SCM car, SCM cdr)
+tmp_num_ (int x)
+{
+ VALUE (tmp_num) = x;
+ return tmp_num;
+}
+
+SCM
+tmp_num2_ (int x)
+{
+ VALUE (tmp_num2) = x;
+ return tmp_num2;
+}
+
+SCM
+make_cell_ (SCM type, SCM car, SCM cdr)
{
SCM x = alloc (1);
#if __GNUC__
return x;
}
+
SCM
-tmp_num_ (int x)
+make_symbol_ (SCM s) ///((internal))
{
- VALUE (tmp_num) = x;
- return tmp_num;
+ VALUE (tmp_num) = TSYMBOL;
+ SCM x = make_cell_ (tmp_num, s, 0);
+ g_symbols = cons (x, g_symbols);
+ return x;
}
SCM
-tmp_num2_ (int x)
+lookup_symbol_ (SCM s)
{
- VALUE (tmp_num2) = x;
- return tmp_num2;
+ SCM x = g_symbols;
+ while (x) {
+ //if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) break;
+ if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) goto dun;
+ x = cdr (x);
+ }
+ dun:
+ if (x) x = car (x);
+ if (!x) x = make_symbol_ (s);
+ return x;
+}
+
+SCM
+list_of_char_equal_p (SCM a, SCM b) ///((internal))
+{
+ while (a != cell_nil && b != cell_nil && VALUE (car (a)) == VALUE (car (b))) {
+#if __GNUC__
+ assert (TYPE (car (a)) == TCHAR);
+ assert (TYPE (car (b)) == TCHAR);
+#endif
+ a = cdr (a);
+ b = cdr (b);
+ }
+ return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
+}
+
+SCM
+type_ (SCM x)
+{
+ return MAKE_NUMBER (TYPE (x));
+}
+
+SCM
+car_ (SCM x)
+{
+ return (TYPE (x) != TCONTINUATION
+ && (TYPE (CAR (x)) == TPAIR // FIXME: this is weird
+ || TYPE (CAR (x)) == TREF
+ || TYPE (CAR (x)) == TSPECIAL
+ || TYPE (CAR (x)) == TSYMBOL
+ || TYPE (CAR (x)) == TSTRING)) ? CAR (x) : MAKE_NUMBER (CAR (x));
+}
+
+SCM
+cdr_ (SCM x)
+{
+ return (TYPE (CDR (x)) == TPAIR
+ || TYPE (CDR (x)) == TREF
+ || TYPE (CAR (x)) == TSPECIAL
+ || TYPE (CDR (x)) == TSYMBOL
+ || TYPE (CDR (x)) == TSTRING) ? CDR (x) : MAKE_NUMBER (CDR (x));
+}
+
+SCM
+arity_ (SCM x)
+{
+ assert (TYPE (x) == TFUNCTION);
+ return MAKE_NUMBER (FUNCTION (x).arity);
}
SCM
cons (SCM x, SCM y)
{
VALUE (tmp_num) = TPAIR;
- return make_cell (tmp_num, x, y);
+ return make_cell_ (tmp_num, x, y);
}
SCM
}
SCM
-type_ (SCM x)
-{
- return MAKE_NUMBER (TYPE (x));
-}
-
-SCM
-car_ (SCM x)
+values (SCM x) ///((arity . n))
{
- return (TYPE (x) != TCONTINUATION
- && (TYPE (CAR (x)) == TPAIR // FIXME: this is weird
- || TYPE (CAR (x)) == TREF
- || TYPE (CAR (x)) == TSPECIAL
- || TYPE (CAR (x)) == TSYMBOL
- || TYPE (CAR (x)) == TSTRING)) ? CAR (x) : MAKE_NUMBER (CAR (x));
+ SCM v = cons (0, x);
+ TYPE (v) = TVALUES;
+ return v;
}
SCM
-cdr_ (SCM x)
+acons (SCM key, SCM value, SCM alist)
{
- return (TYPE (CDR (x)) == TPAIR
- || TYPE (CDR (x)) == TREF
- || TYPE (CAR (x)) == TSPECIAL
- || TYPE (CDR (x)) == TSYMBOL
- || TYPE (CDR (x)) == TSTRING) ? CDR (x) : MAKE_NUMBER (CDR (x));
+ return cons (cons (key, value), alist);
}
SCM
SCM throw;
if ((throw = assq_ref_env (cell_symbol_throw, r0)) != cell_undefined)
return apply (throw, cons (key, cons (x, cell_nil)), r0);
- eputs ("error");
+ display_ (key);
+ puts (": ");
+ display_ (x);
assert (0);
}
if (e != cell_undefined) return e;
// error (cell_symbol_unbound_variable, x);
eputs ("unbound variable: ");
- display_ (x);
+ display_error_ (x);
eputs ("\n");
exit (33);
return e;
eputs (", got: ");
eputs (itoa (alen));
eputs ("\n");
- display_ (f);
+ display_error_ (f);
SCM e = MAKE_STRING (cstring_to_list (buf));
return error (cell_symbol_wrong_number_of_args, cons (e, f));
}
char buf = "TODO:check_apply";
// sprintf (buf, "cannot apply: %s:", type);
// fprintf (stderr, " [");
- // stderr_ (e);
+ // display_error_ (e);
// fprintf (stderr, "]\n");
eputs ("cannot apply: ");
eputs (type);
eputs ("[");
- display_ (e);
+ display_error_ (e);
eputs ("]\n");
SCM e = MAKE_STRING (cstring_to_list (buf));
return error (cell_symbol_wrong_type_arg, cons (e, f));
if ((FUNCTION (fn).arity > 1 || FUNCTION (fn).arity == -1)
&& x != cell_nil && TYPE (CDR (x)) == TPAIR && TYPE (CADR (x)) == TVALUES)
x = cons (CAR (x), cons (CDADAR (x), CDR (x)));
-#if 0
- eputs ("call: ");
- if (FUNCTION (fn).name) eputs (FUNCTION (fn).name);
- else eputs (itoa (CDR (fn)));
- eputs ("\n");
-#endif
switch (FUNCTION (fn).arity)
{
case 0: {return (FUNCTION (fn).function) ();}
- case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (car (x));}
- case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x));}
- case 3: {return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (car (x), cadr (x), car (cddr (x)));}
+ case 1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (CAR (x));}
+ case 2: {return ((SCM(*)(SCM,SCM))(FUNCTION (fn).function)) (CAR (x), CADR (x));}
+ case 3: {return ((SCM(*)(SCM,SCM,SCM))(FUNCTION (fn).function)) (CAR (x), CADR (x), car (CDDR (x)));}
case -1: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
default: {return ((SCM(*)(SCM))(FUNCTION (fn).function)) (x);}
}
}
SCM
-make_closure (SCM args, SCM body, SCM a)
+make_closure_ (SCM args, SCM body, SCM a) ///((internal))
{
- return make_cell (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
+ return make_cell_ (tmp_num_ (TCLOSURE), cell_f, cons (cons (cell_circular, a), cons (args, body)));
}
SCM
-lookup_macro (SCM x, SCM a)
+lookup_macro_ (SCM x, SCM a) ///((internal))
{
if (TYPE (x) != TSYMBOL) return cell_f;
SCM m = assq_ref_env (x, a);
-#if 0
- if (TYPE (m) == TMACRO)
- {
- fputs ("XXmacro: ", 1);
- fputs ("[", 1);
- fputs (itoa (m), 1);
- fputs ("]: ", 1);
- display_ (m);
- fputs ("\n", 1);
-
- }
-#endif
- if (TYPE (m) == TMACRO) return MACRO (m);
+ if (TYPE (m) == TMACRO) return MACRO (m);
return cell_f;
}
return cell_unspecified;
}
-SCM caar (SCM x) {return car (car (x));}
-SCM cadr (SCM x) {return car (cdr (x));}
-SCM cdar (SCM x) {return cdr (car (x));}
-SCM cddr (SCM x) {return cdr (cdr (x));}
-
SCM gc_pop_frame (); //((internal))
SCM
}
case TCLOSURE:
{
- SCM cl = CLOSURE (car (r1));
- SCM formals = cadr (cl);
- SCM body = cddr (cl);
- SCM aa = cdar (cl);
- aa = cdr (aa);
- check_formals (car (r1), formals, cdr (r1));
- SCM p = pairlis (formals, cdr (r1), aa);
+ SCM cl = CLOSURE (CAR (r1));
+ SCM formals = CADR (cl);
+ SCM body = CDDR (cl);
+ SCM aa = CDAR (cl);
+ aa = CDR (aa);
+ check_formals (CAR (r1), formals, CDR (r1));
+ SCM p = pairlis (formals, CDR (r1), aa);
call_lambda (body, p, aa, r0);
goto begin;
}
x = r1;
g_stack = CONTINUATION (CAR (r1));
gc_pop_frame ();
- r1 = cadr (x);
+ r1 = CADR (x);
goto eval_apply;
}
case TSPECIAL:
}
case TPAIR:
{
- switch (caar (r1))
+ switch (CAAR (r1))
{
case cell_symbol_lambda:
{
- SCM formals = cadr (car (r1));
- SCM body = cddr (car (r1));
+ SCM formals = CADR (car (r1));
+ SCM body = CDDR (car (r1));
SCM p = pairlis (formals, cdr (r1), r0);
check_formals (r1, formals, cdr (r1));
call_lambda (body, p, p, r0);
#endif // FIXED_PRIMITIVES
case cell_symbol_quote:
{
- x = r1; gc_pop_frame (); r1 = cadr (x); goto eval_apply;
+ x = r1; gc_pop_frame (); r1 = CADR (x); goto eval_apply;
}
case cell_symbol_begin: goto begin;
case cell_symbol_lambda:
{
- r1 = make_closure (cadr (r1), cddr (r1), assq (cell_closure, r0));
+ r1 = make_closure_ (CADR (r1), CDDR (r1), assq (cell_closure, r0));
goto vm_return;
}
case cell_symbol_if: {r1=cdr (r1); goto vm_if;}
case cell_symbol_set_x:
{
- push_cc (car (cddr (r1)), r1, r0, cell_vm_eval_set_x);
+ push_cc (car (CDDR (r1)), r1, r0, cell_vm_eval_set_x);
goto eval;
eval_set_x:
x = r2;
- r1 = set_env_x (cadr (x), r1, r0);
+ r1 = set_env_x (CADR (x), r1, r0);
goto vm_return;
}
case cell_vm_macro_expand:
{
- push_cc (cadr (r1), r1, r0, cell_vm_return);
+ push_cc (CADR (r1), r1, r0, cell_vm_return);
goto macro_expand;
}
default: {
SCM expanders;
macro_expand:
if (TYPE (r1) == TPAIR
- && (macro = lookup_macro (car (r1), r0)) != cell_f)
+ && (macro = lookup_macro_ (car (r1), r0)) != cell_f)
{
r1 = cons (macro, CDR (r1));
-#if 0
- puts ("macro: ");
- display_ (macro);
- puts ("\n");
- puts ("r1: ");
- display_ (r1);
- puts ("\n");
-#endif
goto apply;
}
else if (TYPE (r1) == TPAIR
while (r1 != cell_nil) {
if (TYPE (r1) == TPAIR && TYPE (CAR (r1)) == TPAIR)
{
- if (caar (r1) == cell_symbol_begin)
- r1 = append2 (cdar (r1), cdr (r1));
- else if (caar (r1) == cell_symbol_primitive_load)
+ if (CAAR (r1) == cell_symbol_begin)
+ r1 = append2 (CDAR (r1), cdr (r1));
+ else if (CAAR (r1) == cell_symbol_primitive_load)
{
push_cc (cons (cell_symbol_read_input_file, cell_nil), r1, r0, cell_vm_begin_read_input_file);
goto apply;
if (CDR (r1) == cell_nil)
{
r1 = car (r1);
-#if 0
- puts ("begin: ");
- display_ (r1);
- puts ("\n");
-#endif
goto eval;
}
push_cc (CAR (r1), r1, r0, cell_vm_begin2);
r1 = r2;
if (x != cell_f)
{
- r1 = cadr (r1);
+ r1 = CADR (r1);
goto eval;
}
- if (cddr (r1) != cell_nil)
+ if (CDDR (r1) != cell_nil)
{
- r1 = car (cddr (r1));
+ r1 = car (CDDR (r1));
goto eval;
}
r1 = cell_unspecified;
call_with_values2:
if (TYPE (r1) == TVALUES)
r1 = CDR (r1);
- r1 = cons (cadr (r2), r1);
+ r1 = cons (CADR (r2), r1);
goto apply;
vm_return:
SCM
gc_peek_frame () ///((internal))
{
- SCM frame = car (g_stack);
- r1 = car (frame);
- r2 = cadr (frame);
- r3 = car (cddr (frame));
- r0 = cadr (cddr (frame));
+ SCM frame = CAR (g_stack);
+ r1 = CAR (frame);
+ r2 = CADR (frame);
+ r3 = CAR (CDDR (frame));
+ r0 = CADR (CDDR (frame));
return frame;
}
return 0;
}
-SCM
-make_symbol_ (SCM s)
-{
- VALUE (tmp_num) = TSYMBOL;
- SCM x = make_cell (tmp_num, s, 0);
- g_symbols = cons (x, g_symbols);
- return x;
-}
-
-SCM
-list_of_char_equal_p (SCM a, SCM b)
-{
- while (a != cell_nil && b != cell_nil && VALUE (car (a)) == VALUE (car (b))) {
-#if __GNUC__
- assert (TYPE (car (a)) == TCHAR);
- assert (TYPE (car (b)) == TCHAR);
-#endif
- a = cdr (a);
- b = cdr (b);
- }
- return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
-}
-
-SCM
-lookup_symbol_ (SCM s)
-{
- SCM x = g_symbols;
- while (x) {
- //if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) break;
- if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) goto dun;
- x = cdr (x);
- }
- dun:
- if (x) x = car (x);
- return x;
-}
-
-SCM
-make_symbol (SCM s)
-{
- SCM x = lookup_symbol_ (s);
- return x ? x : make_symbol_ (s);
-}
-
-//MINI_MES reader.c
-SCM
-lookup_ (SCM s, SCM a)
-{
- if (isdigit (VALUE (car (s))) || (VALUE (car (s)) == '-' && cdr (s) != cell_nil)) {
- SCM p = s;
- int sign = 1;
- if (VALUE (car (s)) == '-') {
- sign = -1;
- p = cdr (s);
- }
- int n = 0;
- while (p != cell_nil && isdigit (VALUE (car (p)))) {
-#if __GNUC__
- //FIXME
- n *= 10;
- n += VALUE (car (p)) - '0';
-#else
- n = n * 10;
- n = n + VALUE (car (p)) - '0';
-#endif
- p = cdr (p);
- }
- if (p == cell_nil) return MAKE_NUMBER (n * sign);
- }
-
- SCM x = lookup_symbol_ (s);
- return x ? x : make_symbol_ (s);
-}
-
-SCM
-acons (SCM key, SCM value, SCM alist)
-{
- return cons (cons (key, value), alist);
-}
-
//\f Posix
int
ungetchar (int c)
return string_to_cstring_buf;
}
-int g_depth;
-
-SCM
-display_helper (SCM x, int cont, char* sep)
-{
- puts (sep);
- if (g_depth == 0) return cell_unspecified;
- //FIXME:
- //g_depth--;
- g_depth = g_depth - 1;
-
- // eputs ("<display>\n");
- switch (TYPE (x))
- {
- case TCHAR:
- {
- //puts ("<char>\n");
- puts ("#\\");
- putchar (VALUE (x));
- break;
- }
- case TFUNCTION:
- {
- puts ("#<procedure ");
- ///puts (FUNCTION (x).name ? FUNCTION (x).name : "?");
- char *p = "?";
- if (FUNCTION (x).name != 0)
- p = FUNCTION (x).name;
- puts (p);
- puts ("[");
- puts (itoa (CDR (x)));
- puts (",");
- puts (itoa (x));
- puts ("]>");
- break;
- }
- case TMACRO:
- {
- puts ("#<macro ");
- display_helper (cdr (x), cont, "");
- puts (">");
- break;
- }
- case TNUMBER:
- {
- //puts ("<number>\n");
- puts (itoa (VALUE (x)));
- break;
- }
- case TPAIR:
- {
- if (!cont) puts ("(");
- if (x && x != cell_nil) display_ (CAR (x));
- if (CDR (x) && TYPE (CDR (x)) == TPAIR)
- display_helper (CDR (x), 1, " ");
- else if (CDR (x) && CDR (x) != cell_nil)
- {
- if (TYPE (CDR (x)) != TPAIR)
- puts (" . ");
- display_ (CDR (x));
- }
- if (!cont) puts (")");
- break;
- }
- case TSPECIAL:
-#if __NYACC__
- // FIXME
- //{}
- {
- SCM t = CAR (x);
- while (t && t != cell_nil)
- {
- putchar (VALUE (CAR (t)));
- t = CDR (t);
- }
- break;
- }
-#endif
- case TSTRING:
-#if __NYACC__
- // FIXME
- //{}
- {
- SCM t = CAR (x);
- while (t && t != cell_nil)
- {
- putchar (VALUE (CAR (t)));
- t = CDR (t);
- }
- break;
- }
-#endif
- case TSYMBOL:
- {
- SCM t = CAR (x);
- while (t && t != cell_nil)
- {
- putchar (VALUE (CAR (t)));
- t = CDR (t);
- }
- break;
- }
- default:
- {
- //puts ("<default>\n");
- puts ("<");
- puts (itoa (TYPE (x)));
- puts (":");
- puts (itoa (x));
- puts (">");
- break;
- }
- }
- return 0;
-}
-
-SCM
-display_ (SCM x)
-{
- g_depth = 5;
- return display_helper (x, 0, "");
-}
-
-SCM
-stderr_ (SCM x)
-{
- SCM write;
- if (TYPE (x) == TSTRING)
- eputs (string_to_cstring (x));
-#if __GNUC__
- else if ((write = assq_ref_env (cell_symbol_write, r0)) != cell_undefined)
- apply (assq_ref_env (cell_symbol_display, r0), cons (x, cons (MAKE_NUMBER (2), cell_nil)), r0);
-#endif
- else if (TYPE (x) == TSPECIAL || TYPE (x) == TSTRING || TYPE (x) == TSYMBOL)
- eputs (string_to_cstring (x));
- else if (TYPE (x) == TNUMBER)
- eputs (itoa (VALUE (x)));
- else
- eputs ("core:stderr: display undefined\n");
- return cell_unspecified;
-}
-
SCM
getenv_ (SCM s) ///((name . "getenv"))
{
//\f Lib [rest of]
+int g_depth;
+
SCM
-exit_ (SCM x) ///((name . "exit"))
+display_helper (SCM x, int cont, char* sep, int fd)
{
- assert (TYPE (x) == TNUMBER);
- exit (VALUE (x));
+ fputs (sep, fd);
+ if (g_depth == 0) return cell_unspecified;
+ g_depth = g_depth - 1;
+
+ switch (TYPE (x))
+ {
+ case TCHAR:
+ {
+ fputs ("#\\", fd);
+ putc (VALUE (x), fd);
+ break;
+ }
+ case TFUNCTION:
+ {
+ fputs ("#<procedure ", fd);
+ char *p = "?";
+ if (FUNCTION (x).name != 0)
+ p = FUNCTION (x).name;
+ fputs (p, fd);
+ fputs ("[", fd);
+ fputs (itoa (CDR (x)), fd);
+ fputs (",", fd);
+ fputs (itoa (x), fd);
+ fputs ("]>", fd);
+ break;
+ }
+ case TMACRO:
+ {
+ fputs ("#<macro ", fd);
+ display_helper (cdr (x), cont, "", fd);
+ fputs (">", fd);
+ break;
+ }
+ case TNUMBER:
+ {
+ fputs (itoa (VALUE (x)), fd);
+ break;
+ }
+ case TPAIR:
+ {
+ if (!cont) fputs ("(", fd);
+ if (x && x != cell_nil) fdisplay_ (CAR (x), fd);
+ if (CDR (x) && TYPE (CDR (x)) == TPAIR)
+ display_helper (CDR (x), 1, " ", fd);
+ else if (CDR (x) && CDR (x) != cell_nil)
+ {
+ if (TYPE (CDR (x)) != TPAIR)
+ fputs (" . ", fd);
+ fdisplay_ (CDR (x), fd);
+ }
+ if (!cont) fputs (")", fd);
+ break;
+ }
+ case TSPECIAL:
+#if __NYACC__
+ // FIXME
+ //{}
+ {
+ SCM t = CAR (x);
+ while (t && t != cell_nil)
+ {
+ putc (VALUE (CAR (t)), fd);
+ t = CDR (t);
+ }
+ break;
+ }
+#endif
+ case TSTRING:
+#if __NYACC__
+ // FIXME
+ {
+ SCM t = CAR (x);
+ while (t && t != cell_nil)
+ {
+ putc (VALUE (CAR (t)), fd);
+ t = CDR (t);
+ }
+ break;
+ }
+#endif
+ case TSYMBOL:
+ {
+ SCM t = CAR (x);
+ while (t && t != cell_nil)
+ {
+ putc (VALUE (CAR (t)), fd);
+ t = CDR (t);
+ }
+ break;
+ }
+ default:
+ {
+ fputs ("<", fd);
+ fputs (itoa (TYPE (x)), fd);
+ fputs (":", fd);
+ fputs (itoa (x), fd);
+ fputs (">", fd);
+ break;
+ }
+ }
+ return 0;
}
SCM
-append (SCM x) ///((arity . n))
+display_ (SCM x)
{
- if (x == cell_nil) return cell_nil;
- if (cdr (x) == cell_nil) return car (x);
- return append2 (car (x), append (cdr (x)));
+ g_depth = 5;
+ return display_helper (x, 0, "", STDOUT);
}
SCM
-values (SCM x) ///((arity . n))
+display_error_ (SCM x)
{
- SCM v = cons (0, x);
- TYPE (v) = TVALUES;
- return v;
+ g_depth = 5;
+ return display_helper (x, 0, "", STDERR);
}
SCM
-arity_ (SCM x)
+fdisplay_ (SCM x, int fd) ///((internal))
{
- assert (TYPE (x) == TFUNCTION);
- return MAKE_NUMBER (FUNCTION (x).arity);
+ g_depth = 5;
+ return display_helper (x, 0, "", fd);
+}
+
+SCM
+exit_ (SCM x) ///((name . "exit"))
+{
+ assert (TYPE (x) == TNUMBER);
+ exit (VALUE (x));
+}
+
+SCM
+append (SCM x) ///((arity . n))
+{
+ if (x == cell_nil) return cell_nil;
+ if (cdr (x) == cell_nil) return car (x);
+ return append2 (car (x), append (cdr (x)));
}
SCM
{
//puts ("<function>\n");
if (VALUE (x) == 0)
- puts ("make-cell");
+ puts ("core:make-cell");
if (VALUE (x) == 1)
puts ("cons");
if (VALUE (x) == 2)
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
-(define zero (make-cell 2 0 0))
-(define one (make-cell 2 0 1))
-(define pair (make-cell 3 zero one))
-(define zero-list (make-cell 3 zero '()))
+(define zero (core:make-cell 2 0 0))
+(define one (core:make-cell 2 0 1))
+(define pair (core:make-cell 3 zero one))
+(define zero-list (core:make-cell 3 zero '()))
(define v (make-vector 1))
(display v) (newline)
(vector-set! v 0 88)
-(define zero-v-list (make-cell 3 v zero-list))
-(define list (make-cell 3 (make-cell 3 zero one) zero-v-list))
+(define zero-v-list (core:make-cell 3 v zero-list))
+(define list (core:make-cell 3 (make-cell 3 zero one) zero-v-list))
(display "list: ") (display list) (newline)
(display "v: ") (display v) (newline)
(gc)
;;; You should have received a copy of the GNU General Public License
;;; along with Mes. If not, see <http://www.gnu.org/licenses/>.
-(define first (make-cell 0 0 #\F)) (newline)
+(define first (core:make-cell 0 0 #\F)) (newline)
-(define one (make-cell 2 0 1))
+(define one (core:make-cell 2 0 1))
(display "\n one=") (display one) (newline)
-(define two (make-cell 2 0 2))
-(define pair2-nil (make-cell 3 two '()))
+(define two (core:make-cell 2 0 2))
+(define pair2-nil (core:make-cell 3 two '()))
(display "\npair2-nil=") (display pair2-nil) (newline)
(gc-show)
-(define list1-2 (make-cell 3 one pair2-nil))
+(define list1-2 (core:make-cell 3 one pair2-nil))
(display "\nlist1-2=") (display list1-2) (newline)
(gc-show)
-(define three (make-cell 2 0 3))
-(define four (make-cell 2 0 4))
-(define pair4-nil (make-cell 3 four '()))
-(define list3-4 (make-cell 3 three pair4-nil))
-(define list1234 (make-cell 3 list1-2 list3-4))
+(define three (core:make-cell 2 0 3))
+(define four (core:make-cell 2 0 4))
+(define pair4-nil (core:make-cell 3 four '()))
+(define list3-4 (core:make-cell 3 three pair4-nil))
+(define list1234 (core:make-cell 3 list1-2 list3-4))
(gc-show)
(gc list1234)
(gc-show)
(if (= gc-free gc-size) (gc))
((lambda (index)
(set! gc-free (+ gc-free 1))
- (make-cell 'p index))
+ (core:make-cell 'p index))
gc-free))
-(define (make-cell type . x)
+(define (core:make-cell type . x)
(cons type (if (pair? x) (car x) '*)))
(define (cell-index c)
int k = VALUE (n);
g_cells[tmp_num].value = TVECTOR;
SCM v = alloc (k);
- SCM x = make_cell (tmp_num, k, v);
+ SCM x = make_cell_ (tmp_num, k, v);
for (int i=0; i<k; i++) g_cells[v+i] = g_cells[vector_entry (cell_unspecified)];
return x;
}
projects / mes.git / commitdiff