Define parameterize using syntax-rules and add it to the host adapter.
authorChris Hanson <org/chris-hanson/cph>
Wed, 13 Jun 2018 03:10:50 +0000 (20:10 -0700)
committerChris Hanson <org/chris-hanson/cph>
Wed, 13 Jun 2018 03:10:50 +0000 (20:10 -0700)
src/runtime/host-adapter.scm
src/runtime/mit-macros.scm

index 28572f67b06fca8635967d1b81b73aa3a7830634..a3b7b3873410dab4eff4b96e721476e0fec8e5da 100644 (file)
@@ -102,6 +102,14 @@ USA.
                      (delay-force (make-promise expression))))))
              env))
 
+    (if (unbound? env 'parameterize)
+       (eval '(define-syntax parameterize
+                (syntax-rules ()
+                  ((parameterize ((param value) ...) form ...)
+                   (parameterize* (list (cons param value) ...)
+                                  (lambda () form ...)))))
+             env))
+
     (if (unbound? env 'define-print-method)
        (eval '(define (define-print-method predicate print-method)
                 unspecific)
index e3041528ebee3d58024d3d1b28b1319e718bf380..c96542ee9a6595b8bd6f96e78ce0a3fec2d8fb40 100644 (file)
@@ -187,24 +187,6 @@ USA.
             (apply scons-begin (map scons-set! ids vals))
             (scons-call (apply scons-lambda '() body-forms)))))))))
 \f
-(define $parameterize
-  (spar-transformer->runtime
-   (delay
-     (scons-rule
-        `((subform (* (subform (list id any))))
-          (+ any))
-       (lambda (bindings body-forms)
-        (let ((ids (map car bindings))
-              (vals (map cadr bindings)))
-          (scons-call (scons-close 'parameterize*)
-                      (apply scons-call
-                             (scons-close 'list)
-                             (map (lambda (id val)
-                                    (scons-call (scons-close 'cons) id val))
-                                  ids
-                                  vals))
-                      (apply scons-lambda '() body-forms))))))))
-
 ;;; SRFI 2: and-let*
 
 ;;; The SRFI document is a little unclear about the semantics, imposes
@@ -406,6 +388,12 @@ USA.
     ((delay expression)
      (delay-force (make-promise expression)))))
 
+(define-syntax $parameterize
+  (syntax-rules ()
+    ((parameterize ((param value) ...) form ...)
+     (parameterize* (list (cons param value) ...)
+                   (lambda () form ...)))))
+
 (define $guard
   (spar-transformer->runtime
    (delay