use WRITE-TO-LOAD-SCRIPT instead of sed and load.scm.in

This commit is contained in:
eknauel 2004-02-09 09:55:26 +00:00
parent 0c903274c8
commit b91f8d05d4
1 changed files with 29 additions and 25 deletions

View File

@ -23,31 +23,35 @@
(zero? (run ,make)))) (zero? (run ,make))))
(exit)))) (exit))))
(if (not (get-option-value 'non-shared-only))
(begin
(display "creating load.scm") (display "creating load.scm")
(newline) (newline)
(let ((config-data
(call-with-input-file "config-data.scm" read)))
(let ((schemedir (get-directory 'scheme #f)) (let ((schemedir (get-directory 'scheme #f))
(libdir (get-directory 'lib #f)) (libdir (get-directory 'lib #f)))
(target-dir (get-directory 'base #t)) (write-to-load-script
(shared-ext (cadr (assoc 'shared-module-extension config-data))) `((user)
(sed-replace (lambda (from to) (load-package 'dynamic-externals)
(string-append "s|" from "|" to "|g")))) (open 'dynamic-externals)
(let ((cmd `(sed -e ,(sed-replace "@ypschemedir@" schemedir) (open 'external-calls)
-e ,(sed-replace "@yphost@" "(host)") (open 'configure)
-e ,(sed-replace "@yplibdir@" libdir) (open 'signals)
-e ,(sed-replace "@sharedmoduleext@" shared-ext) ,@(map (lambda (x) `(run ',x)) tmpl-libtool-la-reader)
"load.scm.in")) (run '(let* ((lib-dir (string-append ,libdir "/" (host)))
(tgt (string-append target-dir "/load.scm"))) (la-file-name (string-append lib-dir "/libscshyp.la"))
(if (get-option-value 'dry-run) (initializer-name "scsh_yp_main"))
(begin (let ((la-alist (read-libtool-la la-file-name)))
(display cmd) (display " > ") (display tgt) (cond
(newline)) ((assoc 'dlname la-alist)
(or (zero? (run ,cmd (> ,tgt))) (exit)))))))) => (lambda (p)
(let ((module-file (string-append lib-dir "/" (cdr p))))
(dynamic-load module-file)
(call-external (get-external initializer-name)))))
(else
(error "Could not figure out libscshyp's name" la-file-name))))))
(config)
(load ,(string-append schemedir "/yp-interfaces.scm"))
(load ,(string-append schemedir "/yp-packages.scm"))
(user))))
(install-directory-contents "scheme" 'scheme) (install-directory-contents "scheme" 'scheme)
) )