picrin/t/ir-macro.scm

73 lines
1.3 KiB
Scheme
Raw Normal View History

(import (scheme base)
2015-06-23 12:54:46 -04:00
(picrin macro)
(picrin test))
2015-06-23 12:54:46 -04:00
(test-begin)
(define-macro aif
2013-12-09 10:27:11 -05:00
(ir-macro-transformer
(lambda (form inject cmp)
(let ((it (inject 'it))
(expr (car (cdr form)))
(then (car (cdr (cdr form))))
(else (car (cdr (cdr (cdr form))))))
`(let ((,it ,expr))
(if ,it ,then ,else))))))
2015-06-23 12:54:46 -04:00
(test 'b
(aif (member 'b '(a b c)) (car it) #f))
2013-12-09 10:27:11 -05:00
;;; test hygiene begin
2015-06-23 12:54:46 -04:00
(define-macro mif
2013-12-09 10:27:11 -05:00
(ir-macro-transformer
(lambda (form inject cmp)
(let ((expr (car (cdr form)))
(then (car (cdr (cdr form))))
(else (car (cdr (cdr (cdr form))))))
`(let ((it ,expr))
(if it ,then ,else))))))
2015-06-23 12:54:46 -04:00
(test 2
(let ((if 42))
(mif 1 2 3)))
2013-12-09 10:27:11 -05:00
; => 2
2015-06-23 12:54:46 -04:00
(test 42
(let ((it 42))
(mif 1 it 2)))
2013-12-09 10:27:11 -05:00
; => 42
;;; end
;;; test core syntax begin
2015-06-23 12:54:46 -04:00
(test 'b (mif 'a 'b 'c))
2013-12-09 10:27:11 -05:00
; => b
2015-06-23 12:54:46 -04:00
(define-macro loop
2013-12-09 10:27:11 -05:00
(ir-macro-transformer
(lambda (expr inject cmp)
(let ((body (cdr expr)))
`(call-with-current-continuation
(lambda (,(inject 'exit))
(let f ()
,@body (f))))))))
(define a 1)
2015-06-23 12:54:46 -04:00
(test #f
(loop
(if (= a 2) (exit #f))
(set! a 2)))
2013-12-09 10:27:11 -05:00
; => #f
2015-06-23 12:54:46 -04:00
(test #f
(loop
(define a 1)
(if (= a 1) (exit #f))))
2013-12-09 10:27:11 -05:00
; => #f
2015-06-23 12:54:46 -04:00
(test-end)