Some name changes and small cleanups.
authorChris Hanson <org/chris-hanson/cph>
Fri, 5 Jan 2018 07:34:28 +0000 (02:34 -0500)
committerChris Hanson <org/chris-hanson/cph>
Fri, 5 Jan 2018 07:34:28 +0000 (02:34 -0500)
src/runtime/bundle.scm
src/runtime/mit-macros.scm
src/runtime/runtime.pkg

index bb97ed1c86dafc056c41a0eb9ebc1d728f81d790..6f4ebf33e8eb1091d6c993771378ae694242490c 100644 (file)
@@ -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))
 \f
 (define (make-bundle-interface name clauses)
index e247f2748e22da75cefe67dba3c65058ef2aaee1..b2d1b874ce9f84191925afdf44a6d0e4eee9c1f6 100644 (file)
@@ -765,36 +765,33 @@ USA.
      (if (not condition)
         (begin form ...)))))
 \f
-(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)))
index 44e30a07b3cf4899abb3f60fcb75dc1661b3b62e..b24fde2563f3935e79ae5554035b065c57655c22 100644 (file)
@@ -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)