Use the Scheme48 module system's "namestring" procedure to update the file-specs.
This commit is contained in:
parent
509cd53d2f
commit
bac56f93bb
|
@ -1,5 +1,5 @@
|
|||
#! /usr/local/bin/scsh \
|
||||
-s
|
||||
-o filenames -o pp -s
|
||||
!#
|
||||
|
||||
;;; xpackages.scm
|
||||
|
@ -32,41 +32,18 @@
|
|||
|
||||
(define header-message
|
||||
";; This file was automatically generated by the sunterlib
|
||||
;; makefile, so do not edit it.
|
||||
;; makefile, so do not edit it.
|
||||
")
|
||||
|
||||
;;; (open <structure>*)
|
||||
;;; (access <name>*)
|
||||
;;; (begin <program>)
|
||||
;;; (files <file-spec>*)
|
||||
;;; (optimize <optimize-spec>*)
|
||||
;;; (for-syntax <clause>*)
|
||||
;;;
|
||||
;;; File names in a files clause can be symbols, strings, or lists
|
||||
;;; (Maclisp-style "namelists"). A ".scm" file type suffix is assumed.
|
||||
;;; Symbols are converted to file names by converting to upper or lower
|
||||
;;; case as appropriate for the host operating system. A namelist is an
|
||||
;;; operating-system-independent way to specify a file obtained from a
|
||||
;;; subdirectory. For example, the namelist "(rts record)" specifies the
|
||||
;;; file "record.scm" in the "rts" subdirectory.
|
||||
|
||||
(define process-source
|
||||
(lambda (source)
|
||||
(let* ((leading-path
|
||||
(split-file-name (file-name-directory source)))
|
||||
(let* ((directory (file-name-directory source))
|
||||
(massage-file-spec
|
||||
(lambda (file-spec)
|
||||
(append
|
||||
leading-path
|
||||
(cond ((pair? file-spec)
|
||||
file-spec)
|
||||
((string? file-spec)
|
||||
(split-file-name file-spec))
|
||||
;; ISSUE: Is this ok?
|
||||
((symbol? file-spec)
|
||||
(split-file-name (symbol->string file-spec)))
|
||||
(else
|
||||
(error "unrecognized file-spec" file-spec))))))
|
||||
;; Uses "namestring" from the "filenames" structure to
|
||||
;; process the file-specs, this is the same procedure
|
||||
;; used by the module system.
|
||||
(namestring file-spec directory "scm")))
|
||||
(massage-clause
|
||||
(lambda (clause)
|
||||
(if (not (and (pair? clause) (eq? 'files (car clause))))
|
||||
|
@ -79,7 +56,7 @@
|
|||
(cond ((eof-object? form)
|
||||
(values))
|
||||
((pair? form)
|
||||
(write
|
||||
(p
|
||||
(let ((op (car form))
|
||||
(rest (cdr form)))
|
||||
(case op
|
||||
|
@ -99,12 +76,13 @@
|
|||
(else
|
||||
(error "unexpected form in packages" source form)))))
|
||||
(newline)
|
||||
(newline)
|
||||
(loop (read)))
|
||||
(else
|
||||
(error "unexpected form in packages" source form))))))))
|
||||
|
||||
(define xpackages
|
||||
;; Copy each source file to the target file, adding the source
|
||||
;; directory to each package's file-specs.
|
||||
(lambda (target sources)
|
||||
(with-current-output-port
|
||||
(open-output-file target)
|
||||
|
|
Loading…
Reference in New Issue