From: Chris Hanson <org/chris-hanson/cph>
Date: Fri, 5 Jan 2018 07:34:28 +0000 (-0500)
Subject: Some name changes and small cleanups.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~423
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=554a62d80558fb3ea7f723b7cfe2c92aa773f7b1;p=mit-scheme.git

Some name changes and small cleanups.
---

diff --git a/src/runtime/bundle.scm b/src/runtime/bundle.scm
index bb97ed1c8..6f4ebf33e 100644
--- a/src/runtime/bundle.scm
+++ b/src/runtime/bundle.scm
@@ -32,10 +32,6 @@ USA.
 ;;; procedure.  If the specified named object isn't a procedure, an error is
 ;;; signaled.
 
-;;; Each bundle also carries a predicate that can be used to identify it.
-;;; Normally the predicate is shared between bundles with the same general
-;;; structure.  New bundle types are typically defined using define-interface.
-
 (declare (usual-integrations))
 
 (define (make-bundle-interface name clauses)
diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index e247f2748..b2d1b874c 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -765,36 +765,33 @@ USA.
      (if (not condition)
 	 (begin form ...)))))
 
-(define-syntax :define-interface
+(define-syntax :define-bundle-interface
   (er-macro-transformer
    (lambda (form rename compare)
      (declare (ignore compare))
-     (syntax-check '(_ identifier identifier
-		       * (or symbol (symbol * (symbol * datum))))
+     (syntax-check '(_ symbol * (or symbol (symbol * (symbol * datum))))
 		   form)
-     (define-interface-helper rename
-       (cadr form)
-       (caddr form)
-       (cdddr form)))))
+     (make-interface-helper rename (cadr form) (cddr form)))))
 
-(define (define-interface-helper rename constructor interface clauses)
+(define (make-interface-helper rename name clauses)
   (rename-generated-expression
    rename
-   `(begin
-      ,(make-interface-definition constructor interface clauses)
-      ,(make-constructor-definition constructor interface
-				    (map (lambda (clause)
-					   (if (symbol? clause)
-					       clause
-					       (car clause)))
-					 clauses)))))
-
-(define (make-interface-definition constructor interface clauses)
+   (let ((interface (symbol name '?)))
+     `(begin
+	,(make-interface-definition name interface clauses)
+	,(make-constructor-definition name interface
+				      (map (lambda (clause)
+					     (if (symbol? clause)
+						 clause
+						 (car clause)))
+					   clauses))))))
+
+(define (make-interface-definition name interface clauses)
   `(define ,interface
-     (make-bundle-interface ',constructor ',clauses)))
+     (make-bundle-interface ',name ',clauses)))
 
-(define (make-constructor-definition constructor interface names)
-  `(define-syntax ,constructor
+(define (make-constructor-definition name interface names)
+  `(define-syntax ,(symbol 'capture- name)
      (sc-macro-transformer
       (lambda (form use-environment)
 	(if (not (null? (cdr form)))
diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 44e30a07b..b24fde256 100644
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -4721,7 +4721,7 @@ USA.
 	  (cons-stream* :cons-stream*)
 	  (define :define)
 	  (define-integrable :define-integrable)
-	  (define-interface :define-interface)
+	  (define-bundle-interface :define-bundle-interface)
 	  (define-record-type :define-record-type)
 	  (do :do)
 	  (fluid-let :fluid-let)