core: Add lookup_variable_, lookup_variable, lookup_ref.
* src/variable.c (lookup_variable, lookup_ref): New builtins, and (lookup_variable_): New function. * include/mes/builtins.h: Declare them. * include/mes/mes.h: Declare it. * src/builtins.c (mes_builtins): Register them.
This commit is contained in:
parent
be2357b1f4
commit
19d31a1020
|
@ -178,6 +178,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_ref (struct scm *lookup, 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);
|
||||||
|
|
|
@ -127,6 +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 *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);
|
||||||
|
|
|
@ -288,6 +288,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-ref", 2, &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);
|
||||||
|
|
|
@ -48,3 +48,35 @@ variable_bound_p (struct scm *var)
|
||||||
return cell_t;
|
return cell_t;
|
||||||
return cell_f;
|
return cell_f;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
struct scm *
|
||||||
|
lookup_variable (struct scm *lookup, struct scm *name, struct scm *define_p)
|
||||||
|
{
|
||||||
|
struct scm *handle = cell_f;
|
||||||
|
if (lookup->type = TPAIR)
|
||||||
|
handle = assq (name, lookup);
|
||||||
|
|
||||||
|
if (handle == cell_f)
|
||||||
|
{
|
||||||
|
handle = hashq_get_handle_ (M0, name, cell_f);
|
||||||
|
if (handle == cell_f && define_p == cell_t)
|
||||||
|
handle = hashq_set_handle_x (M0, name, cell_f);
|
||||||
|
}
|
||||||
|
|
||||||
|
return handle;
|
||||||
|
}
|
||||||
|
|
||||||
|
struct scm *
|
||||||
|
lookup_variable_ (struct scm *lookup, char const* name)
|
||||||
|
{
|
||||||
|
return lookup_variable (lookup, cstring_to_symbol (name), cell_f);
|
||||||
|
}
|
||||||
|
|
||||||
|
struct scm *
|
||||||
|
lookup_ref (struct scm *lookup, struct scm *name)
|
||||||
|
{
|
||||||
|
struct scm *x = lookup_variable (lookup, name, cell_f);
|
||||||
|
if (x == cell_f)
|
||||||
|
error (cell_symbol_unbound_variable, name);
|
||||||
|
return x->cdr;
|
||||||
|
}
|
||||||
|
|
Loading…
Reference in New Issue