Merge #497

CHANGELOG.md

@@ -4,6 +4,7 @@
 
 Bug Fixes
 
+- `(include "body.scm")` inside a file `path/to/lib.sld` will look for `path/to/body.scm`, then fallback to the legacy behavior, and look for `$(pwd)/body.scm`.
 - Pass append and prepend directories when compiling dependent libraries of a program. This prevents issues where the directories are not made available to any `include` directives within such libraries.
 
 ## 0.35.0 - August 25, 2022

cyclone.scm

@@ -738,7 +738,7 @@
               in-prog-raw)
             (else
               ;; Account for any cond-expand declarations in the library
-              (list (lib:cond-expand (car in-prog-raw) expander)))))
+              (list (lib:cond-expand in-file (car in-prog-raw) expander)))))
           ;; expand in-prog, if a library, using lib:cond-expand.
           ;; TODO: will also need to do below in lib:get-all-import-deps, after reading each library
          (program:imports/code (if program? (import-reduction in-prog expander) '()))
@@ -859,7 +859,7 @@
               in-prog-raw)
             (else
               ;; Account for any cond-expand declarations in the library
-              (list (lib:cond-expand (car in-prog-raw) expander)))))
+              (list (lib:cond-expand in-file (car in-prog-raw) expander)))))
          ;; Only read C compiler options from module being compiled
          (cc-opts*
           (cond

scheme/cyclone/libraries.sld

@@ -286,10 +286,13 @@
 ;obviously also need to expand cond-expand in cases where the code reads sld files to track down library dependencies
 
 ;; Take given define-library expression and cond-expand all declarations
-(define (lib:cond-expand expr expander)
+(define (lib:cond-expand filepath expr expander)
+  ;; parametrize include, and include-ci during expand, inside
+  ;; expander.
+  (parameterize ((current-expand-filepath filepath))
     (let ((name (cadr expr))
           (decls (lib:cond-expand-decls (cddr expr) expander)))
-    `(define-library ,name ,@decls)))
+      `(define-library ,name ,@decls))))
 
 (define (lib:cond-expand-decls decls expander)
   (reverse
@@ -462,7 +465,7 @@
          (fp (open-input-file dir))
          (lib (read-all fp))
          (lib* (if expander
-                   (list (lib:cond-expand (car lib) expander))
+                   (list (lib:cond-expand dir (car lib) expander))
                    lib))
          (imports (lib:imports (car lib*))))
     (close-input-port fp)
@@ -485,7 +488,7 @@
          (fp (open-input-file dir))
          (lib (read-all fp))
          (lib* (if expander
-                   (list (lib:cond-expand (car lib) expander))
+                   (list (lib:cond-expand dir (car lib) expander))
                    lib))
          (options (lib:c-linker-options (car lib*))))
     (close-input-port fp)
@@ -505,7 +508,7 @@
          (fp (open-input-file dir))
          (lib (read-all fp))
          (lib* (if expander
-                   (list (lib:cond-expand (car lib) expander))
+                   (list (lib:cond-expand dir (car lib) expander))
                    lib))
          (options (lib:c-compiler-options (car lib*))))
     (close-input-port fp)
@@ -526,7 +529,7 @@
          (fp (open-input-file dir))
          (lib (read-all fp))
          (lib* (if expander
-                   (list (lib:cond-expand (car lib) expander))
+                   (list (lib:cond-expand dir (car lib) expander))
                    lib))
          (exports (lib:exports (car lib*))))
     (close-input-port fp)

scheme/cyclone/util.sld

@@ -93,7 +93,8 @@
     string-replace-all
     take
     drop
-    filter)
+    filter
+    current-expand-filepath)
   (inline
     env:frame-values
     env:frame-variables
@@ -113,6 +114,8 @@
   )
   (begin
 
+(define current-expand-filepath (make-parameter #f))
+
 (define (tagged-list? tag exp)
   (if (pair? exp)
       (equal? (car exp) tag)

scheme/read.sld

@@ -9,6 +9,7 @@
 (define-library (scheme read)
   (import (scheme base)
           (scheme cyclone common)
+          (scheme cyclone util)
           ;(scheme write)
           (scheme char))
   (export
@@ -31,17 +32,37 @@
 (define-syntax include
   (er-macro-transformer
    (lambda (expr rename compare)
-     (apply
+
-      append
+     (define (dirname filename)
-      (cons
+       (let loop ((index (string-length filename)))
-        '(begin)
+         (if (zero? index)
-         (map
+             ""
-          (lambda (filename)
+             (let ((index (- index 1)))
+               (if (char=? (string-ref filename index) #\/)
+                   (substring filename 0 index)
+                   (loop index))))))
+
+     (define (massage filename)
+       (cond
+        ;; may happen in the REPL
+        ((not (current-expand-filepath)) filename)
+        ;; absolute filename
+        ((char=? (string-ref filename 0) #\/) filename)
+        ;; otherwise, open the file relative to the library that is
+        ;; expanded
+        (else (let ((target (string-append (dirname (current-expand-filepath)) "/" filename)))
+                ;; if the target exists use, otherwise fallback to the
+                ;; backward compatible behavior.
+                (if (file-exists? target)
+                    target
+                    filename)))))
+
+     `(begin
+        ,@(let ((filename (massage (cadr expr))))
             (call-with-port
               (open-input-file filename)
               (lambda (port)
-                (read-all/source port filename))))
+                (read-all/source port filename))))))))
-          (cdr expr)))))))
 
 (define-syntax include-ci
   (er-macro-transformer