From 1c8f8a6b3d5624511e549e10b8a1c5856a125e7d Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Thu, 29 Jul 2010 08:16:06 +0900 Subject: [PATCH] ast/module updates --- eval.c | 2 ++ include/chibi/sexp.h | 2 +- lib/chibi/ast.c | 1 + lib/chibi/ast.module | 2 +- lib/chibi/modules.scm | 25 +++++++++++++++++++++---- 5 files changed, 26 insertions(+), 6 deletions(-) diff --git a/eval.c b/eval.c index 1d7dfcbd..db81b9b0 100644 --- a/eval.c +++ b/eval.c @@ -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; } diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h index e4d806ad..11d9e0f7 100644 --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -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" */ diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c index a1ece368..c3b5bbe7 100644 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -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); diff --git a/lib/chibi/ast.module b/lib/chibi/ast.module index e3bb83ba..e349bff3 100644 --- a/lib/chibi/ast.module +++ b/lib/chibi/ast.module @@ -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 diff --git a/lib/chibi/modules.scm b/lib/chibi/modules.scm index 3e85d40c..b9e40e0d 100644 --- a/lib/chibi/modules.scm +++ b/lib/chibi/modules.scm @@ -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)))