Replace usage of ENVIRONMENT-LINK-NAME with new LINK-VARIABLES.

Extend package-file language to allow linking variables with different
names.

diff --git a/v7/src/cref/conpkg.scm b/v7/src/cref/conpkg.scm
index fdedf1b16bff2b9896c9cf571a0bd8e6ef5b2397..3e98944d2f7e1ff59c77f24e57113d1390cf2157 100644 (file)
--- a/v7/src/cref/conpkg.scm
+++ b/v7/src/cref/conpkg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: conpkg.scm,v 1.7 2000/01/18 20:43:28 cph Exp $
+$Id: conpkg.scm,v 1.8 2001/08/09 03:06:12 cph Exp $
 
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
 |#
 
 ;;;; Generate construction program from package model
@@ -38,11 +39,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                 (append-map construct-links (pmodel/extra-packages pmodel))
                 construct-links packages)))
           (if (pair? links)
-              `((LET ((ENVIRONMENT-LINK-NAME
+              `((LET ((LINK-VARIABLES
                        (LET-SYNTAX
                            ((UCODE-PRIMITIVE
-                             (MACRO (NAME) (MAKE-PRIMITIVE-PROCEDURE NAME))))
-                         (UCODE-PRIMITIVE ENVIRONMENT-LINK-NAME))))
+                             (MACRO (NAME ARITY)
+                               (MAKE-PRIMITIVE-PROCEDURE NAME ARITY))))
+                         (UCODE-PRIMITIVE LINK-VARIABLES 4))))
                   ,@links))
               '()))
         construct-definitions
@@ -72,8 +74,9 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
         (map (lambda (link)
                (let ((source (link/source link))
                      (destination (link/destination link)))
-                 `(ENVIRONMENT-LINK-NAME
+                 `(LINK-VARIABLES
                    ,(package-reference (binding/package destination))
+                   ',(binding/name destination)
                    ,(package-reference (binding/package source))
                    ',(binding/name source))))
              (binding/links binding)))

diff --git a/v7/src/cref/make.scm b/v7/src/cref/make.scm
index c6bf348c6837850c3a01242b9a53a7c8c7dec345..0863ad9f49337932a21110faf9389ccd2317be0f 100644 (file)
--- a/v7/src/cref/make.scm
+++ b/v7/src/cref/make.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: make.scm,v 1.19 2000/01/18 20:38:37 cph Exp $
+$Id: make.scm,v 1.20 2001/08/09 03:06:14 cph Exp $
 
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
 |#
 
 ;;;; Package Model: System Construction
@@ -33,4 +34,4 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
      (lambda ()
        (load-option 'RB-TREE)
        (package/system-loader "cref" '() #f)))))
-(add-identification! "CREF" 1 19)
\ No newline at end of file
+(add-identification! "CREF" 1 20)
\ No newline at end of file

diff --git a/v7/src/cref/redpkg.scm b/v7/src/cref/redpkg.scm
index 76997ec29c389401a8a9f482ef0ae99afd079ec6..6b4dc6621bad4a8bb4dc6912b09d7cabcd3593cd 100644 (file)
--- a/v7/src/cref/redpkg.scm
+++ b/v7/src/cref/redpkg.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: redpkg.scm,v 1.12 2000/01/18 20:38:41 cph Exp $
+$Id: redpkg.scm,v 1.13 2001/08/09 03:06:17 cph Exp $
 
-Copyright (c) 1988-2000 Massachusetts Institute of Technology
+Copyright (c) 1988-2001 Massachusetts Institute of Technology
 
 This program is free software; you can redistribute it and/or modify
 it under the terms of the GNU General Public License as published by
@@ -16,7 +16,8 @@ General Public License for more details.
 
 You should have received a copy of the GNU General Public License
 along with this program; if not, write to the Free Software
-Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
+Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
+USA.
 |#
 
 ;;;; Package Model Reader
@@ -328,12 +329,12 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
                 (set-package-description/exports!
                  package
                  (append (package-description/exports package)
-                         (list (parse-export (cdr option))))))
+                         (list (parse-import/export (cdr option))))))
                ((IMPORT)
                 (set-package-description/imports!
                  package
                  (append (package-description/imports package)
-                         (list (parse-import (cdr option))))))
+                         (list (parse-import/export (cdr option))))))
                ((INITIALIZATION)
                 (if (package-description/initialization package)
                     (error "Multiple INITIALIZATION options:" option))
@@ -378,15 +379,23 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
       (error "illegal initialization" initialization))
   (car initialization))
 
-(define (parse-import import)
-  (if (not (and (pair? import) (check-list (cdr import) symbol?)))
-      (error "illegal import" import))
-  (cons (parse-name (car import)) (cdr import)))
-
-(define (parse-export export)
-  (if (not (and (pair? export) (check-list (cdr export) symbol?)))
-      (error "illegal export" export))
-  (cons (parse-name (car export)) (cdr export)))
+(define (parse-import/export object)
+  (if (not (and (pair? object)
+               (check-list (cdr object)
+                           (lambda (item)
+                             (or (symbol? item)
+                                 (and (pair? item)
+                                      (symbol? (car item))
+                                      (pair? (cdr item))
+                                      (symbol? (cadr item))
+                                      (null? (cddr item))))))))
+      (error "illegal import/export list" object))
+  (cons (parse-name (car object))
+       (map (lambda (entry)
+              (if (pair? entry)
+                  (cons (car entry) (cadr entry))
+                  (cons entry entry)))
+            (cdr object))))
 
 (define (check-list items predicate)
   (and (list? items)
@@ -495,14 +504,16 @@ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
     (set-package/initialization! package initialization))
   (for-each (lambda (export)
              (let ((destination (get-package (car export) #t)))
-               (for-each (lambda (name)
-                           (link! package name destination name))
+               (for-each (lambda (names)
+                           (link! package (car names)
+                                  destination (cdr names)))
                          (cdr export))))
            (package-description/exports description))
   (for-each (lambda (import)
              (let ((source (get-package (car import) #t)))
-               (for-each (lambda (name)
-                           (link! source name package name))
+               (for-each (lambda (names)
+                           (link! source (cdr names)
+                                  package (car names)))
                          (cdr import))))
            (package-description/imports description)))