WIP: module integration
This commit is contained in:
Jan Nieuwenhuizen
Jan (janneke) Nieuwenhuizen
parent
8d06a90396
commit
447a258b48
|
|
@ -175,8 +175,8 @@ struct scm *variable_ref (struct scm *var);
|
|||
struct scm *flat_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 *name, struct scm *define_p);
|
||||
struct scm *lookup_ref (struct scm *name);
|
||||
struct scm *lookup_handle (struct scm *name, struct scm* define_p);
|
||||
struct scm *lookup_ref (struct scm *name, struct scm* bound_p);
|
||||
/* src/vector.c */
|
||||
struct scm *make_vector (struct scm *x);
|
||||
struct scm *vector_length (struct scm *x);
|
||||
|
|
|
|||
|
|
@ -73,6 +73,12 @@
|
|||
// CONSTANT FRAME_PROCEDURE 4
|
||||
#define FRAME_PROCEDURE 4
|
||||
|
||||
// CONSTANT MODULE_DEFINES = 3
|
||||
#define MODULE_DEFINES 3
|
||||
|
||||
// CONSTANT MODULE_USES = 4
|
||||
#define MODULE_USES 4
|
||||
|
||||
// CONSTANT STDIN 0
|
||||
// CONSTANT STDOUT 1
|
||||
// CONSTANT STDERR 2
|
||||
|
|
|
|||
|
|
@ -121,13 +121,16 @@ struct scm *apply_builtin1 (struct scm *fn, struct scm *x);
|
|||
struct scm *apply_builtin2 (struct scm *fn, struct scm *x, struct scm *y);
|
||||
struct scm *apply_builtin3 (struct scm *fn, struct scm *x, struct scm *y, struct scm *z);
|
||||
struct scm *builtin_name (struct scm *builtin);
|
||||
struct scm *cell_ref (struct scm *cell, long index);
|
||||
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 *current_module ();
|
||||
struct scm *fdisplay_ (struct scm *, int, int);
|
||||
struct scm *handle_set_x (struct scm *name, struct scm *value);
|
||||
struct scm *init_symbols ();
|
||||
struct scm *init_time (struct scm *a);
|
||||
struct scm *lookup_variable_ (char const* name);
|
||||
struct scm *lookup_handle (struct scm *name, struct scm *define_p);
|
||||
struct scm *lookup_ref_ (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);
|
||||
|
|
@ -146,6 +149,9 @@ struct scm *make_string0 (char const *s);
|
|||
struct scm *make_string_port (struct scm *x);
|
||||
struct scm *make_vector_ (long k, struct scm *e);
|
||||
struct scm *mes_builtins (struct scm *a);
|
||||
struct scm *module_defines (struct scm *module);
|
||||
struct scm *module_handle (struct scm *module, struct scm *name);
|
||||
struct scm *module_variable (struct scm *module, struct scm *name);
|
||||
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);
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable x #f))
|
||||
(lookup-handle x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable x #f))
|
||||
(lookup-handle x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable x #f))
|
||||
(lookup-handle x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable x #f))
|
||||
(lookup-handle x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
|||
|
|
@ -30,7 +30,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable x #f))
|
||||
(lookup-handle x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
|||
|
|
@ -149,20 +149,18 @@
|
|||
|
||||
(define guile:current-module (make-fluid #f))
|
||||
|
||||
(define lookup-global #f)
|
||||
(define (global-lookup-function name define?)
|
||||
;; (if define? (module-make-local-var! (guile:current-module) name)
|
||||
;; (module-variable (guile:current-module) name))
|
||||
'("boe")
|
||||
)
|
||||
(define module-system-booted? #f)
|
||||
(define *current-module* #f)
|
||||
|
||||
(define (set-current-module m)
|
||||
(display "set-current-module: name=")
|
||||
(display (module-name m))
|
||||
(display "\n")
|
||||
(let ((o (guile:current-module)))
|
||||
(guile:current-module m)
|
||||
;; (unless o
|
||||
;; (set! lookup-global global-lookup-function))
|
||||
(set! *current-module* m)
|
||||
(unless o
|
||||
(set! module-system-booted? #t))
|
||||
o))
|
||||
|
||||
(define (make-hook . n)
|
||||
|
|
@ -1232,7 +1230,14 @@
|
|||
(if (and variable (variable-bound? variable))
|
||||
(variable-ref variable)
|
||||
(if (null? rest)
|
||||
(error "No variable named" name 'in module)
|
||||
(begin
|
||||
(when variable
|
||||
(display "Variable's value is undefined: " (current-error-port))
|
||||
(display name (current-error-port))
|
||||
(display ": " (current-error-port))
|
||||
(write variable (current-error-port))
|
||||
(display "\n" (current-error-port)))
|
||||
(error "No variable named" name 'in module))
|
||||
(car rest) ; default value
|
||||
))))
|
||||
|
||||
|
|
@ -2725,13 +2730,25 @@
|
|||
(define-module (guile-user) #:use-module (boo))
|
||||
|
||||
(display "\nnow in guile-user\n")
|
||||
(display "ZEE:")
|
||||
;;(display ((module-ref (guile:current-module) 'ZEE-MODULE)))
|
||||
;;(display (module-ref (resolve-module '(boo)) 'ZEE-MODULE))
|
||||
(display "keil-user: ")
|
||||
(write *current-module*)
|
||||
(display "\n")
|
||||
(display "ZEE-MODULE:")
|
||||
(display ((module-ref (guile:current-module) 'ZEE-MODULE)))
|
||||
;; (display (module-ref (resolve-module '(boo)) 'ZEE-MODULE))
|
||||
;; (display "\n")
|
||||
(ZEE-MODULE)
|
||||
;; (ZEE-MODULE)
|
||||
(display "\n")
|
||||
(display "bah: ")
|
||||
;;(display (module-ref (guile:current-module) 'bah))
|
||||
(display bah)
|
||||
(display (module-ref (guile:current-module) 'bah))
|
||||
;;(display bah)
|
||||
(display "\n")
|
||||
|
||||
|
||||
;; (display "===> ZEE\n")
|
||||
;; (display ZEE-MODULE)
|
||||
;; (display "\n")
|
||||
|
||||
;; (display "===> (ZEE)\n")
|
||||
;; (display (ZEE-MODULE))
|
||||
;; (display "\n")
|
||||
|
|
|
|||
|
|
@ -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 'x #f))))))))))
|
||||
(map car (cdr (core:cdr (core:car (core:cdr (cdr (lookup-handle 'x #f))))))))))
|
||||
|
||||
(define (x t) #t)
|
||||
(define (xx x1 x2)
|
||||
|
|
|
|||
|
|
@ -20,7 +20,7 @@
|
|||
(define mes %version)
|
||||
|
||||
(define (defined? x)
|
||||
(lookup-variable x #f))
|
||||
(lookup-handle x #f))
|
||||
|
||||
(define (cond-expand-expander clauses)
|
||||
(if (defined? (car (car clauses)))
|
||||
|
|
|
|||
|
|
@ -285,8 +285,8 @@ mes_builtins (struct scm *a) /*:((internal)) */
|
|||
a = init_builtin (builtin_type, "flat-variable-ref", 1, &flat_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", 2, &lookup_variable, a);
|
||||
a = init_builtin (builtin_type, "lookup-ref", 1, &lookup_ref, a);
|
||||
a = init_builtin (builtin_type, "lookup-handle", 2, &lookup_handle, a);
|
||||
a = init_builtin (builtin_type, "lookup-ref", 2, &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,9 +149,9 @@ struct scm *
|
|||
error (struct scm *key, struct scm *x)
|
||||
{
|
||||
#if !__MESC_MES__ && !__M2_PLANET__
|
||||
struct scm *throw = lookup_variable (cell_symbol_throw, cell_f);
|
||||
struct scm *throw = lookup_ref (cell_symbol_throw, cell_f);
|
||||
if (throw != cell_f)
|
||||
return apply (throw->cdr, cons (key, cons (x, cell_nil)), R0);
|
||||
return apply (throw, cons (key, cons (x, cell_nil)), R0);
|
||||
#endif
|
||||
display_error_ (key);
|
||||
eputs (": ");
|
||||
|
|
|
|||
|
|
@ -120,8 +120,8 @@ set_x (struct scm *x, struct scm *e) /*:((internal)) */
|
|||
p = x->variable;
|
||||
else
|
||||
{
|
||||
p = lookup_variable (x, cell_f);
|
||||
if (p == cell_f || p-> cdr == cell_undefined)
|
||||
p = lookup_handle (x, cell_f);
|
||||
if (p == cell_f || p->cdr == cell_undefined)
|
||||
error (cell_symbol_unbound_variable, x);
|
||||
}
|
||||
if (p->type != TPAIR)
|
||||
|
|
@ -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 (a, cell_f);
|
||||
v = lookup_handle (a, cell_f);
|
||||
if (v != cell_f)
|
||||
x->car = make_variable (v);
|
||||
}
|
||||
|
|
@ -323,7 +323,7 @@ eval_apply ()
|
|||
struct scm *args;
|
||||
struct scm *body;
|
||||
struct scm *cl;
|
||||
struct scm *entry;
|
||||
struct scm *handle;
|
||||
struct scm *expanders;
|
||||
struct scm *formals;
|
||||
struct scm *input;
|
||||
|
|
@ -630,15 +630,15 @@ eval:
|
|||
name = name->car;
|
||||
if (macro_p != 0)
|
||||
{
|
||||
entry = cell_f;
|
||||
handle = cell_f;
|
||||
/* FIXME: dead code; no tests
|
||||
entry = assq (name, g_macros);
|
||||
if (entry == cell_f)
|
||||
handle = assq (name, g_macros);
|
||||
if (handle == cell_f)
|
||||
*/
|
||||
macro_set_x (name, entry);
|
||||
macro_set_x (name, handle);
|
||||
}
|
||||
else
|
||||
entry = lookup_variable (name, cell_t);
|
||||
lookup_handle (name, cell_t);
|
||||
}
|
||||
R2 = R1;
|
||||
aa = R1->cdr->car;
|
||||
|
|
@ -666,14 +666,24 @@ eval:
|
|||
name = name->car;
|
||||
if (macro_p != 0)
|
||||
{
|
||||
entry = macro_get_handle (name);
|
||||
handle = macro_get_handle (name);
|
||||
R1 = make_macro (name, R1);
|
||||
set_cdr_x (entry, R1);
|
||||
set_cdr_x (handle, R1);
|
||||
}
|
||||
else if (global_p != 0)
|
||||
{
|
||||
entry = lookup_variable (name, cell_f);
|
||||
set_cdr_x (entry, R1);
|
||||
handle = lookup_handle (name, cell_f);
|
||||
if (g_debug > 0)
|
||||
{
|
||||
eputs ("global set: ");
|
||||
write_error_ (name);
|
||||
eputs ("\n");
|
||||
}
|
||||
#if 0
|
||||
set_cdr_x (handle, R1);
|
||||
#else
|
||||
handle_set_x (handle, R1);
|
||||
#endif
|
||||
}
|
||||
else
|
||||
{
|
||||
|
|
@ -685,11 +695,11 @@ eval:
|
|||
eputs ("\n");
|
||||
}
|
||||
#endif
|
||||
entry = cons (name, R1);
|
||||
aa = cons (entry, cell_nil);
|
||||
handle = cons (name, R1);
|
||||
aa = cons (handle, cell_nil);
|
||||
set_cdr_x (aa, cdr (R0));
|
||||
set_cdr_x (R0, aa);
|
||||
cl = lookup_variable (cell_closure, cell_f);
|
||||
cl = lookup_handle (cell_closure, cell_f);
|
||||
set_cdr_x (cl, aa);
|
||||
}
|
||||
R1 = cell_unspecified;
|
||||
|
|
@ -714,7 +724,7 @@ eval:
|
|||
goto vm_return;
|
||||
if (R1 == cell_symbol_call_with_current_continuation)
|
||||
goto vm_return;
|
||||
R1 = lookup_ref (R1);
|
||||
R1 = lookup_ref (R1, cell_t);
|
||||
goto vm_return;
|
||||
}
|
||||
else if (t == TVARIABLE)
|
||||
|
|
@ -787,15 +797,15 @@ macro_expand:
|
|||
macro = macro_get_handle (cell_symbol_portable_macro_expand);
|
||||
if (macro != cell_f)
|
||||
{
|
||||
expanders = lookup_ref (cell_symbol_sc_expander_alist);
|
||||
if (expanders != cell_f)
|
||||
expanders = lookup_ref (cell_symbol_sc_expander_alist, cell_f);
|
||||
if (expanders != cell_undefined)
|
||||
{
|
||||
macro = assq (R1->car, expanders);
|
||||
if (macro != cell_f)
|
||||
{
|
||||
sc_expand = lookup_ref (cell_symbol_macro_expand);
|
||||
sc_expand = lookup_ref (cell_symbol_macro_expand, cell_f);
|
||||
R2 = R1;
|
||||
if (sc_expand != cell_undefined && sc_expand != cell_f)
|
||||
if (sc_expand != cell_undefined && sc_expand != cell_undefined)
|
||||
{
|
||||
R1 = cons (sc_expand, cons (R1, cell_nil));
|
||||
goto apply;
|
||||
|
|
|
|||
129
src/module.c
129
src/module.c
|
|
@ -39,72 +39,89 @@ initial_module ()
|
|||
return M0;
|
||||
}
|
||||
|
||||
// struct scm *
|
||||
// module_define_x (struct scm *module, struct scm *name, struct scm *value)
|
||||
// {
|
||||
// return hashq_set_x (M0, name, value);
|
||||
// }
|
||||
|
||||
// struct scm *
|
||||
// scm_module_lookup_closure (struct scm *module)
|
||||
// {
|
||||
// if (module == cell_f)
|
||||
// return cell_f;
|
||||
// else
|
||||
// return struct_ref (module, MODULE_EVAL_CLOSURE);
|
||||
// }
|
||||
|
||||
// struct scm *
|
||||
// scm_current_module_lookup_closure ()
|
||||
// {
|
||||
// if (scm_module_system_booted_p)
|
||||
// return scm_module_lookup_closure (scm_current_module ());
|
||||
// return cell_f;
|
||||
// }
|
||||
|
||||
// struct scm *
|
||||
// scm_eval_closure_lookup (struct scm *eclo, struct scm *name, struct scm *define_p)
|
||||
// {
|
||||
// struct scm *module = eclo;
|
||||
// if (define_p == cell_f)
|
||||
// return module_variable (module, name);
|
||||
// else
|
||||
// {
|
||||
// #if 0
|
||||
// if (struct scm *_EVAL_CLOSURE_INTERFACE_P (eclo))
|
||||
// return struct cell_f;
|
||||
// #endif
|
||||
// return apply (module_make_local_var_x_var, cons (module, cons (name, cell_nil)));
|
||||
// }
|
||||
// }
|
||||
struct scm *
|
||||
current_module () /*:((internal)) */
|
||||
{
|
||||
/* struct scm *booted_p = hashq_get_handle_ (M0, cstring_to_symbol ("module-system-booted?"), cell_f);
|
||||
if (booted_p->type == TPAIR && booted_p->cdr != cell_f)
|
||||
{
|
||||
*/
|
||||
struct scm *module = hashq_get_handle_ (M0, cstring_to_symbol ("*current-module*"), cell_f);
|
||||
if (module->type == TPAIR && module->cdr != cell_f)
|
||||
return module->cdr;
|
||||
/*
|
||||
}
|
||||
*/
|
||||
return M0;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
module_variable (struct scm *module, struct scm *name)
|
||||
module_defines (struct scm *module) /*:((internal)) */
|
||||
{
|
||||
/* 1. Check module obarray */
|
||||
struct scm *a = struct_ref_ (module, MODULE_OBARRAY);
|
||||
struct scm *b = scm_hashq_ref (a, name, cell_f);
|
||||
if (b != cell_f)
|
||||
return b;
|
||||
if (module != cell_f && module != M0)
|
||||
return struct_ref_ (module, MODULE_DEFINES);
|
||||
return M0;
|
||||
}
|
||||
|
||||
// /* 2. Custom binder */
|
||||
// struct scm *binder = struct_ref (module, MODULE_BINDER);
|
||||
// if (binder != cell_f)
|
||||
// {
|
||||
// b = apply (binder->cdr, (cons (module, cons (name, cons (cell_f, cell_nil)))), cell_f);
|
||||
// if (b != cell_f)
|
||||
// return b;
|
||||
// }
|
||||
struct scm *
|
||||
module_define_x (struct scm *module, struct scm *name, struct scm *value)
|
||||
{
|
||||
struct scm *table = module_defines (module);
|
||||
return hashq_set_x (table, name, value);
|
||||
}
|
||||
|
||||
/* 3. Search the use list */
|
||||
struct scm *uses = struct_ref (module, MODULE_USES);
|
||||
while (uses->type == TPAIR)
|
||||
struct scm *
|
||||
module_handle (struct scm *module, struct scm *name) /*:((internal)) */
|
||||
{
|
||||
/* 1. Check module defines. */
|
||||
struct scm *table = module_defines (module);
|
||||
if (g_debug > 0)
|
||||
{
|
||||
b = module_variable (uses->car, name);
|
||||
eputs ("module_handle:");
|
||||
eputs (" name = ");
|
||||
write_error_ (name);
|
||||
// eputs (" defines = ");
|
||||
// write_error_ (table);
|
||||
eputs ("\n");
|
||||
}
|
||||
|
||||
struct scm *handle = hashq_get_handle_ (table, name, cell_f);
|
||||
if (handle != cell_f)
|
||||
return handle;
|
||||
|
||||
/* 2. Custom binder. */
|
||||
/*
|
||||
struct scm *binder = struct_ref (module, MODULE_BINDER);
|
||||
if (binder != cell_f)
|
||||
{
|
||||
b = apply (binder->cdr, (cons (module, cons (name, cons (cell_f, cell_nil)))), cell_f);
|
||||
if (b != cell_f)
|
||||
return b;
|
||||
}
|
||||
*/
|
||||
|
||||
/* 3. Search the use list. */
|
||||
struct scm *uses = struct_ref_ (module, MODULE_USES);
|
||||
while (uses->type == TPAIR)
|
||||
{
|
||||
handle = module_handle (uses->car, name);
|
||||
if (handle != cell_f)
|
||||
return handle;
|
||||
uses = uses->cdr;
|
||||
}
|
||||
|
||||
/* 4. Hack for Mes: always look in M0. */
|
||||
handle = hashq_get_handle_ (M0, name, cell_f);
|
||||
|
||||
return handle;
|
||||
}
|
||||
|
||||
/* NOT USED? */
|
||||
struct scm *
|
||||
module_variable (struct scm *module, struct scm *name)
|
||||
{
|
||||
struct scm *handle = module_handle (module, name);
|
||||
if (handle != cell_f)
|
||||
return handle->cdr;
|
||||
return cell_f;
|
||||
}
|
||||
|
|
|
|||
116
src/variable.c
116
src/variable.c
|
|
@ -45,9 +45,32 @@ flat_variable_ref (struct scm *var)
|
|||
struct scm *
|
||||
variable_set_x (struct scm *var, struct scm *value)
|
||||
{
|
||||
#if 0
|
||||
assert_variable (1, var);
|
||||
var->variable = value;
|
||||
return cell_unspecified;
|
||||
#else
|
||||
if (g_debug > 0)
|
||||
{
|
||||
eputs ("variable-set!");
|
||||
write_error_ (var);
|
||||
eputs ("\n");
|
||||
}
|
||||
if (var->type == TPAIR)
|
||||
{
|
||||
struct scm *x = var->cdr;
|
||||
if (x->type == TVARIABLE)
|
||||
x->variable = value;
|
||||
else
|
||||
//set_cdr_x (var, value);
|
||||
var->cdr = value;
|
||||
}
|
||||
else if (var->type == TVARIABLE)
|
||||
var->variable = value;
|
||||
else
|
||||
assert_variable (1, var);
|
||||
return cell_unspecified;
|
||||
#endif
|
||||
}
|
||||
|
||||
struct scm *
|
||||
|
|
@ -61,30 +84,65 @@ variable_bound_p (struct scm *var)
|
|||
}
|
||||
|
||||
struct scm *
|
||||
lookup_variable (struct scm *name, struct scm *define_p)
|
||||
handle_set_x (struct scm *handle, struct scm *value)
|
||||
{
|
||||
#if 0
|
||||
struct scm *x = handle->cdr;
|
||||
if (x->type == TVARIABLE)
|
||||
x->variable = value;
|
||||
else
|
||||
handle->cdr = value;
|
||||
return cell_unspecified;
|
||||
#else
|
||||
if (g_debug > 0)
|
||||
{
|
||||
eputs ("variable-set!");
|
||||
write_error_ (handle);
|
||||
eputs ("\n");
|
||||
}
|
||||
if (handle->type == TPAIR)
|
||||
{
|
||||
struct scm *x = handle->cdr;
|
||||
if (x->type == TVARIABLE)
|
||||
x->variable = value;
|
||||
else
|
||||
//set_cdr_x (handle, value);
|
||||
handle->cdr = value;
|
||||
}
|
||||
else if (handle->type == TVARIABLE)
|
||||
handle->variable = value;
|
||||
else
|
||||
assert_variable (1, handle);
|
||||
return cell_unspecified;
|
||||
#endif
|
||||
}
|
||||
|
||||
/*
|
||||
GUILE has `proc': scm_current_module -> scm_module_lookup_closure -> standard-eval-closure:
|
||||
|
||||
BUT: define-p: module-make-local-var!, !define-p: module-variable
|
||||
|
||||
*/
|
||||
struct scm *
|
||||
lookup_handle (struct scm *name, struct scm *define_p)
|
||||
{
|
||||
struct scm *handle = handle = assq (name, R0);
|
||||
|
||||
if (handle == cell_f)
|
||||
{
|
||||
struct scm *lookup = hashq_get_handle_ (M0, cstring_to_symbol ("lookup-global"), cell_f);
|
||||
if (lookup != cell_f && lookup->cdr != cell_f)
|
||||
struct scm *module = current_module ();
|
||||
if (define_p == cell_f)
|
||||
{
|
||||
eputs ("lookup? ");
|
||||
display_error_ (lookup);
|
||||
eputs (" ... \n");
|
||||
handle = apply (lookup->cdr, cons (name, cons (define_p, cell_nil)), R0);
|
||||
eputs ("lookup: ");
|
||||
display_error_ (name);
|
||||
eputs (" => ");
|
||||
write_error_ (handle);
|
||||
if (handle != cell_f)
|
||||
handle = cons (name, name->variable);
|
||||
if (module == M0)
|
||||
handle = hashq_get_handle_ (M0, name, cell_f);
|
||||
else
|
||||
handle = module_handle (module, name);
|
||||
}
|
||||
else
|
||||
{
|
||||
handle = hashq_get_handle_ (M0, name, cell_f);
|
||||
if (handle == cell_f && define_p == cell_t)
|
||||
struct scm *table = module_defines (module);
|
||||
handle = hashq_get_handle_ (table, name, cell_f);
|
||||
if (handle == cell_f)
|
||||
{
|
||||
if (g_debug > 0)
|
||||
{
|
||||
|
|
@ -92,7 +150,15 @@ lookup_variable (struct scm *name, struct scm *define_p)
|
|||
write_error_ (name);
|
||||
eputs ("\n");
|
||||
}
|
||||
handle = hashq_set_handle_x (M0, name, cell_f);
|
||||
handle = hashq_set_handle_x (table, name, cell_f);
|
||||
}
|
||||
else if (handle->cdr == cell_undefined)
|
||||
{
|
||||
eputs ("lookup + define: ");
|
||||
write_error_ (name);
|
||||
eputs (" found: ");
|
||||
write_error_ (handle);
|
||||
eputs ("\n");
|
||||
}
|
||||
}
|
||||
}
|
||||
|
|
@ -101,16 +167,20 @@ lookup_variable (struct scm *name, struct scm *define_p)
|
|||
}
|
||||
|
||||
struct scm *
|
||||
lookup_variable_ (char const* name)
|
||||
lookup_ref (struct scm *name, struct scm *bound_p)
|
||||
{
|
||||
return lookup_variable (cstring_to_symbol (name), cell_f);
|
||||
struct scm *handle = lookup_handle (name, cell_f);
|
||||
if (handle == cell_f)
|
||||
{
|
||||
if (bound_p == cell_t)
|
||||
error (cell_symbol_unbound_variable, name);
|
||||
return cell_undefined;
|
||||
}
|
||||
return handle->cdr;
|
||||
}
|
||||
|
||||
struct scm *
|
||||
lookup_ref (struct scm *name)
|
||||
lookup_ref_ (char const *name)
|
||||
{
|
||||
struct scm *x = lookup_variable (name, cell_f);
|
||||
if (x == cell_f)
|
||||
error (cell_symbol_unbound_variable, name);
|
||||
return x->cdr;
|
||||
return lookup_ref (cstring_to_symbol (name), cell_f);
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue