From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 27 Mar 2018 06:54:01 +0000 (-0700)
Subject: Change scons-call to not quote its operator.
X-Git-Tag: mit-scheme-pucked-x11-0.3.1~7^2~173
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=f15e38d3cb2886ecb238a5065b969351d722e573;p=mit-scheme.git

Change scons-call to not quote its operator.

Instead one must explicitly call scons-close when necessary.
---

diff --git a/src/runtime/mit-macros.scm b/src/runtime/mit-macros.scm
index 9cc1e357b..cf64cb4ce 100644
--- a/src/runtime/mit-macros.scm
+++ b/src/runtime/mit-macros.scm
@@ -173,7 +173,7 @@ USA.
    (delay
      (scons-rule `(,r4rs-lambda-list? any (list (+ any)))
        (lambda (bvl expr body-forms)
-	 (scons-call 'call-with-values
+	 (scons-call (scons-close 'call-with-values)
 		     (scons-lambda '() expr)
 		     (apply scons-lambda bvl body-forms)))))
    system-global-environment))
@@ -192,13 +192,13 @@ USA.
        (lambda (type-name parent maker-name maker-args pred-name field-specs)
 	 (apply scons-begin
 		(scons-define type-name
-		  (scons-call 'new-make-record-type
+		  (scons-call (scons-close 'new-make-record-type)
 			      (scons-quote type-name)
 			      (scons-quote (map car field-specs))
 			      (or parent (default-object))))
 		(if maker-name
 		    (scons-define maker-name
-		      (scons-call 'record-constructor
+		      (scons-call (scons-close 'record-constructor)
 				  type-name
 				  (if maker-args
 				      (scons-quote maker-args)
@@ -206,21 +206,23 @@ USA.
 		    (default-object))
 		(if pred-name
 		    (scons-define pred-name
-		      (scons-call 'record-predicate type-name))
+		      (scons-call (scons-close 'record-predicate) type-name))
 		    (default-object))
 		(append-map (lambda (field-spec)
 			      (let ((name (car field-spec))
 				    (accessor (cadr field-spec))
 				    (modifier (caddr field-spec)))
 				(list (scons-define accessor
-					(scons-call 'record-accessor
-						    type-name
-						    (scons-quote name)))
+					(scons-call
+					 (scons-close 'record-accessor)
+					 type-name
+					 (scons-quote name)))
 				      (if modifier
 					  (scons-define modifier
-					    (scons-call 'record-modifier
-							type-name
-							(scons-quote name)))
+					    (scons-call
+					     (scons-close 'record-modifier)
+					     type-name
+					     (scons-quote name)))
 					  (default-object)))))
 			    field-specs)))))
    system-global-environment))
@@ -427,13 +429,14 @@ USA.
 	   (define (process-predicate items)
 	     (apply scons-or
 		    (map (lambda (item)
-			   (scons-call (if (or (symbol? item)
-					       (boolean? item)
-					       ;; implementation dependent:
-					       (char? item)
-					       (fix:fixnum? item))
-					   'eq?
-					   'eqv?)
+			   (scons-call (scons-close
+					(if (or (symbol? item)
+						(boolean? item)
+						;; implementation dependent:
+						(char? item)
+						(fix:fixnum? item))
+					    'eq?
+					    'eqv?))
 				       (scons-quote item)
 				       temp))
 			 items)))
diff --git a/src/runtime/syntax-constructor.scm b/src/runtime/syntax-constructor.scm
index 3727f9bdd..7b59f34c3 100644
--- a/src/runtime/syntax-constructor.scm
+++ b/src/runtime/syntax-constructor.scm
@@ -51,6 +51,10 @@ USA.
   (map (lambda (part) (close-part close part))
        parts))
 
+(define (scons-close identifier)
+  (guarantee identifier? identifier 'scons-close)
+  (make-open-expr (lambda (close) (close identifier))))
+
 (define (scons-and . exprs)
   (make-open-expr
    (lambda (close)
@@ -66,9 +70,7 @@ USA.
 (define (scons-call operator . operands)
   (make-open-expr
    (lambda (close)
-     (cons (if (identifier? operator)
-	       (close operator)
-	       (close-part close operator))
+     (cons (close-part close operator)
 	   (close-parts close operands)))))
 
 (define (scons-declare . decls)