mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00
Code Activity

compile-file gets #:canonicalization arg, defaults to 'relative

Browse source 
* 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".
This commit is contained in:
Andy Wingo 2010-04-19 13:34:29 +02:00
parent 69cac23837
commit b9e67767ae
1 changed files with 23 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

41
module/system/base/compile.scm
View file

@ -76,6 +76,7 @@
thunk thunk
(lambda () #t)))) (lambda () #t))))
;; (put 'call-with-output-file/atomic 'scheme-indent-function 1)
(define* (call-with-output-file/atomic filename proc #:optional reference) (define* (call-with-output-file/atomic filename proc #:optional reference)
(let* ((template (string-append filename ".XXXXXX")) (let* ((template (string-append filename ".XXXXXX"))
(tmp (mkstemp! template))) (tmp (mkstemp! template)))
@ -146,26 +147,30 @@
(from (current-language)) (from (current-language))
(to 'objcode) (to 'objcode)
(env (default-environment from)) (env (default-environment from))
(opts '())) (opts '())
(let* ((comp (or output-file (compiled-file-name file))) (canonicalization 'relative))
(in (open-input-file file)) (with-fluids ((%file-port-name-canonicalization canonicalization))
(enc (file-encoding in))) (let* ((comp (or output-file (compiled-file-name file)))
(if enc (in (open-input-file file))
(set-port-encoding! in enc)) (enc (file-encoding in)))
(ensure-writable-dir (dirname comp)) (if enc
(call-with-output-file/atomic comp (set-port-encoding! in enc))
(lambda (port) (ensure-writable-dir (dirname comp))
((language-printer (ensure-language to)) (call-with-output-file/atomic comp
(read-and-compile in #:env env #:from from #:to to #:opts opts) (lambda (port)
port)) ((language-printer (ensure-language to))
file) (read-and-compile in #:env env #:from from #:to to #:opts opts)
comp)) port))
file)
comp)))
(define* (compile-and-load file #:key (from 'scheme) (to 'value) (define* (compile-and-load file #:key (from 'scheme) (to 'value)
(env (current-module)) (opts '())) (env (current-module)) (opts '())
(read-and-compile (open-input-file file) (canonicalization 'relative))
#:from from #:to to #:opts opts (with-fluids ((%file-port-name-canonicalization canonicalization))
#:env env)) (read-and-compile (open-input-file file)
#:from from #:to to #:opts opts
#:env env)))
;;; ;;;