DRAFT core: Refactor lookup_variable.
* src/variable.c (lookup_variable, lookup_variable_, lookup_ref): Drop lookup/env parameter. Update users. * src/builtins.c (mes_builtins): Update registration. * include/mes/builtins.h: Update declarations. * include/mes/mes.h: Likewise.
This commit is contained in:
parent
10c21b3564
commit
2da91c01a0
|
@ -174,8 +174,8 @@ struct scm *struct_set_x (struct scm *x, struct scm *i, struct scm *e);
|
|||
struct scm *variable_ref (struct scm *var);
|
||||
struct scm *variable_set_x (struct scm *var, struct scm *value);
|
||||
struct scm *variable_bound_p (struct scm *var);
|
||||
struct scm *lookup_variable (struct scm *lookup, struct scm *name, struct scm *define_p);
|
||||
struct scm *lookup_ref (struct scm *lookup, struct scm *name);
|
||||
struct scm *lookup_variable (struct scm *name, struct scm *define_p);
|
||||
struct scm *lookup_ref (struct scm *name);
|
||||
/* src/vector.c */
|
||||
struct scm *make_vector (struct scm *x);
|
||||
struct scm *vector_length (struct scm *x);
|
||||
|
|
|
@ -124,10 +124,11 @@ struct scm *builtin_name (struct scm *builtin);
|
|||
struct scm *cstring_to_list (char const *s);
|
||||
struct scm *cstring_to_symbol (char const *s);
|
||||
struct scm *cell_ref (struct scm *cell, long index);
|
||||
struct scm *deep_variable_ref (struct scm *var);
|
||||
struct scm *fdisplay_ (struct scm *, int, int);
|
||||
struct scm *init_symbols ();
|
||||
struct scm *init_time (struct scm *a);
|
||||
struct scm *lookup_variable_ (struct scm *lookup, char const* name);
|
||||
struct scm *lookup_variable_ (char const* name);
|
||||
struct scm *make_builtin_type ();
|
||||
struct scm *make_bytes (char const *s, size_t length);
|
||||
struct scm *make_cell (long type, struct scm *car, struct scm *cdr);
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable (current-module) x #f))
|
||||
(lookup-variable x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable (current-module) x #f))
|
||||
(lookup-variable x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable (current-module) x #f))
|
||||
(lookup-variable x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable (current-module) x #f))
|
||||
(lookup-variable x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable (current-module) x #f))
|
||||
(lookup-variable x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -125,7 +125,10 @@
|
|||
(display ">" port))
|
||||
((variable? x)
|
||||
(display "#<variable " port)
|
||||
(write (list->string (car (core:car x))) port)
|
||||
(if (pair? (core:car x)) (display (car (core:car x)) port)
|
||||
(begin
|
||||
(display "value: " port)
|
||||
(display (core:car x) port)))
|
||||
(display ">" port))
|
||||
((number? x)
|
||||
(display (number->string x) port))
|
||||
|
|
|
@ -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 (lookup-variable (current-module) 'x #f))))))))))
|
||||
(map car (cdr (core:cdr (core:car (core:cdr (cdr (lookup-variable 'x #f))))))))))
|
||||
|
||||
(define (x t) #t)
|
||||
(define (xx x1 x2)
|
||||
|
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable (current-module) x #f))
|
||||
(lookup-variable x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
@ -284,8 +284,8 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
|||
a = init_builtin (builtin_type, "variable-ref", 1, &variable_ref, a);
|
||||
a = init_builtin (builtin_type, "variable-set!", 2, &variable_set_x, a);
|
||||
a = init_builtin (builtin_type, "variable-bound?", 1, &variable_bound_p, a);
|
||||
a = init_builtin (builtin_type, "lookup-variable", 3, &lookup_variable, a);
|
||||
a = init_builtin (builtin_type, "lookup-ref", 2, &lookup_ref, a);
|
||||
a = init_builtin (builtin_type, "lookup-variable", 2, &lookup_variable, a);
|
||||
a = init_builtin (builtin_type, "lookup-ref", 1, &lookup_ref, a);
|
||||
/* src/vector.c */
|
||||
a = init_builtin (builtin_type, "make-vector", -1, &make_vector, a);
|
||||
a = init_builtin (builtin_type, "vector-length", 1, &vector_length, a);
|
||||
|
|
|
@ -149,7 +149,7 @@ struct scm *
|
|||
error (struct scm *key, struct scm *x)
|
||||
{
|
||||
#if !__MESC_MES__ && !__M2_PLANET__
|
||||
struct scm *throw = lookup_variable (R0, cell_symbol_throw, cell_f);
|
||||
struct scm *throw = lookup_variable (cell_symbol_throw, cell_f);
|
||||
if (throw != cell_f)
|
||||
return apply (throw->cdr, cons (key, cons (x, cell_nil)), R0);
|
||||
#endif
|
||||
|
|
|
@ -139,7 +139,13 @@ display_helper (struct scm *x, int cont, char *sep, int fd, int write_p)
|
|||
else if (t == TVARIABLE)
|
||||
{
|
||||
fdputs ("#<variable ", fd);
|
||||
if (x->variable->type == TPAIR)
|
||||
display_helper (x->variable->car, cont, "", fd, 0);
|
||||
else
|
||||
{
|
||||
fdputs ("value: ", fd);
|
||||
display_helper (x->variable, cont, "", fd, 0);
|
||||
}
|
||||
fdputs (">", fd);
|
||||
}
|
||||
else if (t == TNUMBER)
|
||||
|
|
|
@ -120,7 +120,7 @@ set_x (struct scm *x, struct scm *e) /*:((internal)) */
|
|||
p = x->variable;
|
||||
else
|
||||
{
|
||||
p = lookup_variable (R0, x, cell_f);
|
||||
p = lookup_variable (x, cell_f);
|
||||
if (p == cell_f || p-> cdr == cell_undefined)
|
||||
error (cell_symbol_unbound_variable, x);
|
||||
}
|
||||
|
@ -264,7 +264,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 = lookup_variable (R0, a, cell_f);
|
||||
v = lookup_variable (a, cell_f);
|
||||
if (v != cell_f)
|
||||
x->car = make_variable (v);
|
||||
}
|
||||
|
@ -609,12 +609,15 @@ eval:
|
|||
name = name->car;
|
||||
if (macro_p != 0)
|
||||
{
|
||||
entry = cell_f;
|
||||
/* FIXME: dead code; no tests
|
||||
entry = assq (name, g_macros);
|
||||
if (entry == cell_f)
|
||||
macro_set_x (name, cell_f);
|
||||
*/
|
||||
macro_set_x (name, entry);
|
||||
}
|
||||
else
|
||||
entry = lookup_variable (R0, name, cell_t);
|
||||
entry = lookup_variable (name, cell_t);
|
||||
}
|
||||
R2 = R1;
|
||||
aa = R1->cdr->car;
|
||||
|
@ -648,7 +651,7 @@ eval:
|
|||
}
|
||||
else if (global_p != 0)
|
||||
{
|
||||
entry = lookup_variable (R0, name, cell_f);
|
||||
entry = lookup_variable (name, cell_f);
|
||||
set_cdr_x (entry, R1);
|
||||
}
|
||||
else
|
||||
|
@ -657,7 +660,7 @@ eval:
|
|||
aa = cons (entry, cell_nil);
|
||||
set_cdr_x (aa, cdr (R0));
|
||||
set_cdr_x (R0, aa);
|
||||
cl = lookup_variable (R0, cell_closure, cell_f);
|
||||
cl = lookup_variable (cell_closure, cell_f);
|
||||
set_cdr_x (cl, aa);
|
||||
}
|
||||
R1 = cell_unspecified;
|
||||
|
@ -682,12 +685,12 @@ eval:
|
|||
goto vm_return;
|
||||
if (R1 == cell_symbol_call_with_current_continuation)
|
||||
goto vm_return;
|
||||
R1 = lookup_ref (R0, R1);
|
||||
R1 = lookup_ref (R1);
|
||||
goto vm_return;
|
||||
}
|
||||
else if (t == TVARIABLE)
|
||||
{
|
||||
R1 = variable_ref (R1);
|
||||
R1 = deep_variable_ref (R1);
|
||||
goto vm_return;
|
||||
}
|
||||
else if (t == TBROKEN_HEART)
|
||||
|
@ -755,13 +758,13 @@ macro_expand:
|
|||
macro = macro_get_handle (cell_symbol_portable_macro_expand);
|
||||
if (macro != cell_f)
|
||||
{
|
||||
expanders = lookup_ref (R0, cell_symbol_sc_expander_alist);
|
||||
expanders = lookup_ref (cell_symbol_sc_expander_alist);
|
||||
if (expanders != cell_f)
|
||||
{
|
||||
macro = assq (R1->car, expanders);
|
||||
if (macro != cell_f)
|
||||
{
|
||||
sc_expand = lookup_ref (R0, cell_symbol_macro_expand);
|
||||
sc_expand = lookup_ref (cell_symbol_macro_expand);
|
||||
R2 = R1;
|
||||
if (sc_expand != cell_undefined && sc_expand != cell_f)
|
||||
{
|
||||
|
|
|
@ -39,7 +39,7 @@ struct scm *
|
|||
car_ (struct scm *x)
|
||||
{
|
||||
struct scm *a = x->car;
|
||||
if (x->type == TPAIR)
|
||||
if (x->type == TPAIR || x->type == TCLOSURE || x->type == TVARIABLE)
|
||||
return a;
|
||||
return make_number (cast_scmp_to_long (a));
|
||||
}
|
||||
|
|
|
@ -22,11 +22,23 @@
|
|||
#include "mes/mes.h"
|
||||
|
||||
struct scm *
|
||||
variable_ref (struct scm *var)
|
||||
deep_variable_ref (struct scm *var)
|
||||
{
|
||||
assert_variable (1, var);
|
||||
struct scm *ref = var->variable;
|
||||
struct scm *value = ref->cdr;
|
||||
if (value == cell_undefined)
|
||||
error (cell_symbol_unbound_variable, var);
|
||||
if (value->type == TVARIABLE)
|
||||
value = value->variable;
|
||||
return value;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
variable_ref (struct scm *var)
|
||||
{
|
||||
assert_variable (1, var);
|
||||
struct scm *value = var->variable;
|
||||
if (value == cell_undefined)
|
||||
error (cell_symbol_unbound_variable, var);
|
||||
return value;
|
||||
|
@ -51,11 +63,9 @@ variable_bound_p (struct scm *var)
|
|||
}
|
||||
|
||||
struct scm *
|
||||
lookup_variable (struct scm *lookup, struct scm *name, struct scm *define_p)
|
||||
lookup_variable (struct scm *name, struct scm *define_p)
|
||||
{
|
||||
struct scm *handle = cell_f;
|
||||
if (lookup->type = TPAIR)
|
||||
handle = assq (name, lookup);
|
||||
struct scm *handle = handle = assq (name, R0);
|
||||
|
||||
if (handle == cell_f)
|
||||
{
|
||||
|
@ -68,15 +78,15 @@ lookup_variable (struct scm *lookup, struct scm *name, struct scm *define_p)
|
|||
}
|
||||
|
||||
struct scm *
|
||||
lookup_variable_ (struct scm *lookup, char const* name)
|
||||
lookup_variable_ (char const* name)
|
||||
{
|
||||
return lookup_variable (lookup, cstring_to_symbol (name), cell_f);
|
||||
return lookup_variable (cstring_to_symbol (name), cell_f);
|
||||
}
|
||||
|
||||
struct scm *
|
||||
lookup_ref (struct scm *lookup, struct scm *name)
|
||||
lookup_ref (struct scm *name)
|
||||
{
|
||||
struct scm *x = lookup_variable (lookup, name, cell_f);
|
||||
struct scm *x = lookup_variable (name, cell_f);
|
||||
if (x == cell_f)
|
||||
error (cell_symbol_unbound_variable, name);
|
||||
return x->cdr;
|
||||
|
|
Loading…
Reference in New Issue