core: Have module variable lookup return variable type. WIP
This commit is contained in:
parent
3092efa8aa
commit
684199d107
|
@ -120,6 +120,8 @@
|
||||||
(display ">" port))
|
(display ">" port))
|
||||||
((variable? x)
|
((variable? x)
|
||||||
(display "#<variable " port)
|
(display "#<variable " port)
|
||||||
|
(when (not (zero? (core:cdr x)))
|
||||||
|
(display "*local* " port))
|
||||||
(write (list->string (car (core:car x))) port)
|
(write (list->string (car (core:car x))) port)
|
||||||
(display ">" port))
|
(display ">" port))
|
||||||
((number? x)
|
((number? x)
|
||||||
|
|
|
@ -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 (module-variable (current-module) 'x))))))))))
|
(map car (cdr (core:cdr (core:car (core:cdr (cdr (core:car (module-variable (current-module) 'x)))))))))))
|
||||||
|
|
||||||
(define (x t) #t)
|
(define (x t) #t)
|
||||||
(define (xx x1 x2)
|
(define (xx x1 x2)
|
||||||
|
|
|
@ -80,6 +80,8 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
|
||||||
else if (t == TVARIABLE)
|
else if (t == TVARIABLE)
|
||||||
{
|
{
|
||||||
fdputs ("#<variable ", fd);
|
fdputs ("#<variable ", fd);
|
||||||
|
if (LOCAL_P (x))
|
||||||
|
fdputs ("*local* ", fd);
|
||||||
display_helper (CAR (VARIABLE (x)), cont, "", fd, 0);
|
display_helper (CAR (VARIABLE (x)), cont, "", fd, 0);
|
||||||
fdputs (">", fd);
|
fdputs (">", fd);
|
||||||
}
|
}
|
||||||
|
|
30
src/mes.c
30
src/mes.c
|
@ -124,6 +124,7 @@ struct scm {
|
||||||
long length;
|
long length;
|
||||||
};
|
};
|
||||||
union {
|
union {
|
||||||
|
long local_p;
|
||||||
long value;
|
long value;
|
||||||
long function;
|
long function;
|
||||||
long port;
|
long port;
|
||||||
|
@ -311,6 +312,7 @@ int g_function = 0;
|
||||||
|
|
||||||
#if !_POSIX_SOURCE
|
#if !_POSIX_SOURCE
|
||||||
#define LENGTH(x) g_cells[x].car
|
#define LENGTH(x) g_cells[x].car
|
||||||
|
#define LOCAL_P(x) g_cells[x].cdr
|
||||||
#define REF(x) g_cells[x].car
|
#define REF(x) g_cells[x].car
|
||||||
#define STRING(x) g_cells[x].car
|
#define STRING(x) g_cells[x].car
|
||||||
#define VARIABLE(x) g_cells[x].car
|
#define VARIABLE(x) g_cells[x].car
|
||||||
|
@ -332,8 +334,9 @@ int g_function = 0;
|
||||||
#define NVECTOR(x) g_news[x].cdr
|
#define NVECTOR(x) g_news[x].cdr
|
||||||
|
|
||||||
#else
|
#else
|
||||||
#define CONTINUATION(x) g_cells[x].cdr
|
#define CONTINUATION(x) g_cells[x].continuation
|
||||||
#define HITS(x) g_cells[x].hits
|
#define HITS(x) g_cells[x].hits
|
||||||
|
#define LOCAL_P(x) g_cells[x].local_p
|
||||||
#define LENGTH(x) g_cells[x].length
|
#define LENGTH(x) g_cells[x].length
|
||||||
#define NAME(x) g_cells[x].name
|
#define NAME(x) g_cells[x].name
|
||||||
#define STRING(x) g_cells[x].string
|
#define STRING(x) g_cells[x].string
|
||||||
|
@ -855,8 +858,10 @@ set_env_x (SCM x, SCM e, SCM a)
|
||||||
SCM p;
|
SCM p;
|
||||||
if (TYPE (x) == TVARIABLE)
|
if (TYPE (x) == TVARIABLE)
|
||||||
p = VARIABLE (x);
|
p = VARIABLE (x);
|
||||||
else
|
if (TYPE (x) == TSYMBOL)
|
||||||
p = assert_defined (x, module_variable (a, x));
|
p = assert_defined (x, module_variable (a, x));
|
||||||
|
if (TYPE (p) == TVARIABLE)
|
||||||
|
p = VARIABLE (p);
|
||||||
if (TYPE (p) != TPAIR)
|
if (TYPE (p) != TPAIR)
|
||||||
error (cell_symbol_not_a_pair, cons (p, x));
|
error (cell_symbol_not_a_pair, cons (p, x));
|
||||||
return set_cdr_x (p, e);
|
return set_cdr_x (p, e);
|
||||||
|
@ -878,11 +883,17 @@ make_closure_ (SCM args, SCM body, SCM a) ///((internal))
|
||||||
}
|
}
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
make_variable_ (SCM var) ///((internal))
|
make_variable_ (SCM var, int local_p) ///((internal))
|
||||||
{
|
{
|
||||||
return make_cell__ (TVARIABLE, var, 0);
|
return make_cell__ (TVARIABLE, var, local_p);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
// SCM
|
||||||
|
// make_variable (SCM var, SCM local_p)
|
||||||
|
// {
|
||||||
|
// return make_variable_ (var, VALUE (local_p));
|
||||||
|
// }
|
||||||
|
|
||||||
SCM
|
SCM
|
||||||
macro_ref (SCM table, SCM name) ///((internal))
|
macro_ref (SCM table, SCM name) ///((internal))
|
||||||
{
|
{
|
||||||
|
@ -1018,8 +1029,8 @@ expand_variable_ (SCM x, SCM formals, int top_p) ///((internal))
|
||||||
&& !formal_p (CAR (x), formals))
|
&& !formal_p (CAR (x), formals))
|
||||||
{
|
{
|
||||||
SCM v = module_variable (r0, CAR (x));
|
SCM v = module_variable (r0, CAR (x));
|
||||||
if (v != cell_f)
|
if (v != cell_f && !LOCAL_P (v))
|
||||||
CAR (x) = make_variable_ (v);
|
CAR (x) = v;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
x = CDR (x);
|
x = CDR (x);
|
||||||
|
@ -1053,6 +1064,7 @@ eval_apply ()
|
||||||
SCM p;
|
SCM p;
|
||||||
SCM program;
|
SCM program;
|
||||||
SCM sc_expand;
|
SCM sc_expand;
|
||||||
|
SCM v;
|
||||||
SCM x;
|
SCM x;
|
||||||
int global_p;
|
int global_p;
|
||||||
int macro_p;
|
int macro_p;
|
||||||
|
@ -1323,7 +1335,8 @@ eval_apply ()
|
||||||
}
|
}
|
||||||
else if (global_p)
|
else if (global_p)
|
||||||
{
|
{
|
||||||
entry = module_variable (r0, name);
|
v = module_variable (r0, name);
|
||||||
|
entry = VARIABLE (v);
|
||||||
set_cdr_x (entry, r1);
|
set_cdr_x (entry, r1);
|
||||||
}
|
}
|
||||||
else
|
else
|
||||||
|
@ -1332,7 +1345,8 @@ eval_apply ()
|
||||||
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 = module_variable (r0, cell_closure);
|
v = module_variable (r0, cell_closure);
|
||||||
|
cl = VARIABLE (v);
|
||||||
set_cdr_x (cl, aa);
|
set_cdr_x (cl, aa);
|
||||||
}
|
}
|
||||||
r1 = cell_unspecified;
|
r1 = cell_unspecified;
|
||||||
|
|
15
src/module.c
15
src/module.c
|
@ -91,14 +91,22 @@ module_printer (SCM module)
|
||||||
SCM
|
SCM
|
||||||
module_variable (SCM module, SCM name)
|
module_variable (SCM module, SCM name)
|
||||||
{
|
{
|
||||||
|
if (g_debug > 4)
|
||||||
|
{
|
||||||
|
eputs ("module_variable: "); display_error_ (name); eputs ("\n");
|
||||||
|
}
|
||||||
//SCM locals = struct_ref_ (module, 3);
|
//SCM locals = struct_ref_ (module, 3);
|
||||||
SCM locals = module;
|
SCM locals = module;
|
||||||
SCM x = assq (name, locals);
|
SCM x = assq (name, locals);
|
||||||
if (x == cell_f)
|
if (x != cell_f)
|
||||||
|
x = make_variable_ (x, 1);
|
||||||
|
else
|
||||||
{
|
{
|
||||||
module = m0;
|
module = m0;
|
||||||
SCM globals = struct_ref_ (module, 5);
|
SCM globals = struct_ref_ (module, 5);
|
||||||
x = hashq_ref (globals, name, cell_f);
|
x = hashq_ref (globals, name, cell_f);
|
||||||
|
if (x != cell_f)
|
||||||
|
x = make_variable_ (x, 0);
|
||||||
}
|
}
|
||||||
return x;
|
return x;
|
||||||
}
|
}
|
||||||
|
@ -106,13 +114,10 @@ module_variable (SCM module, SCM name)
|
||||||
SCM
|
SCM
|
||||||
module_ref (SCM module, SCM name)
|
module_ref (SCM module, SCM name)
|
||||||
{
|
{
|
||||||
if (g_debug > 4)
|
|
||||||
{
|
|
||||||
eputs ("module_ref: "); display_error_ (name); eputs ("\n");
|
|
||||||
}
|
|
||||||
SCM x = module_variable (module, name);
|
SCM x = module_variable (module, name);
|
||||||
if (x == cell_f)
|
if (x == cell_f)
|
||||||
return cell_undefined;
|
return cell_undefined;
|
||||||
|
x = VARIABLE (x);
|
||||||
return CDR (x);
|
return CDR (x);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue