diff --git a/lib/srfi/139.scm b/lib/srfi/139.scm index a9e317e3..4198dfba 100644 --- a/lib/srfi/139.scm +++ b/lib/srfi/139.scm @@ -7,22 +7,23 @@ (define-syntax syntax-parameterize (lambda (expr use-env mac-env) (let* ((_let (make-syntactic-closure mac-env '() 'let)) - (_set! (make-syntactic-closure mac-env '() 'set!)) - (_out (make-syntactic-closure mac-env '() 'out)) - (_tmp (make-syntactic-closure mac-env '() 'tmp)) - (bindings (cadr expr)) - (body (cddr expr)) - (keywords (map car bindings)) - (transformers (map cadr bindings)) - (cells - (map (lambda (keyword) - (env-cell use-env keyword)) - keywords)) - (old (map cdr cells)) - (new (map (lambda (transformer) - (make-macro (eval (make-syntactic-closure use-env '() transformer)) - use-env)) - transformers))) + (_set! (make-syntactic-closure mac-env '() 'set!)) + (_out (make-syntactic-closure mac-env '() 'out)) + (_tmp (make-syntactic-closure mac-env '() 'tmp)) + (bindings (cadr expr)) + (body (cddr expr)) + (keywords (map car bindings)) + (transformers (map cadr bindings)) + (cells + (map (lambda (keyword) + (env-cell use-env keyword)) + keywords)) + (old (map cdr cells)) + (new (map (lambda (transformer) + (make-macro + (eval (make-syntactic-closure use-env '() transformer)) + use-env)) + transformers))) (for-each set-cdr! cells new) `(,_let ((,_tmp #f)) (,_set! ,_tmp (,_let () ,@body)) diff --git a/lib/srfi/139.sld b/lib/srfi/139.sld index 09ef4cdd..5aa2a866 100644 --- a/lib/srfi/139.sld +++ b/lib/srfi/139.sld @@ -1,6 +1,6 @@ (define-library (srfi 139) (export (rename define-syntax define-syntax-parameter) - syntax-parameterize) + syntax-parameterize) (import (chibi) - (chibi ast)) + (chibi ast)) (include "139.scm")) diff --git a/lib/srfi/139/test.sld b/lib/srfi/139/test.sld index fb5d8df9..2f6c3607 100644 --- a/lib/srfi/139/test.sld +++ b/lib/srfi/139/test.sld @@ -6,47 +6,43 @@ (begin (define-syntax-parameter abort (syntax-rules () - ((_ . _) - (syntax-error "abort used outside of a loop")))) - + ((_ . _) + (syntax-error "abort used outside of a loop")))) + (define-syntax-parameter foo (syntax-rules () - ((foo) 'old))) - + ((foo) 'old))) + (define-syntax forever (syntax-rules () - ((forever body1 body2 ...) - (call-with-current-continuation - (lambda (escape) - (syntax-parameterize - ((abort - (syntax-rules () - ((abort value (... ...)) - (escape value (... ...)))))) - (let loop () - body1 body2 ... (loop)))))))) + ((forever body1 body2 ...) + (call-with-current-continuation + (lambda (escape) + (syntax-parameterize + ((abort + (syntax-rules () + ((abort value (... ...)) + (escape value (... ...)))))) + (let loop () + body1 body2 ... (loop)))))))) (define (run-tests) (test-begin "srfi-139: syntax parameters") (test (list 'old 'new) - (let ((new - (syntax-parameterize - ((foo (syntax-rules () - ((foo) 'new)))) - (foo)))) - (list (foo) new))) + (let ((new + (syntax-parameterize + ((foo (syntax-rules () + ((foo) 'new)))) + (foo)))) + (list (foo) new))) - (test 10 - (let ((i 0)) - (forever - (set! i (+ 1 i)) - (when (= i 10) - (abort))) - i)) - - - + (let ((i 0)) + (forever + (set! i (+ 1 i)) + (when (= i 10) + (abort))) + i)) (test-end))))