Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-20 22:29:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

ast/module updates

Browse source
This commit is contained in:
Alex Shinn 2010-07-29 08:16:06 +09:00
parent 68e55705a2
commit 1c8f8a6b3d
5 changed files with 26 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
eval.c
View file

@ -269,6 +269,8 @@ static sexp sexp_make_lambda (sexp ctx, sexp params) {
sexp_lambda_sv(res) = SEXP_NULL;
sexp_lambda_locals(res) = SEXP_NULL;
sexp_lambda_defs(res) = SEXP_NULL;
sexp_lambda_return_type(res) = SEXP_FALSE;
sexp_lambda_param_types(res) = SEXP_NULL;
return res;
}

2
include/chibi/sexp.h
View file

@ -1046,7 +1046,7 @@ SEXP_API sexp sexp_finalize_c_type (sexp ctx sexp_api_params(self, n), sexp obj)
#define sexp_make_type_predicate(ctx, a, b) sexp_make_type_predicate_op(ctx sexp_api_pass(NULL, 2), a, b)
#define sexp_make_constructor(ctx, a, b) sexp_make_constructor_op(ctx sexp_api_pass(NULL, 2), a, b)
#define sexp_make_getter(ctx, a, b, c) sexp_make_getter_op(ctx sexp_api_pass(NULL, 3), a, b, c)
#define sexp_make_setter(ctx, a, b, c) sexp_make_getter_op(ctx sexp_api_pass(NULL, 3), a, b, c)
#define sexp_make_setter(ctx, a, b, c) sexp_make_setter_op(ctx sexp_api_pass(NULL, 3), a, b, c)
#ifdef __cplusplus
} /* extern "C" */

1
lib/chibi/ast.c
View file

@ -128,6 +128,7 @@ static sexp sexp_optimize (sexp ctx sexp_api_params(self, n), sexp x) {
sexp_env_define(ctx, env, sexp_intern(ctx, name, -1), sexp_type_by_index(ctx, tag));
sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
sexp_define_type(ctx, "object", SEXP_OBJECT);
sexp_define_type(ctx, "lam", SEXP_LAMBDA);
sexp_define_type(ctx, "cnd", SEXP_CND);
sexp_define_type(ctx, "set", SEXP_SET);

2
lib/chibi/ast.module
View file

@ -1,7 +1,7 @@
(define-module (chibi ast)
(export analyze optimize env-cell ast->sexp macroexpand
lam cnd set ref seq lit
object lam cnd set ref seq lit
pair-source pair-source-set!
syntactic-closure? lambda? cnd? set? ref? seq? lit? opcode? type?
syntactic-closure-expr syntactic-closure-env syntactic-closure-vars

25
lib/chibi/modules.scm
View file

@ -65,14 +65,31 @@
(and (env-cell (module-env (if (module? mod) mod (load-module mod))) var-name)
#t))
(define (module-defines? name mod var-name)
(if (not (module-ast mod))
(module-ast-set! mod (analyze-module-source name mod #f)))
(let lp ((ls (module-ast mod)))
(and (pair? ls)
(or (and (set? (car ls))
(eq? var-name (ref-name (set-var (car ls))))
(begin
;; (write `(found ,var-name in ,name ,(ast->sexp (car ls))) (current-error-port))
;; (newline (current-error-port))
#t))
(lp (cdr ls))))))
(define (containing-module x)
(let lp1 ((ls *modules*))
(let lp1 ((ls (reverse *modules*)))
(and (pair? ls)
(let ((env (module-env (cdar ls))))
(let lp2 ((e-ls (env-exports env)))
(cond ((null? e-ls) (lp1 (cdr ls)))
((eq? x (cdr (env-cell env (car e-ls)))) (car ls))
(else (lp2 (cdr e-ls)))))))))
(if (null? e-ls)
(lp1 (cdr ls))
(let ((cell (env-cell env (car e-ls))))
(if (and (eq? x (cdr cell))
(module-defines? (caar ls) (cdar ls) (car cell)))
(car ls)
(lp2 (cdr e-ls))))))))))
(define (procedure-analysis x)
(let ((mod (containing-module x)))