Use the Scheme48 module system's "namestring" procedure to update the file-specs.

This commit is contained in:
Anthony Carrico 2003-01-29 16:26:53 +00:00
parent 509cd53d2f
commit bac56f93bb
1 changed files with 10 additions and 32 deletions

View File

@ -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)