core: Use variables for modules.
This change introduces a 'lexical?' field for bindings (called 'lexical_p' and stored in the cdr of the binding cell). Non-lexical bindings handle variables transparently, while lexical bindings do not. * src/module.c (module_define_x): Wrap value in a variable. * include/mes/mes.h (scm): Add 'lexical_p' to the cdr union. (set_x): New declaration. * src/eval-apply.c (make_binding_): Add a 'lexical_p' argument. (lookup_handle): Remove function. (lookup_binding): Add function. (lookup_value): Use 'lookup_binding' and return the contents of variables that are not bound lexically. (set_env_x): Remove function. (set_x): New function. (expand_variable_): Use 'lookup_binding' in place of 'lookup_handle'. (eval_apply): Likewise; use 'set_x' in place of 'set_env_x'; and when evaluating a binding, return the contents of variables that are not bound lexically. * include/mes/builtins.h (set_env_x): Remove declaration. * src/builtins.c (mes_builtins): Do not register 'set-env!'. * scaffold/boot/53-closure-display.scm (closure)[mes]: Rewrite to avoid 'module-variable'.
This commit is contained in:
parent
5edef591b7
commit
c18b95620a
|
@ -53,7 +53,6 @@ struct scm *write_port_ (struct scm *x, struct scm *p);
|
|||
struct scm *pairlis (struct scm *x, struct scm *y, struct scm *a);
|
||||
struct scm *set_car_x (struct scm *x, struct scm *e);
|
||||
struct scm *set_cdr_x (struct scm *x, struct scm *e);
|
||||
struct scm *set_env_x (struct scm *x, struct scm *e, struct scm *a);
|
||||
struct scm *add_formals (struct scm *formals, struct scm *x);
|
||||
struct scm *eval_apply ();
|
||||
/* src/gc.c */
|
||||
|
|
|
@ -50,6 +50,7 @@ struct scm
|
|||
long value;
|
||||
FUNCTION function;
|
||||
struct scm *vector;
|
||||
long lexical_p; /* for bindings */
|
||||
};
|
||||
};
|
||||
|
||||
|
@ -131,7 +132,7 @@ struct scm *cell_ref (struct scm *cell, long index);
|
|||
struct scm *fdisplay_ (struct scm *, int, int);
|
||||
struct scm *init_symbols ();
|
||||
struct scm *init_time (struct scm *a);
|
||||
struct scm *lookup_handle (struct scm *name);
|
||||
struct scm *lookup_binding (struct scm *name);
|
||||
struct scm *lookup_value (struct scm *name);
|
||||
struct scm *make_builtin_type ();
|
||||
struct scm *make_bytes (char const *s, size_t length);
|
||||
|
@ -153,6 +154,7 @@ struct scm *make_variable_type ();
|
|||
struct scm *make_vector_ (long k, struct scm *e);
|
||||
struct scm *mes_builtins (struct scm *a);
|
||||
struct scm *push_cc (struct scm *p1, struct scm *p2, struct scm *a, struct scm *c);
|
||||
struct scm *set_x (struct scm *x, struct scm *e);
|
||||
struct scm *struct_ref_ (struct scm *x, long i);
|
||||
struct scm *struct_set_x_ (struct scm *x, long i, struct scm *e);
|
||||
struct scm *vector_ref_ (struct scm *x, long i);
|
||||
|
|
|
@ -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 x))))))))
|
||||
|
||||
(define (x t) #t)
|
||||
(define (xx x1 x2)
|
||||
|
|
|
@ -163,7 +163,6 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
|||
a = init_builtin (builtin_type, "pairlis", 3, &pairlis, a);
|
||||
a = init_builtin (builtin_type, "set-car!", 2, &set_car_x, a);
|
||||
a = init_builtin (builtin_type, "set-cdr!", 2, &set_cdr_x, a);
|
||||
a = init_builtin (builtin_type, "set-env!", 3, &set_env_x, a);
|
||||
a = init_builtin (builtin_type, "add-formals", 2, &add_formals, a);
|
||||
a = init_builtin (builtin_type, "eval-apply", 0, &eval_apply, a);
|
||||
/* src/gc.c */
|
||||
|
|
|
@ -122,16 +122,24 @@ set_cdr_x (struct scm *x, struct scm *e)
|
|||
}
|
||||
|
||||
struct scm *
|
||||
set_env_x (struct scm *x, struct scm *e, struct scm *a)
|
||||
set_x (struct scm *x, struct scm *e)
|
||||
{
|
||||
struct scm *p;
|
||||
struct scm *binding;
|
||||
|
||||
if (x->type == TBINDING)
|
||||
p = x->binding;
|
||||
binding = x;
|
||||
else
|
||||
p = assert_defined (x, lookup_handle (x));
|
||||
if (p->type != TPAIR)
|
||||
error (cell_symbol_not_a_pair, cons (p, x));
|
||||
return set_cdr_x (p, e);
|
||||
binding = lookup_binding (x);
|
||||
|
||||
if (binding == cell_f)
|
||||
return error (cell_symbol_unbound_variable, x);
|
||||
|
||||
if (binding->lexical_p != 0)
|
||||
set_cdr_x (binding->binding, e);
|
||||
else
|
||||
variable_set_x (binding->binding->cdr, e);
|
||||
|
||||
return cell_unspecified;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
|
@ -150,9 +158,11 @@ make_closure_ (struct scm *args, struct scm *body, struct scm *a) /*:((int
|
|||
}
|
||||
|
||||
struct scm *
|
||||
make_binding_ (struct scm *handle) /*:((internal)) */
|
||||
make_binding_ (struct scm *handle, long lexical_p) /*:((internal)) */
|
||||
{
|
||||
return make_cell (TBINDING, handle, 0);
|
||||
struct scm *binding = make_cell (TBINDING, handle, 0);
|
||||
binding->lexical_p = lexical_p;
|
||||
return binding;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
|
@ -195,22 +205,30 @@ push_cc (struct scm *p1, struct scm *p2, struct scm *a, struct scm *c) /*:((int
|
|||
}
|
||||
|
||||
struct scm *
|
||||
lookup_handle (struct scm *name)
|
||||
lookup_binding (struct scm *name)
|
||||
{
|
||||
struct scm *handle = assq (name, R0);
|
||||
if (handle == cell_f)
|
||||
{
|
||||
handle = module_variable (M0, name);
|
||||
}
|
||||
return handle;
|
||||
if (handle != cell_f)
|
||||
return make_binding_ (handle, 1);
|
||||
|
||||
handle = module_variable (M0, name);
|
||||
if (handle != cell_f)
|
||||
return make_binding_ (handle, 0);
|
||||
|
||||
return cell_f;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
lookup_value (struct scm *name)
|
||||
{
|
||||
struct scm *handle = lookup_handle (name);
|
||||
if (handle != cell_f)
|
||||
return handle->cdr;
|
||||
struct scm *binding = lookup_binding (name);
|
||||
if (binding != cell_f)
|
||||
{
|
||||
if (binding->lexical_p != 0)
|
||||
return binding->binding->cdr;
|
||||
else
|
||||
return variable_ref (binding->binding->cdr);
|
||||
}
|
||||
return cell_undefined;
|
||||
}
|
||||
|
||||
|
@ -295,9 +313,9 @@ expand_variable_ (struct scm *x, struct scm *formals, int top_p) /*:((int
|
|||
&& a != cell_symbol_primitive_load
|
||||
&& formal_p (x->car, formals) == 0)
|
||||
{
|
||||
v = lookup_handle (a);
|
||||
v = lookup_binding (a);
|
||||
if (v != cell_f)
|
||||
x->car = make_binding_ (v);
|
||||
x->car = v;
|
||||
}
|
||||
}
|
||||
x = x->cdr;
|
||||
|
@ -607,7 +625,7 @@ eval:
|
|||
push_cc (R1->cdr->cdr->car, R1, R0, cell_vm_eval_set_x);
|
||||
goto eval;
|
||||
eval_set_x:
|
||||
R1 = set_env_x (R2->cdr->car, R1, R0);
|
||||
R1 = set_x (R2->cdr->car, R1);
|
||||
goto vm_return;
|
||||
}
|
||||
else if (c == cell_vm_macro_expand)
|
||||
|
@ -645,7 +663,7 @@ eval:
|
|||
}
|
||||
else
|
||||
{
|
||||
entry = lookup_handle (name);
|
||||
entry = lookup_binding (name);
|
||||
if (entry == cell_f)
|
||||
module_define_x (M0, name, cell_f);
|
||||
}
|
||||
|
@ -682,8 +700,7 @@ eval:
|
|||
}
|
||||
else if (global_p != 0)
|
||||
{
|
||||
entry = lookup_handle (name);
|
||||
set_cdr_x (entry, R1);
|
||||
set_x (name, R1);
|
||||
}
|
||||
else
|
||||
{
|
||||
|
@ -691,8 +708,7 @@ eval:
|
|||
aa = cons (entry, cell_nil);
|
||||
set_cdr_x (aa, cdr (R0));
|
||||
set_cdr_x (R0, aa);
|
||||
cl = lookup_handle (cell_closure);
|
||||
set_cdr_x (cl, aa);
|
||||
set_x (cell_closure, aa);
|
||||
}
|
||||
R1 = cell_unspecified;
|
||||
goto vm_return;
|
||||
|
@ -721,8 +737,10 @@ eval:
|
|||
}
|
||||
else if (t == TBINDING)
|
||||
{
|
||||
x = R1->binding;
|
||||
R1 = x->cdr;
|
||||
if (R1->lexical_p != 0)
|
||||
R1 = R1->binding->cdr;
|
||||
else
|
||||
R1 = variable_ref (R1->binding->cdr);
|
||||
goto vm_return;
|
||||
}
|
||||
else if (t == TBROKEN_HEART)
|
||||
|
|
|
@ -106,5 +106,6 @@ 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);
|
||||
struct scm *var = make_variable (value);
|
||||
return hashq_set_x (globals, name, var);
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue