mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +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
(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)))
;;;