From: Maxim Cournoyer <maxim.cournoyer@gmail.com>
To: guile-devel@gnu.org
Cc: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Subject: [PATCH v3 3/6] ice-9: Fix 'include' when used in compilation contexts.
Date: Sat, 18 Nov 2023 01:05:35 -0500 [thread overview]
Message-ID: <20231118060621.24675-3-maxim.cournoyer@gmail.com> (raw)
In-Reply-To: <20231118060621.24675-1-maxim.cournoyer@gmail.com>
Fix bug #66046.
Introduce a 'compilation-source-file-name' fluid that captures the
pre-canonicalized file name used when compiling a file, before it gets
modified in fport_canonicalize_filename. That reference that can then
used directly by 'include', avoiding problems.
* module/ice-9/boot-9.scm (compilation-source-file-name): New fluid.
(compile-file): Set it to the value of FILE.
(compile-and-load): Likewise.
* module/ice-9/psyntax.scm (call-with-include-port): Use it.
---
(no changes since v1)
module/ice-9/boot-9.scm | 6 ++++++
module/ice-9/psyntax.scm | 13 +++++++++----
module/system/base/compile.scm | 6 ++++--
3 files changed, 19 insertions(+), 6 deletions(-)
diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index a5f2eea9b..7f2a02007 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -395,6 +395,12 @@ If returning early, return the return value of F."
;; expanded macros, to dispatch an input against a set of patterns.
(define $sc-dispatch #f)
+;;; This fluid captures the original compiled source file name, before
+;;; it gets potentially stripped by the file ports canonicalization. It
+;;; is used with 'include' to locate the true source, which is necessary
+;;; when using relative paths during compilation, for example.
+(define compilation-source-file-name (make-fluid #f))
+
;; Load it up!
(primitive-load-path "ice-9/psyntax-pp")
;; The binding for `macroexpand' has now been overridden, making psyntax the
diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index 7811f7118..ccdd15fca 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -3260,15 +3260,20 @@
(let ((syntax-dirname (lambda (stx)
(define src (syntax-source stx))
(define filename (and src (assq-ref src 'filename)))
- (and (string? filename)
- (dirname filename)))))
+ (define source-file-name
+ (fluid-ref compilation-source-file-name))
+ (or (and source-file-name
+ (dirname source-file-name))
+ (and (string? filename)
+ (dirname filename))))))
(lambda* (filename proc #:key (dirname (syntax-dirname filename)))
"Like @code{call-with-input-file}, except relative paths are
-searched relative to the @var{dirname} instead of the current working
+searched relative to @var{dirname} instead of the current working
directory. Also, @var{filename} can be a syntax object; in that case,
and if @var{dirname} is not specified, the @code{syntax-source} of
@var{filename} is used to obtain a base directory for relative file
-names."
+names. As a special case, when the @var{compilation-source-file-name}
+fluid is set, its value overrides the @var{dirname} argument provided."
(let* ((filename (syntax->datum filename))
(p (open-input-file
(cond ((absolute-file-name? filename)
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index a33d012bd..7b2670c21 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -174,7 +174,8 @@
(opts '())
(canonicalization 'relative))
(validate-options opts)
- (with-fluids ((%file-port-name-canonicalization canonicalization))
+ (with-fluids ((%file-port-name-canonicalization canonicalization)
+ (compilation-source-file-name file))
(let* ((comp (or output-file (compiled-file-name file)
(error "failed to create path for auto-compiled file"
file)))
@@ -202,7 +203,8 @@
(opts '())
(canonicalization 'relative))
(validate-options opts)
- (with-fluids ((%file-port-name-canonicalization canonicalization))
+ (with-fluids ((%file-port-name-canonicalization canonicalization)
+ (compilation-source-file-name file))
(read-and-compile (open-input-file file)
#:from from #:to to #:opts opts
#:optimization-level optimization-level
--
2.41.0
next prev parent reply other threads:[~2023-11-18 6:05 UTC|newest]
Thread overview: 6+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-11-18 6:05 [PATCH v3 1/6] module: Add srfi-126 Maxim Cournoyer
2023-11-18 6:05 ` [PATCH v3 2/6] tests: Add new compile-file tests Maxim Cournoyer
2023-11-18 6:05 ` Maxim Cournoyer [this message]
2023-11-18 6:05 ` [PATCH v3 4/6] module: Add srfi-128 Maxim Cournoyer
2023-11-18 6:05 ` [PATCH v3 5/6] module: Add srfi-125 Maxim Cournoyer
2023-11-18 6:05 ` [PATCH v3 6/6] module: Add srfi-151 Maxim Cournoyer
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20231118060621.24675-3-maxim.cournoyer@gmail.com \
--to=maxim.cournoyer@gmail.com \
--cc=guile-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).