Add parameterize back

scheme/base.sld

@@ -851,38 +851,38 @@
                       fill)))
         (list->string
           (apply make-list (cons k fill*)))))
-    ;(define-syntax parameterize
+    (define-syntax parameterize
-    ;  (syntax-rules ()
+      (syntax-rules ()
-    ;    ((parameterize
+        ((parameterize
-    ;       ("step")
+           ("step")
-    ;       ((param value p old new) ...)
+           ((param value p old new) ...)
-    ;       ()
+           ()
-    ;       body)
+           body)
-    ;     (let ((p param) ...)
+         (let ((p param) ...)
-    ;       (let ((old (p))
+           (let ((old (p))
-    ;             ...
+                 ...
-    ;             (new ((p <param-convert>) value))
+                 (new ((p '<param-convert>) value))
-    ;             ...)
+                 ...)
-    ;         (dynamic-wind
+             (dynamic-wind
-    ;           (lambda () (p <param-set!> new) ...)
+               (lambda () (p '<param-set!> new) ...)
-    ;           (lambda () . body)
+               (lambda () . body)
-    ;           (lambda () (p <param-set!> old) ...)))))
+               (lambda () (p '<param-set!> old) ...)))))
-    ;    ((parameterize
+        ((parameterize
-    ;       ("step")
+           ("step")
-    ;       args
+           args
-    ;       ((param value) . rest)
+           ((param value) . rest)
-    ;       body)
+           body)
-    ;     (parameterize
+         (parameterize
-    ;       ("step")
+           ("step")
-    ;       ((param value p old new) . args)
+           ((param value p old new) . args)
-    ;       rest
+           rest
-    ;       body))
+           body))
-    ;    ((parameterize ((param value) ...) . body)
+        ((parameterize ((param value) ...) . body)
-    ;     (parameterize
+         (parameterize
-    ;       ("step")
+           ("step")
-    ;       ()
+           ()
-    ;       ((param value) ...)
+           ((param value) ...)
-    ;       body))))
+           body))))
     (define (make-parameter init . o)
       (let* ((converter
                (if (pair? o) (car o) (lambda (x) x)))

tests/debug/macro-testing.scm

@@ -103,33 +103,33 @@
 ;    ((define-values var expr)
 ;     (define var
 ;       (call-with-values (lambda () expr) list)))))
-
+;
-(write
+;(write
-  (letrec* ((x 1)) x))
+;  (letrec* ((x 1)) x))
-
+;
-(write
+;(write
-  (guard (condition
+;  (guard (condition
-          ((assq 'a condition) => cdr)
+;          ((assq 'a condition) => cdr)
-          ((assq 'b condition)))
+;          ((assq 'b condition)))
-    (raise (list (cons 'a 42))))) ;=> 42
+;    (raise (list (cons 'a 42))))) ;=> 42
-
+;
-(write
+;(write
-  (guard (condition
+;  (guard (condition
-          ((assq 'a condition) => cdr)
+;          ((assq 'a condition) => cdr)
-          ((assq 'b condition)))
+;          ((assq 'b condition)))
-    (raise (list (cons 'b 23))))) ;=> (b . 23)
+;    (raise (list (cons 'b 23))))) ;=> (b . 23)
-
+;
-(define range
+;(define range
-  (case-lambda
+;  (case-lambda
-    ((e) (range 0 e))
+;    ((e) (range 0 e))
-    ((b e) (do ((r '() (cons e r))
+;    ((b e) (do ((r '() (cons e r))
-                (e (- e 1) (- e 1)))
+;                (e (- e 1) (- e 1)))
-               ((< e b) r)))))
+;               ((< e b) r)))))
-(write
+;(write
-  (range 3)) ; => (0 1 2)
+;  (range 3)) ; => (0 1 2)
-(write
+;(write
-  (range 3 5)) ; => (3 4)
+;  (range 3 5)) ; => (3 4)
-
+;
 ;(define-values (x y) (integer-sqrt 17))
 ;(write
 ;  (list x y)) ; => (4 1)
@@ -166,22 +166,24 @@
 ;     (parameterize ("step") old (cons (cons ptmp vtmp) cons-new) ((param value ptmp vtmp) . args) rest body))
 ;    ((parameterize ((param value) ...) . body)
 ;     (parameterize ("step") old (thread-parameters) () ((param value) ...) body))))
-;
+
-;(define radix
+(define radix
-;  (make-parameter
+  (make-parameter
-;    10
+    10
-;    (lambda (x)
+    (lambda (x)
-;      (if (and (exact-integer? x) (<= 2 x 16))
+      (if (and (exact-integer? x) (<= 2 x 16))
-;          x
+          x
-;          (error "invalid radix")))))
+          (error "invalid radix")))))
-;(define (f n) (number->string n (radix)))
+(define (f n) (number->string n (radix)))
-;
+
-;(write
+(display
-;  (f 12)) ;=> "12"
+  (f 12)) ;=> "12"
-;
+(newline)
-;(write
+
-;  (parameterize ((radix 2))
+(display
-;    (f 12))) ;=> "1100"
+  (parameterize ((radix 2))
-;
+    (f 12))) ;=> "1100"
-;(write
+(newline)
-;  (f 12)) ;=> "12"
+
+(display
+  (f 12)) ;=> "12"