Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Temporary testbed

Browse source
This commit is contained in:
Justin Ethier 2016-02-13 02:34:17 -05:00
parent f448245253
commit da05bc874f
1 changed files with 63 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

63
macro-testing.scm Normal file
View file

@ -0,0 +1,63 @@
(import (scheme base) (scheme write))
;(call-with-values (lambda () (values 1 2)) (lambda (x y) (write `(,x ,y))))
(define-syntax letrec*
(syntax-rules ()
((letrec* ((var val) ...) . body)
(let () (define var val) ... . body))))
(define-syntax guard
(syntax-rules ()
((guard (var clause ...) e1 e2 ...)
((call-with-current-continuation
(lambda (guard-k)
(with-exception-handler
(lambda (condition)
((call-with-current-continuation
(lambda (handler-k)
(guard-k
(lambda ()
(let ((var condition)) ; clauses may SET! var
(guard-aux (handler-k (lambda ()
(raise-continuable condition)))
clause ...))))))))
(lambda ()
(let ((res (begin e1 e2 ...)))
(guard-k (lambda () res)))))))))))
(define-syntax guard-aux
(syntax-rules (else =>)
((guard-aux reraise (else result1 result2 ...))
(begin result1 result2 ...))
((guard-aux reraise (test => result))
(let ((temp test))
(if temp (result temp) reraise)))
((guard-aux reraise (test => result) clause1 clause2 ...)
(let ((temp test))
(if temp (result temp) (guard-aux reraise clause1 clause2 ...))))
((guard-aux reraise (test))
(or test reraise))
((guard-aux reraise (test) clause1 clause2 ...)
(or test (guard-aux reraise clause1 clause2 ...)))
((guard-aux reraise (test result1 result2 ...))
(if test (begin result1 result2 ...) reraise))
((guard-aux reraise (test result1 result2 ...) clause1 clause2 ...)
(if test
(begin result1 result2 ...)
(guard-aux reraise clause1 clause2 ...)))))
(write
(letrec* ((x 1)) x))
(write
(guard (condition
((assq 'a condition) => cdr)
((assq 'b condition)))
(raise (list (cons 'a 42))))) ;=> 42
(write
(guard (condition
((assq 'a condition) => cdr)
((assq 'b condition)))
(raise (list (cons 'b 23))))) ;=> (b . 23)