From cfa8ff0c3bda9f29caf7ec97dd8b2087e3e98698 Mon Sep 17 00:00:00 2001 From: Anthony Carrico Date: Wed, 29 Jan 2003 03:44:23 +0000 Subject: [PATCH] The file-spec paths in the master package lists are now automatically adjusted from their local versions. --- Makefile | 29 +++++++--- build/xpackages.scm | 116 +++++++++++++++++++++++++++++++++++++ s48/args-fold/packages.scm | 2 +- 3 files changed, 138 insertions(+), 9 deletions(-) create mode 100755 build/xpackages.scm diff --git a/Makefile b/Makefile index bd05033..3f3061d 100644 --- a/Makefile +++ b/Makefile @@ -1,23 +1,36 @@ -s48-interfaces := $(shell find s48 -name interfaces.scm) -s48-packages := $(shell find s48 -name packages.scm) -scsh-interfaces := $(shell find scsh -name interfaces.scm) -scsh-packages := $(shell find scsh -name packages.scm) +s48-interfaces := $(shell find s48 \ + -maxdepth 2 -mindepth 2 \ + -name interfaces.scm) +s48-packages := $(shell find s48 \ + -maxdepth 2 -mindepth 2 \ + -name packages.scm) +scsh-interfaces := $(shell find scsh \ + -maxdepth 2 -mindepth 2 \ + -name interfaces.scm) +scsh-packages := $(shell find scsh \ + -maxdepth 2 -mindepth 2 \ + -name packages.scm) -targets = s48-interfaces.scm s48-packages.scm interfaces.scm packages.scm +s48-targets := s48-interfaces.scm s48-packages.scm +scsh-targets := interfaces.scm packages.scm +targets := $(s48-targets) $(scsh-targets) -all : $(targets) +.PHONY: all s48 scsh +all : s48 scsh +s48 : $(s48-targets) +scsh : $(scsh-targets) s48-interfaces.scm : $(s48-interfaces) cat $(s48-interfaces) > s48-interfaces.scm s48-packages.scm : $(s48-packages) - cat $(s48-packages) > s48-packages.scm + build/xpackages.scm s48-packages.scm $(s48-packages) interfaces.scm : $(s48-interfaces) $(scsh-interfaces) cat $(s48-interfaces) $(scsh-interfaces) > interfaces.scm packages.scm : $(s48-packages) $(scsh-packages) - cat $(s48-packages) $(scsh-packages) > packages.scm + build/xpackages.scm packages.scm $(s48-packages) $(scsh-packages) .PHONY : clean clean : diff --git a/build/xpackages.scm b/build/xpackages.scm new file mode 100755 index 0000000..ee361f0 --- /dev/null +++ b/build/xpackages.scm @@ -0,0 +1,116 @@ +#! /usr/local/bin/scsh \ +-s +!# + +;;; xpackages.scm +;;; +;;; Copyright (c) 2003 Anthony Carrico +;;; +;;; All rights reserved. +;;; +;;; Redistribution and use in source and binary forms, with or without +;;; modification, are permitted provided that the following conditions +;;; are met: +;;; 1. Redistributions of source code must retain the above copyright +;;; notice, this list of conditions and the following disclaimer. +;;; 2. Redistributions in binary form must reproduce the above copyright +;;; notice, this list of conditions and the following disclaimer in the +;;; documentation and/or other materials provided with the distribution. +;;; 3. The name of the authors may not be used to endorse or promote products +;;; derived from this software without specific prior written permission. +;;; +;;; THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR +;;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES +;;; OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. +;;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, +;;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT +;;; NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +;;; DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +;;; THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +;;; (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF +;;; THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +(define header-message + ";; This file was automatically generated by the sunterlib +;; makefile, so do not edit it. +") + +;;; (open *) +;;; (access *) +;;; (begin ) +;;; (files *) +;;; (optimize *) +;;; (for-syntax *) +;;; +;;; 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))) + (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)))))) + (massage-clause + (lambda (clause) + (if (not (and (pair? clause) (eq? 'files (car clause)))) + clause + (cons (car clause) + (map massage-file-spec (cdr clause))))))) + (with-current-input-port + (open-input-file source) + (let loop ((form (read))) + (cond ((eof-object? form) + (values)) + ((pair? form) + (write + (let ((op (car form)) + (rest (cdr form))) + (case op + ((define-structure define-structures) + (if (pair? rest) + (let* ((interface (car rest)) + (clauses (cdr rest))) + (cons op + (cons interface + (map massage-clause clauses)))))) + ((define-interface) + form) + ((define-syntax) + ;; ISSUE: what does define-syntax mean in the + ;; configuration language? + (error "unexpected form in packages" source form)) + (else + (error "unexpected form in packages" source form))))) + (newline) + (newline) + (loop (read))) + (else + (error "unexpected form in packages" source form)))))))) + +(define xpackages + (lambda (target sources) + (with-current-output-port + (open-output-file target) + (display header-message) + (newline) + (for-each process-source sources)))) + +(xpackages (car command-line-arguments) + (cdr command-line-arguments)) diff --git a/s48/args-fold/packages.scm b/s48/args-fold/packages.scm index 0ab8750..0bf8418 100644 --- a/s48/args-fold/packages.scm +++ b/s48/args-fold/packages.scm @@ -1,4 +1,4 @@ (define-structure srfi-37 srfi-37-interface (open scheme srfi-9 srfi-11) - (files "s48/args-fold/args-fold.scm")) + (files args-fold))