scsh-conservatory
/
sunterlib
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
build/xpackages.scm
View File

@ -1,5 +1,5 @@
#! /usr/local/bin/scsh \ #! /usr/local/bin/scsh \
-s -o filenames -o pp -s
!# !#
;;; xpackages.scm ;;; xpackages.scm
@ -32,41 +32,18 @@
(define header-message (define header-message
";; This file was automatically generated by the sunterlib ";; 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 (define process-source
(lambda (source) (lambda (source)
(let* ((leading-path (let* ((directory (file-name-directory source))
(split-file-name (file-name-directory source)))
(massage-file-spec (massage-file-spec
(lambda (file-spec) (lambda (file-spec)
(append ;; Uses "namestring" from the "filenames" structure to
leading-path ;; process the file-specs, this is the same procedure
(cond ((pair? file-spec) ;; used by the module system.
file-spec) (namestring file-spec directory "scm")))
((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))))))
(massage-clause (massage-clause
(lambda (clause) (lambda (clause)
(if (not (and (pair? clause) (eq? 'files (car clause)))) (if (not (and (pair? clause) (eq? 'files (car clause))))
@ -79,7 +56,7 @@
(cond ((eof-object? form) (cond ((eof-object? form)
(values)) (values))
((pair? form) ((pair? form)
(write (p
(let ((op (car form)) (let ((op (car form))
(rest (cdr form))) (rest (cdr form)))
(case op (case op
@ -99,12 +76,13 @@
(else (else
(error "unexpected form in packages" source form))))) (error "unexpected form in packages" source form)))))
(newline) (newline)
(newline)
(loop (read))) (loop (read)))
(else (else
(error "unexpected form in packages" source form)))))))) (error "unexpected form in packages" source form))))))))
(define xpackages (define xpackages
;; Copy each source file to the target file, adding the source
;; directory to each package's file-specs.
(lambda (target sources) (lambda (target sources)
(with-current-output-port (with-current-output-port
(open-output-file target) (open-output-file target)