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
(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))

4
lib/srfi/139.sld
View file

@ -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"))

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

@ -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))))