~ chicken-core (chicken-5) 6a7eded4882cdde442a3c5a3318420af188044f8


commit 6a7eded4882cdde442a3c5a3318420af188044f8
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Sat Mar 8 19:11:29 2025 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Sat Mar 8 19:11:29 2025 +0100

    better address issues with inclide-library-declarations, and cond-expand in library definitions

diff --git a/expand.scm b/expand.scm
index dc2b9a08..da9ff706 100644
--- a/expand.scm
+++ b/expand.scm
@@ -1274,7 +1274,7 @@
            (if (and (pair? e2) (eq? '##core#begin (car e2)))
                (cons '##core#begin (map expand/begin (cdr e2)))
                e2)))
-       (define (read-forms filename ci?)
+       (define (read-forms filename ci? #!optional (proc (lambda (x) (map expand/begin x))))
          (fluid-let ((##sys#default-read-info-hook
                        (let ((name 'chicken.compiler.support#read-info-hook))
                          (and (feature? 'compiling)
@@ -1283,15 +1283,15 @@
            (##sys#include-forms-from-file
                filename
                ##sys#current-source-filename ci?
-               (lambda (forms path) (map expand/begin forms)))))
+               (lambda (forms path) (proc forms)))))
        (define (process-include-decls fnames)
          (parse-decls
            (let loop ((fnames fnames) (all '()))
              (if (null? fnames)
                  (reverse all)
-                 (let ((forms (read-forms (car fnames) #t)))
+                 (let ((forms (read-forms (car fnames) #t (lambda (x) x))))
                    (loop (cdr fnames)
-                   		 (append (reverse forms) all)))))))
+                         (append (reverse forms) all)))))))
        (define (fail spec)
          (##sys#syntax-error 'define-library "invalid library declaration" spec))
        (define (parse-decls decls)
@@ -1320,9 +1320,11 @@
                    `(##core#begin ,(process-include-decls (cdr spec))
                                   ,(parse-decls more)))
                   ((cond-expand)
-                   `(##core#begin ,@(process-cond-expand (cdr spec))
-                                  ,(parse-decls more)))
-                  ((begin ##core#begin)
+                   (parse-decls (append (list (process-cond-expand (cdr spec)))
+                                        more)))
+                  ((##core#begin)
+                    (parse-decls (cdr spec)))
+                  ((begin)
                    `(##core#begin ,@(cdr spec)
                                   ,(parse-decls more)))
                   (else (fail spec)))))
Trap