core: Remove make_module_type, module_printer, module_variable, module_ref.
* src/module.c (make_module_type, module_printer, module_variable, module_ref): Remove. * include/mes/builtins.h: Remove declarations. * src/builtins.c (mes_builtins): Remove registrations. * src/eval-apply.c (assert_defined): Remove. (set_env_x, eval_apply): Use lookup_variable and variable_ref. * src/core.c (error): Likewise. * mes/module/mes/boot-01.scm (defined?): Likewise. * mes/module/mes/boot-02.scm (defined?): Likewise. * mes/module/mes/boot-03.scm (defined?): Likewise. * mes/module/mes/boot-0.scm (defined?): Likewise. * scaffold/boot/53-closure-display.scm (guile): Likewise. * scaffold/boot/60-let-syntax-expanded.scm (defined?): Likewise. * src/mes.c (main): Use hash_table_printer for debugging.
This commit is contained in:
parent
19d31a1020
commit
ea9d231335
|
@ -101,10 +101,6 @@ struct scm *lognot (struct scm *x);
|
|||
struct scm *logxor (struct scm *x);
|
||||
struct scm *ash (struct scm *n, struct scm *count);
|
||||
/* src/module.c */
|
||||
struct scm *make_module_type ();
|
||||
struct scm *module_printer (struct scm *module);
|
||||
struct scm *module_variable (struct scm *module, struct scm *name);
|
||||
struct scm *module_ref (struct scm *module, struct scm *name);
|
||||
struct scm *module_define_x (struct scm *module, struct scm *name, struct scm *value);
|
||||
/* src/posix.c */
|
||||
struct scm *abort_ ();
|
||||
|
|
|
@ -70,7 +70,7 @@ struct scm *R1;
|
|||
struct scm *R2;
|
||||
/* continuation */
|
||||
struct scm *R3;
|
||||
/* current-module */
|
||||
/* initial module */
|
||||
struct scm *M0;
|
||||
/* macro */
|
||||
struct scm *g_macros;
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(module-variable (current-module) x))
|
||||
(lookup-variable (current-module) x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(module-variable (current-module) x))
|
||||
(lookup-variable (current-module) x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(module-variable (current-module) x))
|
||||
(lookup-variable (current-module) x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(module-variable (current-module) x))
|
||||
(lookup-variable (current-module) x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(module-variable (current-module) x))
|
||||
(lookup-variable (current-module) x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -28,7 +28,7 @@
|
|||
(if (null? lst) (list)
|
||||
(cons (f (car lst)) (map f (cdr lst)))))
|
||||
(define (closure x)
|
||||
(map car (cdr (core:cdr (core:car (core:cdr (cdr (module-variable (current-module) 'x))))))))))
|
||||
(map car (cdr (core:cdr (core:car (core:cdr (cdr (lookup-variable (current-module) 'x #f))))))))))
|
||||
|
||||
(define (x t) #t)
|
||||
(define (xx x1 x2)
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(module-variable (current-module) x))
|
||||
(lookup-variable (current-module) x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -211,10 +211,6 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
|||
a = init_builtin (builtin_type, "logxor", -1, &logxor, a);
|
||||
a = init_builtin (builtin_type, "ash", 2, &ash, a);
|
||||
/* src/module.c */
|
||||
a = init_builtin (builtin_type, "make-module-type", 0, &make_module_type, a);
|
||||
a = init_builtin (builtin_type, "module-printer", 1, &module_printer, a);
|
||||
a = init_builtin (builtin_type, "module-variable", 2, &module_variable, a);
|
||||
a = init_builtin (builtin_type, "module-ref", 2, &module_ref, a);
|
||||
a = init_builtin (builtin_type, "module-define!", 3, &module_define_x, a);
|
||||
/* src/posix.c */
|
||||
a = init_builtin (builtin_type, "abort", 0, &abort_, a);
|
||||
|
|
|
@ -149,9 +149,9 @@ struct scm *
|
|||
error (struct scm *key, struct scm *x)
|
||||
{
|
||||
#if !__MESC_MES__ && !__M2_PLANET__
|
||||
struct scm *throw = module_ref (R0, cell_symbol_throw);
|
||||
if (throw != cell_undefined)
|
||||
return apply (throw, cons (key, cons (x, cell_nil)), R0);
|
||||
struct scm *throw = lookup_variable (R0, cell_symbol_throw, cell_f);
|
||||
if (throw != cell_f)
|
||||
return apply (throw->cdr, cons (key, cons (x, cell_nil)), R0);
|
||||
#endif
|
||||
display_error_ (key);
|
||||
eputs (": ");
|
||||
|
|
|
@ -23,14 +23,6 @@
|
|||
|
||||
#include <string.h>
|
||||
|
||||
struct scm *
|
||||
assert_defined (struct scm *x, struct scm *e) /*:((internal)) */
|
||||
{
|
||||
if (e == cell_undefined)
|
||||
return error (cell_symbol_unbound_variable, x);
|
||||
return e;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
check_formals (struct scm *f, struct scm *formals, struct scm *args) /*:((internal)) */
|
||||
{
|
||||
|
@ -127,7 +119,11 @@ set_env_x (struct scm *x, struct scm *e, struct scm *a)
|
|||
if (x->type == TVARIABLE)
|
||||
p = x->variable;
|
||||
else
|
||||
p = assert_defined (x, module_variable (a, x));
|
||||
{
|
||||
p = lookup_variable (a, x, cell_f);
|
||||
if (p == cell_f || p-> cdr == cell_undefined)
|
||||
error (cell_symbol_unbound_variable, x);
|
||||
}
|
||||
if (p->type != TPAIR)
|
||||
error (cell_symbol_not_a_pair, cons (p, x));
|
||||
return set_cdr_x (p, e);
|
||||
|
@ -269,7 +265,7 @@ expand_variable_ (struct scm *x, struct scm *formals, int top_p) /*:((int
|
|||
&& a != cell_symbol_primitive_load
|
||||
&& formal_p (x->car, formals) == 0)
|
||||
{
|
||||
v = module_variable (R0, a);
|
||||
v = lookup_variable (R0, a, cell_f);
|
||||
if (v != cell_f)
|
||||
x->car = make_variable (v);
|
||||
}
|
||||
|
@ -508,6 +504,7 @@ apply:
|
|||
}
|
||||
if (c == cell_symbol_current_module)
|
||||
{
|
||||
/* FIXME: TODO */
|
||||
R1 = R0;
|
||||
goto vm_return;
|
||||
}
|
||||
|
@ -623,11 +620,7 @@ eval:
|
|||
macro_set_x (name, cell_f);
|
||||
}
|
||||
else
|
||||
{
|
||||
entry = module_variable (R0, name);
|
||||
if (entry == cell_f)
|
||||
module_define_x (M0, name, cell_f);
|
||||
}
|
||||
entry = lookup_variable (R0, name, cell_t);
|
||||
}
|
||||
R2 = R1;
|
||||
aa = R1->cdr->car;
|
||||
|
@ -661,7 +654,7 @@ eval:
|
|||
}
|
||||
else if (global_p != 0)
|
||||
{
|
||||
entry = module_variable (R0, name);
|
||||
entry = lookup_variable (R0, name, cell_f);
|
||||
set_cdr_x (entry, R1);
|
||||
}
|
||||
else
|
||||
|
@ -670,7 +663,7 @@ eval:
|
|||
aa = cons (entry, cell_nil);
|
||||
set_cdr_x (aa, cdr (R0));
|
||||
set_cdr_x (R0, aa);
|
||||
cl = module_variable (R0, cell_closure);
|
||||
cl = lookup_variable (R0, cell_closure, cell_f);
|
||||
set_cdr_x (cl, aa);
|
||||
}
|
||||
R1 = cell_unspecified;
|
||||
|
@ -697,13 +690,12 @@ eval:
|
|||
goto vm_return;
|
||||
if (R1 == cell_symbol_call_with_current_continuation)
|
||||
goto vm_return;
|
||||
R1 = assert_defined (R1, module_ref (R0, R1));
|
||||
R1 = lookup_ref (R0, R1);
|
||||
goto vm_return;
|
||||
}
|
||||
else if (t == TVARIABLE)
|
||||
{
|
||||
x = R1->variable;
|
||||
R1 = x->cdr;
|
||||
R1 = variable_ref (R1);
|
||||
goto vm_return;
|
||||
}
|
||||
else if (t == TBROKEN_HEART)
|
||||
|
@ -771,13 +763,13 @@ macro_expand:
|
|||
macro = macro_get_handle (cell_symbol_portable_macro_expand);
|
||||
if (macro != cell_f)
|
||||
{
|
||||
expanders = module_ref (R0, cell_symbol_sc_expander_alist);
|
||||
if (expanders != cell_undefined)
|
||||
expanders = lookup_ref (R0, cell_symbol_sc_expander_alist);
|
||||
if (expanders != cell_f)
|
||||
{
|
||||
macro = assq (R1->car, expanders);
|
||||
if (macro != cell_f)
|
||||
{
|
||||
sc_expand = module_ref (R0, cell_symbol_macro_expand);
|
||||
sc_expand = lookup_ref (R0, cell_symbol_macro_expand);
|
||||
R2 = R1;
|
||||
if (sc_expand != cell_undefined && sc_expand != cell_f)
|
||||
{
|
||||
|
@ -884,7 +876,7 @@ begin_expand:
|
|||
push_cc (input, R2, R0, cell_vm_return);
|
||||
x = read_input_file_env (R0);
|
||||
if (g_debug > 5)
|
||||
module_printer (M0);
|
||||
hash_table_printer (R0);
|
||||
gc_pop_frame ();
|
||||
input = R1;
|
||||
R1 = x;
|
||||
|
|
1
src/gc.c
1
src/gc.c
|
@ -731,7 +731,6 @@ gc_dump_state ()
|
|||
gc_dump_register ("R1", R1);
|
||||
gc_dump_register ("R2", R2);
|
||||
gc_dump_register ("R3", R3);
|
||||
gc_dump_register ("M0", M0);
|
||||
gc_dump_register ("g_symbols", g_symbols);
|
||||
gc_dump_register ("g_symbol_max", g_symbol_max);
|
||||
gc_dump_register ("g_macros", g_macros);
|
||||
|
|
|
@ -189,10 +189,11 @@ main (int argc, char **argv, char **envp)
|
|||
a = mes_builtins (a);
|
||||
a = init_time (a);
|
||||
M0 = make_initial_module (a);
|
||||
R0 = cell_nil;
|
||||
g_macros = make_hash_table_ (0);
|
||||
|
||||
if (g_debug > 5)
|
||||
module_printer (M0);
|
||||
hash_table_printer (M0);
|
||||
|
||||
struct scm *program = read_boot ();
|
||||
R0 = acons (cell_symbol_program, program, R0);
|
||||
|
@ -216,7 +217,7 @@ main (int argc, char **argv, char **envp)
|
|||
if (g_debug != 0)
|
||||
{
|
||||
if (g_debug > 5)
|
||||
module_printer (M0);
|
||||
hash_table_printer (M0);
|
||||
|
||||
if (g_debug < 3)
|
||||
gc_stats_ ("\ngc run");
|
||||
|
|
82
src/module.c
82
src/module.c
|
@ -21,96 +21,20 @@
|
|||
#include "mes/lib.h"
|
||||
#include "mes/mes.h"
|
||||
|
||||
struct scm *
|
||||
make_module_type () /*:(internal)) */
|
||||
{
|
||||
struct scm *fields = cell_nil;
|
||||
fields = cons (cstring_to_symbol ("globals"), fields);
|
||||
fields = cons (cstring_to_symbol ("locals"), fields);
|
||||
fields = cons (cstring_to_symbol ("name"), fields);
|
||||
fields = cons (fields, cell_nil);
|
||||
fields = cons (cell_symbol_module, fields);
|
||||
return make_struct (cell_symbol_record_type, fields, cell_unspecified);
|
||||
}
|
||||
|
||||
struct scm *
|
||||
make_initial_module (struct scm *a) /*:((internal)) */
|
||||
{
|
||||
struct scm *module_type = make_module_type ();
|
||||
a = acons (cell_symbol_module, module_type, a);
|
||||
|
||||
struct scm *hash_table_type = scm_hash_table_type;
|
||||
a = acons (cell_symbol_hashq_table, hash_table_type, a);
|
||||
|
||||
struct scm *name = cons (cstring_to_symbol ("boot"), cell_nil);
|
||||
struct scm *globals = make_hash_table_ (0);
|
||||
struct scm *locals = cell_nil;
|
||||
|
||||
struct scm *values = cell_nil;
|
||||
values = cons (globals, values);
|
||||
values = cons (locals, values);
|
||||
values = cons (name, values);
|
||||
values = cons (cell_symbol_module, values);
|
||||
struct scm *module = make_struct (module_type, values, cstring_to_symbol ("module-printer"));
|
||||
R0 = cell_nil;
|
||||
R0 = cons (a->cdr->car, R0);
|
||||
R0 = cons (a->car, R0);
|
||||
M0 = module;
|
||||
struct scm *module = make_hash_table_ (100);
|
||||
while (a->type == TPAIR)
|
||||
{
|
||||
module_define_x (module, a->car->car, a->car->cdr);
|
||||
hashq_set_x (module, a->car->car, a->car->cdr);
|
||||
a = a->cdr;
|
||||
}
|
||||
|
||||
return module;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
module_printer (struct scm *module)
|
||||
{
|
||||
fdputs ("#<", __stdout);
|
||||
display_ (struct_ref_ (module, 2));
|
||||
fdputc (' ', __stdout);
|
||||
fdputs ("name: ", __stdout);
|
||||
display_ (struct_ref_ (module, 3));
|
||||
fdputc (' ', __stdout);
|
||||
fdputs ("locals: ", __stdout);
|
||||
display_ (struct_ref_ (module, 4));
|
||||
fdputc (' ', __stdout);
|
||||
struct scm *table = struct_ref_ (module, 5);
|
||||
fdputs ("globals:\n ", __stdout);
|
||||
display_ (table);
|
||||
fdputc ('>', __stdout);
|
||||
}
|
||||
|
||||
struct scm *
|
||||
module_variable (struct scm *module, struct scm *name)
|
||||
{
|
||||
/*struct scm *locals = struct_ref_ (module, 3);*/
|
||||
struct scm *locals = module;
|
||||
struct scm *x = assq (name, locals);
|
||||
if (x == cell_f)
|
||||
{
|
||||
module = M0;
|
||||
struct scm *globals = struct_ref_ (module, 5);
|
||||
x = hashq_get_handle_ (globals, name, cell_f);
|
||||
}
|
||||
return x;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
module_ref (struct scm *module, struct scm *name)
|
||||
{
|
||||
struct scm *x = module_variable (module, name);
|
||||
if (x == cell_f)
|
||||
return cell_undefined;
|
||||
return x->cdr;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
module_define_x (struct scm *module, struct scm *name, struct scm *value)
|
||||
{
|
||||
module = M0;
|
||||
struct scm *globals = struct_ref_ (module, 5);
|
||||
return hashq_set_x (globals, name, value);
|
||||
return hashq_set_x (M0, name, value);
|
||||
}
|
||||
|
|
|
@ -43,7 +43,6 @@ test_setup ()
|
|||
g_ports = cell_zero;
|
||||
g_macros = cell_zero;
|
||||
g_stack = STACK_SIZE;
|
||||
M0 = cell_zero;
|
||||
|
||||
memset (g_arena + sizeof (struct scm), 0, ARENA_SIZE * sizeof (struct scm));
|
||||
cell_zero->type = TCHAR;
|
||||
|
@ -185,7 +184,6 @@ main (int argc, char **argv, char **envp)
|
|||
g_ports = cell_zero;
|
||||
g_macros = cell_zero;
|
||||
g_stack = STACK_SIZE;
|
||||
M0 = cell_zero;
|
||||
|
||||
test_empty ();
|
||||
test_number ();
|
||||
|
|
|
@ -25,7 +25,8 @@ struct scm *
|
|||
variable_ref (struct scm *var)
|
||||
{
|
||||
assert_variable (1, var);
|
||||
struct scm *value = var->variable;
|
||||
struct scm *ref = var->variable;
|
||||
struct scm *value = ref->cdr;
|
||||
if (value == cell_undefined)
|
||||
error (cell_symbol_unbound_variable, var);
|
||||
return value;
|
||||
|
|
Loading…
Reference in New Issue