Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-15 08:57:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

fixing import bug (was ignoring exports list except when using

Browse source 
only/except/rename/prefix modifiers)
This commit is contained in:
Alex Shinn 2009-12-24 14:53:30 +09:00
parent cb1859c683
commit bfbc9313ed
4 changed files with 19 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
eval.c
View file

@ -75,14 +75,17 @@ static sexp sexp_env_cell_create (sexp ctx, sexp env, sexp key, sexp value) {
return sexp_env_cell_create_loc(ctx, env, key, value, NULL);
}
sexp sexp_env_global_ref (sexp env, sexp key, sexp dflt) {
sexp cell;
while (sexp_env_parent(env))
env = sexp_env_parent(env);
cell = sexp_env_cell(env, key);
sexp sexp_env_ref (sexp env, sexp key, sexp dflt) {
sexp cell = sexp_env_cell(env, key);
return (cell ? sexp_cdr(cell) : dflt);
}
sexp sexp_env_global_ref (sexp env, sexp key, sexp dflt) {
while (sexp_env_lambda(env) && sexp_env_parent(env))
env = sexp_env_parent(env);
return sexp_env_ref(env, key, dflt);
}
sexp sexp_env_define (sexp ctx, sexp env, sexp key, sexp value) {
sexp cell = sexp_assq(ctx, key, sexp_env_bindings(env)), res=SEXP_VOID;
sexp_gc_var1(tmp);
@ -2587,7 +2590,7 @@ sexp sexp_env_copy (sexp ctx, sexp to, sexp from, sexp ls, sexp immutp) {
} else {
newname = oldname = sexp_car(ls);
}
value = sexp_env_global_ref(from, oldname, SEXP_UNDEF);
value = sexp_env_ref(from, oldname, SEXP_UNDEF);
if (value != SEXP_UNDEF) {
sexp_env_define(ctx, to, newname, value);
#if SEXP_USE_WARN_UNDEFS

1
include/chibi/eval.h
View file

@ -140,6 +140,7 @@ SEXP_API sexp sexp_extend_env (sexp context, sexp env, sexp vars, sexp value);
SEXP_API sexp sexp_env_copy (sexp context, sexp to, sexp from, sexp ls, sexp immutp);
SEXP_API sexp sexp_env_define (sexp context, sexp env, sexp sym, sexp val);
SEXP_API sexp sexp_env_cell (sexp env, sexp sym);
SEXP_API sexp sexp_env_ref (sexp env, sexp sym, sexp dflt);
SEXP_API sexp sexp_env_global_ref (sexp env, sexp sym, sexp dflt);
SEXP_API void sexp_warn_undefs (sexp ctx, sexp from, sexp to, sexp out);
SEXP_API sexp sexp_make_opcode (sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp, sexp_proc1);

5
lib/config.scm
View file

@ -5,12 +5,13 @@
(define *this-module* '())
(define (make-module exports env meta) (vector exports env meta))
(define (%module-exports mod) (vector-ref mod 0))
(define (module-env mod) (vector-ref mod 1))
(define (module-meta-data mod) (vector-ref mod 2))
(define (module-env-set! mod env) (vector-set! mod 1 env))
(define (module-exports mod)
(or (vector-ref mod 0) (env-exports (module-env mod))))
(or (%module-exports mod) (env-exports (module-env mod))))
(define (module-name->strings ls res)
(if (null? ls)
@ -88,7 +89,7 @@
(if (pair? i) (cdr i) i)))
(cdr mod-name+imports)))))
((find-module x)
=> (lambda (mod) (cons x #f)))
=> (lambda (mod) (cons x (%module-exports mod))))
(else
(error "couldn't find import" x))))

8
lib/init.scm
View file

@ -783,10 +783,14 @@
((or) (any check (cdr x)))
((not) (not (check (cadr x))))
(else (error "cond-expand: bad feature" x)))
(memq (identifier->symbol x) (cons 'else *features*))))
(memq (identifier->symbol x) *features*)))
(let expand ((ls (cdr expr)))
(cond ((null? ls) (error "cond-expand: no expansions" (cdr expr)))
(cond ((null? ls) (error "cond-expand: no expansions" expr))
((not (pair? (car ls))) (error "cond-expand: bad clause" (car ls)))
((eq? 'else (identifier->symbol (caar ls)))
(if (pair? (cdr ls))
(error "cond-expand: else in non-final position")
`(,(rename 'begin) ,@(cdar ls))))
((check (caar ls)) `(,(rename 'begin) ,@(cdar ls)))
(else (expand (cdr ls))))))))