tracking source info for macros

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

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))

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);

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!

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))

lib/chibi/type-inference.scm

@@ -256,8 +256,12 @@
   (cons 'lambda (cons (lambda-return-type x) (lambda-param-types x))))
 
 (define (procedure-signature x)
-  (if (opcode? x)
-      (cdr (opcode-type x))
+  (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
@@ -269,4 +273,4 @@
          ((lambda? lam)
           (cdr (lambda-type lam)))
          (else
-            #f))))))
+          #f)))))))

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))