diff --git a/CHANGELOG.md b/CHANGELOG.md index fb869e3e..1f39c1f7 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/cyclone.scm b/cyclone.scm index 7186b231..c5b14a8b 100644 --- a/cyclone.scm +++ b/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 diff --git a/scheme/cyclone/libraries.sld b/scheme/cyclone/libraries.sld index eb068dbd..ea355c13 100644 --- a/scheme/cyclone/libraries.sld +++ b/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) - (let ((name (cadr expr)) - (decls (lib:cond-expand-decls (cddr expr) expander))) - `(define-library ,name ,@decls))) +(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 (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) diff --git a/scheme/cyclone/util.sld b/scheme/cyclone/util.sld index a9474549..2d9db7b3 100644 --- a/scheme/cyclone/util.sld +++ b/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) diff --git a/scheme/read.sld b/scheme/read.sld index 67d65bf9..efc41e21 100644 --- a/scheme/read.sld +++ b/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 - (cons - '(begin) - (map - (lambda (filename) + + (define (dirname filename) + (let loop ((index (string-length filename))) + (if (zero? index) + "" + (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)))) - (cdr expr))))))) + (read-all/source port filename)))))))) (define-syntax include-ci (er-macro-transformer