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:
Jan Nieuwenhuizen 2019-11-15 17:45:27 +01:00 committed by Jan (janneke) Nieuwenhuizen
parent 9091d70aad
commit a455aa8f5b
No known key found for this signature in database
GPG Key ID: F3C1A0D9C1D65273
13 changed files with 27 additions and 29 deletions

View File

@ -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_ref (struct scm *var);
struct scm *variable_set_x (struct scm *var, struct scm *value); struct scm *variable_set_x (struct scm *var, struct scm *value);
struct scm *variable_bound_p (struct scm *var); 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_variable (struct scm *name, struct scm *define_p);
struct scm *lookup_ref (struct scm *lookup, struct scm *name); struct scm *lookup_ref (struct scm *name);
/* src/vector.c */ /* src/vector.c */
struct scm *make_vector (struct scm *x); struct scm *make_vector (struct scm *x);
struct scm *vector_length (struct scm *x); struct scm *vector_length (struct scm *x);

View File

@ -127,7 +127,7 @@ struct scm *cell_ref (struct scm *cell, long index);
struct scm *fdisplay_ (struct scm *, int, int); struct scm *fdisplay_ (struct scm *, int, int);
struct scm *init_symbols (); struct scm *init_symbols ();
struct scm *init_time (struct scm *a); 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_builtin_type ();
struct scm *make_bytes (char const *s, size_t length); struct scm *make_bytes (char const *s, size_t length);
struct scm *make_cell (long type, struct scm *car, struct scm *cdr); struct scm *make_cell (long type, struct scm *car, struct scm *cdr);

View File

@ -30,7 +30,7 @@
(define mes %version) (define mes %version)
(define (defined? x) (define (defined? x)
(lookup-variable (current-module) x #f)) (lookup-variable x #f))
(define (cond-expand-expander clauses) (define (cond-expand-expander clauses)
(if (defined? (car (car clauses))) (if (defined? (car (car clauses)))

View File

@ -20,7 +20,7 @@
(define mes %version) (define mes %version)
(define (defined? x) (define (defined? x)
(lookup-variable (current-module) x #f)) (lookup-variable x #f))
(define (cond-expand-expander clauses) (define (cond-expand-expander clauses)
(if (defined? (car (car clauses))) (if (defined? (car (car clauses)))

View File

@ -20,7 +20,7 @@
(define mes %version) (define mes %version)
(define (defined? x) (define (defined? x)
(lookup-variable (current-module) x #f)) (lookup-variable x #f))
(define (cond-expand-expander clauses) (define (cond-expand-expander clauses)
(if (defined? (car (car clauses))) (if (defined? (car (car clauses)))

View File

@ -30,7 +30,7 @@
(define mes %version) (define mes %version)
(define (defined? x) (define (defined? x)
(lookup-variable (current-module) x #f)) (lookup-variable x #f))
(define (cond-expand-expander clauses) (define (cond-expand-expander clauses)
(if (defined? (car (car clauses))) (if (defined? (car (car clauses)))

View File

@ -30,7 +30,7 @@
(define mes %version) (define mes %version)
(define (defined? x) (define (defined? x)
(lookup-variable (current-module) x #f)) (lookup-variable x #f))
(define (cond-expand-expander clauses) (define (cond-expand-expander clauses)
(if (defined? (car (car clauses))) (if (defined? (car (car clauses)))

View File

@ -28,7 +28,7 @@
(if (null? lst) (list) (if (null? lst) (list)
(cons (f (car lst)) (map f (cdr lst))))) (cons (f (car lst)) (map f (cdr lst)))))
(define (closure x) (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 (x t) #t)
(define (xx x1 x2) (define (xx x1 x2)

View File

@ -20,7 +20,7 @@
(define mes %version) (define mes %version)
(define (defined? x) (define (defined? x)
(lookup-variable (current-module) x #f)) (lookup-variable x #f))
(define (cond-expand-expander clauses) (define (cond-expand-expander clauses)
(if (defined? (car (car clauses))) (if (defined? (car (car clauses)))

View File

@ -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-ref", 1, &variable_ref, a);
a = init_builtin (builtin_type, "variable-set!", 2, &variable_set_x, 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, "variable-bound?", 1, &variable_bound_p, a);
a = init_builtin (builtin_type, "lookup-variable", 3, &lookup_variable, a); a = init_builtin (builtin_type, "lookup-variable", 2, &lookup_variable, a);
a = init_builtin (builtin_type, "lookup-ref", 2, &lookup_ref, a); a = init_builtin (builtin_type, "lookup-ref", 1, &lookup_ref, a);
/* src/vector.c */ /* src/vector.c */
a = init_builtin (builtin_type, "make-vector", -1, &make_vector, a); a = init_builtin (builtin_type, "make-vector", -1, &make_vector, a);
a = init_builtin (builtin_type, "vector-length", 1, &vector_length, a); a = init_builtin (builtin_type, "vector-length", 1, &vector_length, a);

View File

@ -149,7 +149,7 @@ struct scm *
error (struct scm *key, struct scm *x) error (struct scm *key, struct scm *x)
{ {
#if !__MESC_MES__ && !__M2_PLANET__ #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) if (throw != cell_f)
return apply (throw->cdr, cons (key, cons (x, cell_nil)), R0); return apply (throw->cdr, cons (key, cons (x, cell_nil)), R0);
#endif #endif

View File

@ -120,7 +120,7 @@ set_x (struct scm *x, struct scm *e) /*:((internal)) */
p = x->variable; p = x->variable;
else else
{ {
p = lookup_variable (R0, x, cell_f); p = lookup_variable (x, cell_f);
if (p == cell_f || p-> cdr == cell_undefined) if (p == cell_f || p-> cdr == cell_undefined)
error (cell_symbol_unbound_variable, x); 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 && a != cell_symbol_primitive_load
&& formal_p (x->car, formals) == 0) && formal_p (x->car, formals) == 0)
{ {
v = lookup_variable (R0, a, cell_f); v = lookup_variable (a, cell_f);
if (v != cell_f) if (v != cell_f)
x->car = make_variable (v); x->car = make_variable (v);
} }
@ -617,7 +617,7 @@ eval:
macro_set_x (name, entry); macro_set_x (name, entry);
} }
else else
entry = lookup_variable (R0, name, cell_t); entry = lookup_variable (name, cell_t);
} }
R2 = R1; R2 = R1;
aa = R1->cdr->car; aa = R1->cdr->car;
@ -651,7 +651,7 @@ eval:
} }
else if (global_p != 0) else if (global_p != 0)
{ {
entry = lookup_variable (R0, name, cell_f); entry = lookup_variable (name, cell_f);
set_cdr_x (entry, R1); set_cdr_x (entry, R1);
} }
else else
@ -660,7 +660,7 @@ eval:
aa = cons (entry, cell_nil); aa = cons (entry, cell_nil);
set_cdr_x (aa, cdr (R0)); set_cdr_x (aa, cdr (R0));
set_cdr_x (R0, aa); 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); set_cdr_x (cl, aa);
} }
R1 = cell_unspecified; R1 = cell_unspecified;
@ -685,7 +685,7 @@ eval:
goto vm_return; goto vm_return;
if (R1 == cell_symbol_call_with_current_continuation) if (R1 == cell_symbol_call_with_current_continuation)
goto vm_return; goto vm_return;
R1 = lookup_ref (R0, R1); R1 = lookup_ref (R1);
goto vm_return; goto vm_return;
} }
else if (t == TVARIABLE) else if (t == TVARIABLE)
@ -758,13 +758,13 @@ macro_expand:
macro = macro_get_handle (cell_symbol_portable_macro_expand); macro = macro_get_handle (cell_symbol_portable_macro_expand);
if (macro != cell_f) 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) if (expanders != cell_f)
{ {
macro = assq (R1->car, expanders); macro = assq (R1->car, expanders);
if (macro != cell_f) if (macro != cell_f)
{ {
sc_expand = lookup_ref (R0, cell_symbol_macro_expand); sc_expand = lookup_ref (cell_symbol_macro_expand);
R2 = R1; R2 = R1;
if (sc_expand != cell_undefined && sc_expand != cell_f) if (sc_expand != cell_undefined && sc_expand != cell_f)
{ {

View File

@ -51,11 +51,9 @@ variable_bound_p (struct scm *var)
} }
struct scm * 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; struct scm *handle = handle = assq (name, R0);
if (lookup->type = TPAIR)
handle = assq (name, lookup);
if (handle == cell_f) if (handle == cell_f)
{ {
@ -68,15 +66,15 @@ lookup_variable (struct scm *lookup, struct scm *name, struct scm *define_p)
} }
struct scm * 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 * 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) if (x == cell_f)
error (cell_symbol_unbound_variable, name); error (cell_symbol_unbound_variable, name);
return x->cdr; return x->cdr;