From a5f85d368575b3a6273912021d5ed6852c81c550 Mon Sep 17 00:00:00 2001 From: Alex Shinn Date: Mon, 16 May 2011 00:48:55 -0700 Subject: [PATCH] tracking source info for macros --- eval.c | 1 + include/chibi/sexp.h | 4 +++- lib/chibi/ast.c | 1 + lib/chibi/ast.module | 2 +- lib/chibi/modules.module | 2 +- lib/chibi/type-inference.scm | 32 ++++++++++++++++++-------------- sexp.c | 4 +++- 7 files changed, 28 insertions(+), 18 deletions(-) mode change 100644 => 100755 eval.c mode change 100644 => 100755 include/chibi/sexp.h mode change 100644 => 100755 lib/chibi/ast.c mode change 100644 => 100755 lib/chibi/ast.module mode change 100644 => 100755 lib/chibi/modules.module mode change 100644 => 100755 lib/chibi/type-inference.scm mode change 100644 => 100755 sexp.c diff --git a/eval.c b/eval.c old mode 100644 new mode 100755 index 65572ec1..66707f0f --- a/eval.c +++ b/eval.c @@ -728,6 +728,7 @@ static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) { if (sexp_synclop(name) && sexp_env_global_p(sexp_context_env(bind_ctx))) name = sexp_synclo_expr(name); mac = sexp_make_macro(eval_ctx, proc, sexp_context_env(bind_ctx)); + sexp_macro_source(mac) = sexp_pair_source(sexp_cadar(ls)); sexp_env_define(eval_ctx, sexp_context_env(bind_ctx), name, mac); } else { res = (sexp_exceptionp(proc) ? proc diff --git a/include/chibi/sexp.h b/include/chibi/sexp.h old mode 100644 new mode 100755 index f789b1f9..9aea8f7a --- a/include/chibi/sexp.h +++ b/include/chibi/sexp.h @@ -315,7 +315,7 @@ struct sexp_struct { sexp bc, vars; } procedure; struct { - sexp proc, env; + sexp proc, env, source; } macro; struct { sexp env, free_vars, expr; @@ -676,6 +676,7 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x); #define sexp_procedure_variadic_p(x) (sexp_unbox_fixnum(sexp_procedure_flags(x)) & 1) #define sexp_procedure_code(x) (sexp_field(x, procedure, SEXP_PROCEDURE, bc)) #define sexp_procedure_vars(x) (sexp_field(x, procedure, SEXP_PROCEDURE, vars)) +#define sexp_procedure_source(x) sexp_bytecode_source(sexp_procedure_code(x)) #define sexp_bytes_length(x) (sexp_field(x, bytes, SEXP_BYTES, length)) #define sexp_bytes_data(x) (sexp_field(x, bytes, SEXP_BYTES, data)) @@ -741,6 +742,7 @@ SEXP_API sexp sexp_make_unsigned_integer(sexp ctx, sexp_luint_t x); #define sexp_macro_proc(x) (sexp_field(x, macro, SEXP_MACRO, proc)) #define sexp_macro_env(x) (sexp_field(x, macro, SEXP_MACRO, env)) +#define sexp_macro_source(x) (sexp_field(x, macro, SEXP_MACRO, source)) #define sexp_synclo_env(x) (sexp_field(x, synclo, SEXP_SYNCLO, env)) #define sexp_synclo_free_vars(x) (sexp_field(x, synclo, SEXP_SYNCLO, free_vars)) diff --git a/lib/chibi/ast.c b/lib/chibi/ast.c old mode 100644 new mode 100755 index 1c393087..66fc4f01 --- a/lib/chibi/ast.c +++ b/lib/chibi/ast.c @@ -303,6 +303,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) { sexp_define_accessors(ctx, env, SEXP_EXCEPTION, 2, "exception-irritants", "exception-irritants-set!"); sexp_define_accessors(ctx, env, SEXP_MACRO, 0, "macro-procedure", "macro-procedure-set!"); sexp_define_accessors(ctx, env, SEXP_MACRO, 1, "macro-env", "macro-env-set!"); + sexp_define_accessors(ctx, env, SEXP_MACRO, 2, "macro-source", "macro-source-set!"); sexp_define_foreign_opt(ctx, env, "analyze", 2, sexp_analyze_op, SEXP_FALSE); sexp_define_foreign(ctx, env, "extend-env", 2, sexp_extend_env); sexp_define_foreign(ctx, env, "env-cell", 2, sexp_get_env_cell); diff --git a/lib/chibi/ast.module b/lib/chibi/ast.module old mode 100644 new mode 100755 index 33ed4eba..de1f8240 --- a/lib/chibi/ast.module +++ b/lib/chibi/ast.module @@ -26,7 +26,7 @@ exception-irritants exception-irritants-set! opcode-name opcode-num-params opcode-return-type opcode-param-type opcode-variadic? - macro-procedure macro-env + macro-procedure macro-env macro-source procedure-code procedure-vars procedure-name bytecode-name bytecode-literals bytecode-source port-line port-line-set! diff --git a/lib/chibi/modules.module b/lib/chibi/modules.module old mode 100644 new mode 100755 index 1807694a..fb32bda5 --- a/lib/chibi/modules.module +++ b/lib/chibi/modules.module @@ -2,7 +2,7 @@ (module (chibi modules) (export module-name module-dir module-includes module-ast module-ast-set! module-ref module-contains? - analyze-module containing-module + analyze-module containing-module load-module module-exports procedure-analysis) (import-immutable (scheme) (config)) (import (chibi ast)) diff --git a/lib/chibi/type-inference.scm b/lib/chibi/type-inference.scm old mode 100644 new mode 100755 index 6b21a230..d7aaa444 --- a/lib/chibi/type-inference.scm +++ b/lib/chibi/type-inference.scm @@ -256,17 +256,21 @@ (cons 'lambda (cons (lambda-return-type x) (lambda-param-types x)))) (define (procedure-signature x) - (if (opcode? x) - (cdr (opcode-type x)) - (let lp ((count 0)) - (let ((lam (procedure-analysis x))) - (cond - ((and lam (not (typed? lam)) (zero? count) - (containing-module x)) - => (lambda (mod) - (and (type-analyze-module (car mod)) - (lp (+ count 1))))) - ((lambda? lam) - (cdr (lambda-type lam))) - (else - #f)))))) + (cond + ((opcode? x) + (cdr (opcode-type x))) + ((macro? x) + (procedure-signature (macro-procedure x))) + (else + (let lp ((count 0)) + (let ((lam (procedure-analysis x))) + (cond + ((and lam (not (typed? lam)) (zero? count) + (containing-module x)) + => (lambda (mod) + (and (type-analyze-module (car mod)) + (lp (+ count 1))))) + ((lambda? lam) + (cdr (lambda-type lam))) + (else + #f))))))) diff --git a/sexp.c b/sexp.c old mode 100644 new mode 100755 index e2b6851b..e9d788b4 --- a/sexp.c +++ b/sexp.c @@ -101,7 +101,7 @@ static struct sexp_type_struct _sexp_type_specs[] = { {SEXP_OPORT, sexp_offsetof(port, name), 2, 2, 0, 0, sexp_sizeof(port), 0, 0, 0, 0, 0, 0, 0, 0, "output-port", SEXP_FALSE, SEXP_FALSE, SEXP_FINALIZE_PORT}, {SEXP_EXCEPTION, sexp_offsetof(exception, kind), 6, 6, 0, 0, sexp_sizeof(exception), 0, 0, 0, 0, 0, 0, 0, 0, "exception", SEXP_FALSE, SEXP_FALSE, NULL}, {SEXP_PROCEDURE, sexp_offsetof(procedure, bc), 2, 2, 0, 0, sexp_sizeof(procedure), 0, 0, 0, 0, 0, 0, 0, 0, "procedure", SEXP_FALSE, SEXP_FALSE, NULL}, - {SEXP_MACRO, sexp_offsetof(macro, proc), 2, 2, 0, 0, sexp_sizeof(macro), 0, 0, 0, 0, 0, 0, 0, 0, "macro", SEXP_FALSE, SEXP_FALSE, NULL}, + {SEXP_MACRO, sexp_offsetof(macro, proc), 3, 3, 0, 0, sexp_sizeof(macro), 0, 0, 0, 0, 0, 0, 0, 0, "macro", SEXP_FALSE, SEXP_FALSE, NULL}, {SEXP_SYNCLO, sexp_offsetof(synclo, env), 3, 3, 0, 0, sexp_sizeof(synclo), 0, 0, 0, 0, 0, 0, 0, 0, "syntactic-closure", SEXP_FALSE, SEXP_FALSE, NULL}, #if SEXP_USE_RENAME_BINDINGS {SEXP_ENV, sexp_offsetof(env, parent), 4, 4, 0, 0, sexp_sizeof(env), 0, 0, 0, 0, 0, 0, 0, 0, "environment", SEXP_FALSE, SEXP_FALSE, NULL}, @@ -1853,6 +1853,8 @@ sexp sexp_read_raw (sexp ctx, sexp in) { if ((line >= 0) && sexp_pairp(res)) { sexp_pair_source(res) = sexp_cons(ctx, sexp_port_name(in), sexp_make_fixnum(line)); + for (tmp=sexp_cdr(res); sexp_pairp(tmp); tmp=sexp_cdr(tmp)) + sexp_pair_source(tmp) = sexp_pair_source(res); } if (sexp_port_sourcep(in)) for (tmp=res; sexp_pairp(tmp); tmp=sexp_cdr(tmp))