summaryrefslogtreecommitdiff
path: root/module/system/base/compile.scm
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2010-04-19 13:34:29 +0200
committerAndy Wingo <wingo@pobox.com>2010-04-19 13:34:29 +0200
commitb9e67767ae7f7544563286f731b135435967fa26 (patch)
tree24a9bfbf5ebffd57db1cdaf2020ed520d570812d /module/system/base/compile.scm
parent69cac23837eaa3f506658696bd8692764a432e4a (diff)
downloadguile-b9e67767ae7f7544563286f731b135435967fa26.tar.gz
compile-file gets #:canonicalization arg, defaults to 'relative
* module/system/base/compile.scm (compile-file, compile-and-load): Add a keyword arg #:canonicalization, which defaults to 'relative. In this way, one might compile "../module/ice-9/boot-9.scm", but the path that gets residualized into the .go is "ice-9/boot-9.scm".
Diffstat (limited to 'module/system/base/compile.scm')
-rw-r--r--module/system/base/compile.scm41
1 files changed, 23 insertions, 18 deletions
diff --git a/module/system/base/compile.scm b/module/system/base/compile.scm
index 34e097b75..71f768ada 100644
--- a/module/system/base/compile.scm
+++ b/module/system/base/compile.scm
@@ -76,6 +76,7 @@
thunk
(lambda () #t))))
+;; (put 'call-with-output-file/atomic 'scheme-indent-function 1)
(define* (call-with-output-file/atomic filename proc #:optional reference)
(let* ((template (string-append filename ".XXXXXX"))
(tmp (mkstemp! template)))
@@ -146,26 +147,30 @@
(from (current-language))
(to 'objcode)
(env (default-environment from))
- (opts '()))
- (let* ((comp (or output-file (compiled-file-name file)))
- (in (open-input-file file))
- (enc (file-encoding in)))
- (if enc
- (set-port-encoding! in enc))
- (ensure-writable-dir (dirname comp))
- (call-with-output-file/atomic comp
- (lambda (port)
- ((language-printer (ensure-language to))
- (read-and-compile in #:env env #:from from #:to to #:opts opts)
- port))
- file)
- comp))
+ (opts '())
+ (canonicalization 'relative))
+ (with-fluids ((%file-port-name-canonicalization canonicalization))
+ (let* ((comp (or output-file (compiled-file-name file)))
+ (in (open-input-file file))
+ (enc (file-encoding in)))
+ (if enc
+ (set-port-encoding! in enc))
+ (ensure-writable-dir (dirname comp))
+ (call-with-output-file/atomic comp
+ (lambda (port)
+ ((language-printer (ensure-language to))
+ (read-and-compile in #:env env #:from from #:to to #:opts opts)
+ port))
+ file)
+ comp)))
(define* (compile-and-load file #:key (from 'scheme) (to 'value)
- (env (current-module)) (opts '()))
- (read-and-compile (open-input-file file)
- #:from from #:to to #:opts opts
- #:env env))
+ (env (current-module)) (opts '())
+ (canonicalization 'relative))
+ (with-fluids ((%file-port-name-canonicalization canonicalization))
+ (read-and-compile (open-input-file file)
+ #:from from #:to to #:opts opts
+ #:env env)))
;;;