Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

removing tabs

Browse source
This commit is contained in:
Alex Shinn 2017-08-26 23:29:02 +09:00
parent 17b7ee3f98
commit 1ac4473942
3 changed files with 46 additions and 49 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

33
lib/srfi/139.scm
View file

@ -7,22 +7,23 @@
(define-syntax syntax-parameterize (define-syntax syntax-parameterize
(lambda (expr use-env mac-env) (lambda (expr use-env mac-env)
(let* ((_let (make-syntactic-closure mac-env '() 'let)) (let* ((_let (make-syntactic-closure mac-env '() 'let))
(_set! (make-syntactic-closure mac-env '() 'set!)) (_set! (make-syntactic-closure mac-env '() 'set!))
(_out (make-syntactic-closure mac-env '() 'out)) (_out (make-syntactic-closure mac-env '() 'out))
(_tmp (make-syntactic-closure mac-env '() 'tmp)) (_tmp (make-syntactic-closure mac-env '() 'tmp))
(bindings (cadr expr)) (bindings (cadr expr))
(body (cddr expr)) (body (cddr expr))
(keywords (map car bindings)) (keywords (map car bindings))
(transformers (map cadr bindings)) (transformers (map cadr bindings))
(cells (cells
(map (lambda (keyword) (map (lambda (keyword)
(env-cell use-env keyword)) (env-cell use-env keyword))
keywords)) keywords))
(old (map cdr cells)) (old (map cdr cells))
(new (map (lambda (transformer) (new (map (lambda (transformer)
(make-macro (eval (make-syntactic-closure use-env '() transformer)) (make-macro
use-env)) (eval (make-syntactic-closure use-env '() transformer))
transformers))) use-env))
transformers)))
(for-each set-cdr! cells new) (for-each set-cdr! cells new)
`(,_let ((,_tmp #f)) `(,_let ((,_tmp #f))
(,_set! ,_tmp (,_let () ,@body)) (,_set! ,_tmp (,_let () ,@body))

4
lib/srfi/139.sld
View file

@ -1,6 +1,6 @@
(define-library (srfi 139) (define-library (srfi 139)
(export (rename define-syntax define-syntax-parameter) (export (rename define-syntax define-syntax-parameter)
syntax-parameterize) syntax-parameterize)
(import (chibi) (import (chibi)
(chibi ast)) (chibi ast))
(include "139.scm")) (include "139.scm"))

58
lib/srfi/139/test.sld
View file

@ -6,47 +6,43 @@
(begin (begin
(define-syntax-parameter abort (define-syntax-parameter abort
(syntax-rules () (syntax-rules ()
((_ . _) ((_ . _)
(syntax-error "abort used outside of a loop")))) (syntax-error "abort used outside of a loop"))))
(define-syntax-parameter foo (define-syntax-parameter foo
(syntax-rules () (syntax-rules ()
((foo) 'old))) ((foo) 'old)))
(define-syntax forever (define-syntax forever
(syntax-rules () (syntax-rules ()
((forever body1 body2 ...) ((forever body1 body2 ...)
(call-with-current-continuation (call-with-current-continuation
(lambda (escape) (lambda (escape)
(syntax-parameterize (syntax-parameterize
((abort ((abort
(syntax-rules () (syntax-rules ()
((abort value (... ...)) ((abort value (... ...))
(escape value (... ...)))))) (escape value (... ...))))))
(let loop () (let loop ()
body1 body2 ... (loop)))))))) body1 body2 ... (loop))))))))
(define (run-tests) (define (run-tests)
(test-begin "srfi-139: syntax parameters") (test-begin "srfi-139: syntax parameters")
(test (list 'old 'new) (test (list 'old 'new)
(let ((new (let ((new
(syntax-parameterize (syntax-parameterize
((foo (syntax-rules () ((foo (syntax-rules ()
((foo) 'new)))) ((foo) 'new))))
(foo)))) (foo))))
(list (foo) new))) (list (foo) new)))
(test 10 (test 10
(let ((i 0)) (let ((i 0))
(forever (forever
(set! i (+ 1 i)) (set! i (+ 1 i))
(when (= i 10) (when (= i 10)
(abort))) (abort)))
i)) i))
(test-end)))) (test-end))))