Eliminate compile-system.

diff --git a/src/blowfish/compile.scm b/src/blowfish/compile.scm
index 7f6406d5f5c0f06301912b0671540f0c0807b45e..477c7c8ba7b45d1a25e88394a90b9cb8247960b6 100644 (file)
--- a/src/blowfish/compile.scm
+++ b/src/blowfish/compile.scm
@@ -2,11 +2,12 @@
 
 ;;;; Compile the Blowfish wrapper.
 
-(fluid-let ((load/suppress-loading-message? #t))
-  (load-option 'CREF)
-  (load-option 'FFI))
-
-(with-system-library-directories
- '("./")
- (lambda ()
-   (compile-system "blowfish" (directory-pathname (current-load-pathname)))))
\ No newline at end of file
+(load-option 'CREF)
+(load-option 'FFI)
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+  (lambda ()
+    (with-system-library-directories
+       '("./")
+      (lambda ()
+       (compile-file "blowfish" '() (->environment '(RUNTIME)))))
+    (cref/generate-constructors "blowfish" 'ALL)))
\ No newline at end of file

diff --git a/src/cref/butils.scm b/src/cref/butils.scm
deleted file mode 100644 (file)
index 512de2c..0000000
--- a/src/cref/butils.scm
+++ /dev/null
@@ -1,131 +0,0 @@
-#| -*-Scheme-*-
-
-Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
-    1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-    2006, 2007, 2008, 2009, 2010, 2011, 2012, 2013 Massachusetts
-    Institute of Technology
-
-This file is part of MIT/GNU Scheme.
-
-MIT/GNU Scheme is free software; you can redistribute it and/or modify
-it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 2 of the License, or (at
-your option) any later version.
-
-MIT/GNU Scheme is distributed in the hope that it will be useful, but
-WITHOUT ANY WARRANTY; without even the implied warranty of
-MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-General Public License for more details.
-
-You should have received a copy of the GNU General Public License
-along with MIT/GNU Scheme; if not, write to the Free Software
-Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301,
-USA.
-
-|#
-
-;;;; Build utilities
-;;; package: (cross-reference build-utilities)
-
-(declare (usual-integrations))
-\f
-(define (compile-system name directory . options)
-  ;; Gets a list of files from DIRECTORY/NAME.pkg, creates the
-  ;; packages described therein, and loads each file, in order,
-  ;; re-compiling it first when necessary.
-  ;;
-  ;; If OPTIONS includes 'dependencies, its value should be an alist
-  ;; of filenames, as they appear in the NAME.pkg file, each
-  ;; associated with a list of pathnames (relative to DIRECTORY).
-  ;;
-  ;; If OPTIONS includes 'imports, its value should be a list,
-  ;;
-  ;;     ( (<target-package> <source-package> . <bound-names>)... )
-  ;;
-  ;; e.g. (((gtk keys) (ffi) find-c-includes c-enum-constant-values)).
-  ;; Each symbol in <bound-names> is bound in the target package and
-  ;; linked to the same name in the source package.  <target-package>
-  ;; and <source-package> should be package names -- lists of symbols.
-
-  (define (find-option name options default)
-    (let loop ((opts options))
-      (if (pair? opts)
-         (if (eq? (car opts) name)
-             (cadr opts)
-             (loop (cddr opts)))
-         default)))
-
-  (with-working-directory-pathname directory
-    (lambda ()
-      (let* ((os-type microcode-id/operating-system)
-            (pmodel (read-package-model name os-type))
-            (dependencies (find-option 'dependencies options '()))
-            (imports (find-option 'imports options '())))
-
-       (declare (integrate-operator file-package))
-       (define (file-package file)
-         (let loop ((packages (pmodel/packages pmodel)))
-           (if (pair? packages)
-               (if (find (lambda (f) (pathname=? f file))
-                         (package/files (car packages)))
-                   (car packages)
-                   (loop (cdr packages)))
-               (error "No cref package for file:" file pmodel))))
-
-       (define-integrable (file-environment file)
-         (->environment (package/name (file-package file))))
-
-       (define-integrable (file-dependencies file)
-         (let ((entry (assoc (->namestring file) dependencies)))
-           (if entry (cdr entry) '())))
-
-       (for-each (lambda (file.deps)
-                   (if (not (for-all? file.deps string?))
-                       (error "Bogus dependency:" file.deps)))
-                 dependencies)
-
-       (for-each (lambda (import)
-                   (let ((target (car import))
-                         (source (cadr import))
-                         (names (cddr import))
-                         (glt guarantee-list-of-type))
-                     (declare (integrate glt))
-                     (glt target symbol? "package name" 'compile-system)
-                     (glt source symbol? "package name" 'compile-system)
-                     (glt names symbol? "imported names" 'compile-system)))
-                 imports)
-    
-       (let ((existing
-              (let loop ((packages (pmodel/packages pmodel)))
-                (if (pair? packages)
-                    (or (name->package (package/name (car packages)))
-                        (loop (cdr packages)))
-                    #f))))
-         (if existing
-             (error "Package already exists:" existing)
-             (construct-packages-from-file
-              (construct-external-descriptions pmodel))))
-
-       (for-each
-         (lambda (import)
-           (let ((target (->environment (car import)))
-                 (source (->environment (cadr import)))
-                 (names (cddr import)))
-             (for-each (lambda (name)
-                        (environment-link-name target source name))
-                      names)))
-         imports)
-
-       (for-each
-         (lambda (file)
-           (let ((env (file-environment file))
-                 (deps (file-dependencies file))
-                 (type
-                  (if (or compile-file:sf-only? compiler:cross-compiling?)
-                      "bin"
-                      #f)))
-             (compile-file file deps env)
-             (load (pathname-new-type file type) env)))
-         (append-map package/files (pmodel/packages pmodel)))
-
-       (cref/generate-constructors name 'ALL)))))
\ No newline at end of file

diff --git a/src/cref/cref.pkg b/src/cref/cref.pkg
index f6d071341887a7b15e1f7a6899c16daf9a98ff1a..830e2faa6f4a4f0b1144d4117fb2bfbbfab51950 100644 (file)
--- a/src/cref/cref.pkg
+++ b/src/cref/cref.pkg
@@ -41,12 +41,6 @@ USA.
          cref/generate-trivial-constructor
          cref/package-files))
 
-(define-package (cross-reference build-utilities)
-  (files "butils")
-  (parent (cross-reference))
-  (export ()
-         compile-system))
-
 (define-package (cross-reference analyze-file)
   (files "anfile")
   (parent (cross-reference))

diff --git a/src/cref/triv.pkg b/src/cref/triv.pkg
index 999b1d5d083ad0aeeb494beba79bb967c6b95413..ecf77513fa17e1a0081e1c2c4037295eea0fb2d5 100644 (file)
--- a/src/cref/triv.pkg
+++ b/src/cref/triv.pkg
@@ -53,10 +53,6 @@ USA.
                      cref/generate-trivial-constructor
                      cref/package-files)
                    '())
-          (package '(cross-reference build-utilities)
-                   '((cross-reference) ())
-                   '((compile-system))
-                   '())
           (package '(cross-reference analyze-file)
                    '((cross-reference) ())
                    '(analyze-file)
@@ -83,7 +79,6 @@ USA.
                  '#()
                  '#()))))
    (vector (files '(cross-reference) "mset" "object" "toplev")
-          (files '(cross-reference build-utilities) "butils")
           (files '(cross-reference analyze-file) "anfile")
           (files '(cross-reference constructor) "conpkg")
           (files '(cross-reference formatter) "forpkg")

diff --git a/src/etc/compile.scm b/src/etc/compile.scm
index f9252cf45531b2418c38ccff228a659592a4d3ae..f5eca8a4045e3e612271c0404bab84e031790d1f 100644 (file)
--- a/src/etc/compile.scm
+++ b/src/etc/compile.scm
@@ -43,18 +43,6 @@ USA.
       (load "load")))
   (for-each compile-dir '("xml" "win32" "edwin" "imail" "ssp" "ffi")))
 
-(define (compile-ffi dir)
-  (if (eq? microcode-id/compiled-code-type 'C)
-      (in-liarc
-       (lambda ()
-        (c-compile-dir dir)
-        (let* ((line '("make" "compile-liarc-bundle"))
-               (code (run-synchronous-subprocess
-                      (car line) (cdr line) 'working-directory dir)))
-          (if (not (zero? code))
-              (error "Process exited with error code:" code line)))))
-      (compile-dir dir)))
-
 (define (compile-boot-dirs compile-dir)
   (compile-cref compile-dir)
   (for-each compile-dir '("runtime" "cref" "sf" "compiler" "star-parser")))

diff --git a/src/ffi/compile.scm b/src/ffi/compile.scm
index 944b6dfcb5df2d7b5f6828936ef268f88b01c50a..7e6f1aa4723fe06197e099f446c7a7691b71eacb 100644 (file)
--- a/src/ffi/compile.scm
+++ b/src/ffi/compile.scm
@@ -1,14 +1,11 @@
-#| -*-Scheme-*-
+#| -*-Scheme-*- |#
 
-Compile the FFI system. |#
+;;;; Compile the C/FFI.
 
 (load-option 'CREF)
-
-;; Temporary hack.  Remove when compile-system is in the release.
-(if (not (environment-bound? (->environment '()) 'compile-system))
-    (let ((butil-env (->environment '(cross-reference)))
-         (global-env (->environment '())))
-      (load "../cref/butils" butil-env)
-      (environment-link-name global-env butil-env 'compile-system)))
-
-(compile-system "ffi" (directory-pathname (current-load-pathname)))
\ No newline at end of file
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+  (lambda ()
+    (for-each (lambda (file)
+               (compile-file file '() (->environment '(RUNTIME))))
+             '("ctypes" "cdecls" "syntax" "generator" "build"))
+    (cref/generate-constructors "ffi" 'ALL)))
\ No newline at end of file

diff --git a/src/gdbm/compile.scm b/src/gdbm/compile.scm
index b94c01ac7676d7989e56d25941c6d2ff20939b23..2052264a185231cac618a1d43ad531abcf0ae4c7 100644 (file)
--- a/src/gdbm/compile.scm
+++ b/src/gdbm/compile.scm
@@ -2,11 +2,12 @@
 
 ;;;; Compile the GDBM wrapper.
 
-(fluid-let ((load/suppress-loading-message? #t))
-  (load-option 'CREF)
-  (load-option 'FFI))
-
-(with-system-library-directories
- '("./")
- (lambda ()
-   (compile-system "gdbm" (directory-pathname (current-load-pathname)))))
\ No newline at end of file
+(load-option 'CREF)
+(load-option 'FFI)
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+  (lambda ()
+    (with-system-library-directories
+       '("./")
+      (lambda ()
+       (compile-file "gdbm" '() (->environment '(RUNTIME)))))
+    (cref/generate-constructors "gdbm" 'ALL)))
\ No newline at end of file

diff --git a/src/md5/compile.scm b/src/md5/compile.scm
index bae36363459ad3f403d364db0af22a2c858ce6cf..749754eb4f46422ca6d27352d7aab2b9ad14551e 100644 (file)
--- a/src/md5/compile.scm
+++ b/src/md5/compile.scm
@@ -2,11 +2,12 @@
 
 ;;;; Compile the MD5 wrapper.
 
-(fluid-let ((load/suppress-loading-message? #t))
-  (load-option 'CREF)
-  (load-option 'FFI))
-
-(with-system-library-directories
- '("./")
- (lambda ()
-   (compile-system "md5" (directory-pathname (current-load-pathname)))))
\ No newline at end of file
+(load-option 'CREF)
+(load-option 'FFI)
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+  (lambda ()
+    (with-system-library-directories
+       '("./")
+      (lambda ()
+       (compile-file "md5" '() (->environment '(RUNTIME)))))
+    (cref/generate-constructors "md5" 'ALL)))
\ No newline at end of file

diff --git a/src/mhash/compile.scm b/src/mhash/compile.scm
index 0f4899c2e286d19e50e2add0d9fbc24a12cf6608..e5b92ce1a366df1b89f57f26fef6c570f46b3f91 100644 (file)
--- a/src/mhash/compile.scm
+++ b/src/mhash/compile.scm
@@ -2,11 +2,12 @@
 
 ;;;; Compile the mhash wrapper.
 
-(fluid-let ((load/suppress-loading-message? #t))
-  (load-option 'CREF)
-  (load-option 'FFI))
-
-(with-system-library-directories
- '("./")
- (lambda ()
-   (compile-system "mhash" (directory-pathname (current-load-pathname)))))
\ No newline at end of file
+(load-option 'CREF)
+(load-option 'FFI)
+(with-working-directory-pathname (directory-pathname (current-load-pathname))
+  (lambda ()
+    (with-system-library-directories
+       '("./")
+      (lambda ()
+       (compile-file "mhash" '() (->environment '(RUNTIME)))))
+    (cref/generate-constructors "mhash" 'ALL)))
\ No newline at end of file