Attach include source info in continuation mark during compilation

Part of #521

ChangeLog

@@ -1,3 +1,9 @@
+2024-12-09  Shiro Kawai  <shiro@acm.org>
+
+	* src/compile-1.scm: Attach include source info in the continuation
+	  mark with (%include-source-mark-key) during compilation, so that
+	  we can report compile-time errors from the included source.
+
 2024-12-04  Shiro Kawai  <shiro@acm.org>
 
 	* src/libeval.scm (%invoke-other-version): Avoid using cond-expand.

src/compile-1.scm

@@ -382,7 +382,10 @@
     [(((op . args) . incsrc) . rest)
      (or (and-let* ([ (or (not vframe) (not (assq op vframe))) ]
                     [head (pass1/lookup-head op cenv)])
-           (process-form-1 op head args incsrc rest mframe vframe cenv))
+           (if (null? incsrc)
+             (process-form-1 op head args incsrc rest mframe vframe cenv)
+             (with-continuation-mark (%include-source-mark-key) incsrc
+               (process-form-1 op head args incsrc rest mframe vframe cenv))))
          (pass1/body-finish exprs mframe vframe cenv))]
     [_ (pass1/body-finish exprs mframe vframe cenv)]))
 
@@ -419,9 +422,10 @@
                          (cons (pass1/body-1 (car exprs) stmtenv) r))))))]))
 
 (define (pass1/body-1 expr&src cenv)
-  (let1 src (cdr expr&src)
-    (if (string? src)
-      (pass1 (car expr&src) (cenv-swap-source cenv src))
+  (let1 incsrc (cdr expr&src)
+    (if (string? incsrc)
+      (with-continuation-mark (%include-source-mark-key) incsrc
+        (pass1 (car expr&src) (cenv-swap-source cenv incsrc)))
       (pass1 (car expr&src) cenv))))
 
 ;;--------------------------------------------------------------
@@ -1943,12 +1947,10 @@
 ;; Include .............................................
 
 (define-pass1-syntax (include form cenv) :gauche
-  ($seq (map (^p (pass1 (car p) (cenv-swap-source cenv (cdr p))))
-             (pass1/expand-include (cdr form) cenv #f))))
+  (pass1/body-rest (pass1/expand-include (cdr form) cenv #f) cenv))
 
 (define-pass1-syntax (include-ci form cenv) :gauche
-  ($seq (map (^p (pass1 (car p) (cenv-swap-source cenv (cdr p))))
-             (pass1/expand-include (cdr form) cenv #t))))
+  (pass1/body-rest (pass1/expand-include (cdr form) cenv #t) cenv))
 
 ;; Returns  ((Sexpr . Filename) ...)
 (define (pass1/expand-include args cenv case-fold?)

src/compile.scm

@@ -1676,21 +1676,33 @@
                    [else (make-bottom-cenv)]) ; use default module
     (receive (env-header-size cont-frame-size)
         (parse-target-params target-params)
-      (guard (e [else
-                 ;; Attach the source with <compile-error-mixin>, if it is
-                 ;; not alrady attached.
-                 ;; TODO: check if e is an expected error (such as syntax error)
-                 ;; or an unexpected error (compiler bug).
-                 (if (and (is-a? e <compound-condition>)
-                          (find (^c (and (is-a? c <compile-error-mixin>)
-                                         (eq? (~ c'expr) program)))
-                                (~ e '%conditions)))
-                   (raise e)
-                   ($ raise $ make-compound-condition e
-                      $ make <compile-error-mixin> :expr program))])
-        (pass5 (pass2-4 (pass1 program cenv) (cenv-module cenv))
-               (make-compile-target env-header-size cont-frame-size)
-               '() 'tail)))))
+      (with-error-handler
+          (^e (raise (%attach-compile-error-context e program)))
+        (^[]
+          (pass5 (pass2-4 (pass1 program cenv) (cenv-module cenv))
+                 (make-compile-target env-header-size cont-frame-size)
+                 '() 'tail))))))
+
+;; Attach <compile-error-mixin> and/or <include-condition-mixin> to the
+;; thrown condition, if necessary.
+;; TODO: check if e is an expected error (such as syntax error)
+;; or an unexpected error (compiler bug).
+(define (%attach-compile-error-context e program)
+  (define include-source-mixin
+    (and-let1 incsrc (continuation-mark-set-first (current-continuation-marks)
+                                                  (%include-source-mark-key))
+      (make <include-condition-mixin> :includee incsrc)))
+  (define compile-error-mixin
+    ;; avoid attaching duplicate mixins
+    (if (and (is-a? e <compound-condition>)
+             (find (^c (and (is-a? c <compile-error-mixin>)
+                            (eq? (~ c'expr) program)))
+                   (~ e '%conditions)))
+      #f
+      (make <compile-error-mixin> :expr program)))
+  (apply make-compound-condition e
+         (cond-list [include-source-mixin]
+                    [compile-error-mixin])))
 
 ;; stub for future extension
 (define (compile-partial program module) #f)