From 28da6d71ba26a11cf0b65e5870f37a97bfb639fc Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 7 Dec 2013 06:29:29 -0800 Subject: [PATCH 01/15] add pic_equal_p --- include/picrin.h | 2 ++ piclib/built-in.scm | 10 ---------- src/bool.c | 32 ++++++++++++++++++++++++++++++++ 3 files changed, 34 insertions(+), 10 deletions(-) diff --git a/include/picrin.h b/include/picrin.h index ff241611..afce63bf 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -100,6 +100,8 @@ int pic_get_args(pic_state *, const char *, ...); void pic_defun(pic_state *, const char *, pic_func_t); void pic_defmacro(pic_state *, const char *, struct pic_proc *); +bool pic_equal_p(pic_state *, pic_value, pic_value); + pic_sym pic_intern_cstr(pic_state *, const char *); const char *pic_symbol_name(pic_state *, pic_sym); diff --git a/piclib/built-in.scm b/piclib/built-in.scm index 89d65e84..27351492 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -260,16 +260,6 @@ (define-macro (unless test . exprs) (list 'if test #f (cons 'begin exprs))) -(define (equal? x y) - (cond - ((eqv? x y) - #t) - ((and (pair? x) (pair? y)) - (and (equal? (car x) (car y)) - (equal? (cdr x) (cdr y)))) - (else - #f))) - (define (member obj list . opts) (let ((compare (if (null? opts) equal? (car opts)))) (if (null? list) diff --git a/src/bool.c b/src/bool.c index faacf3a8..3051a1b4 100644 --- a/src/bool.c +++ b/src/bool.c @@ -1,6 +1,27 @@ #include #include "picrin.h" +#include "picrin/pair.h" + +bool +pic_equal_p(pic_state *pic, pic_value x, pic_value y) +{ + enum pic_tt type; + + if (pic_eqv_p(x, y)) + return true; + + type = pic_type(x); + if (type != pic_type(y)) + return false; + switch (type) { + case PIC_TT_PAIR: + return pic_equal_p(pic, pic_car(pic, x), pic_car(pic, y)) + && pic_equal_p(pic, pic_cdr(pic, x), pic_cdr(pic, y)); + default: + return false; + } +} static pic_value pic_bool_eq_p(pic_state *pic) @@ -22,6 +43,16 @@ pic_bool_eqv_p(pic_state *pic) return pic_bool_value(pic_eqv_p(x, y)); } +static pic_value +pic_bool_equal_p(pic_state *pic) +{ + pic_value x, y; + + pic_get_args(pic, "oo", &x, &y); + + return pic_bool_value(pic_equal_p(pic, x, y)); +} + /* TODO: replace it with native opcode */ static pic_value pic_bool_not(pic_state *pic) @@ -48,6 +79,7 @@ pic_init_bool(pic_state *pic) { pic_defun(pic, "eq?", pic_bool_eq_p); pic_defun(pic, "eqv?", pic_bool_eqv_p); + pic_defun(pic, "equal?", pic_bool_equal_p); pic_defun(pic, "not", pic_bool_not); pic_defun(pic, "boolean?", pic_bool_boolean_p); From 24a41d8e279ab2fd0c6af472d1db4208cd2b0b81 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 7 Dec 2013 06:30:21 -0800 Subject: [PATCH 02/15] add pic_assoc --- include/picrin/pair.h | 1 + src/pair.c | 18 ++++++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/include/picrin/pair.h b/include/picrin/pair.h index 5fd18e62..0167f96c 100644 --- a/include/picrin/pair.h +++ b/include/picrin/pair.h @@ -13,6 +13,7 @@ int pic_length(pic_state *, pic_value); pic_value pic_reverse(pic_state *, pic_value); pic_value pic_assq(pic_state *, pic_value key, pic_value assoc); +pic_value pic_assoc(pic_state *, pic_value key, pic_value assoc); pic_value pic_acons(pic_state *, pic_value key, pic_value val, pic_value assoc); pic_value pic_caar(pic_state *, pic_value); diff --git a/src/pair.c b/src/pair.c index 193d4c77..83ac92d6 100644 --- a/src/pair.c +++ b/src/pair.c @@ -128,6 +128,24 @@ pic_assq(pic_state *pic, pic_value key, pic_value assoc) goto enter; } +pic_value +pic_assoc(pic_state *pic, pic_value key, pic_value assoc) +{ + pic_value cell; + + enter: + + if (pic_nil_p(assoc)) + return assoc; + + cell = pic_car(pic, assoc); + if (pic_equal_p(pic, key, pic_car(pic, cell))) + return cell; + + assoc = pic_cdr(pic, assoc); + goto enter; +} + pic_value pic_acons(pic_state *pic, pic_value key, pic_value val, pic_value assoc) { From 2f68113980a24ea391253918aef4432b3cd85a23 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 7 Dec 2013 07:03:30 -0800 Subject: [PATCH 03/15] s/PICCONF/config/g --- include/config.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/include/config.h b/include/config.h index e1bdd9e2..f6ba56e5 100644 --- a/include/config.h +++ b/include/config.h @@ -1,5 +1,5 @@ -#ifndef PICCONF_H__ -#define PICCONF_H__ +#ifndef CONFIG_H__ +#define CONFIG_H__ /* switch normal VM and direct threaded VM */ #define PIC_DIRECT_THREADED_VM 1 From a83627ef9c5779f65e57aa85f80d3e3ef870c053 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 7 Dec 2013 09:14:00 -0800 Subject: [PATCH 04/15] update submodules --- extlib/xhash | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extlib/xhash b/extlib/xhash index 350f8895..8ad46d86 160000 --- a/extlib/xhash +++ b/extlib/xhash @@ -1 +1 @@ -Subproject commit 350f8895bf888aceea87c38e38e19adfd604f9d2 +Subproject commit 8ad46d8623415d9d8b7dc80d5fc302295f9f1291 From 617ee5aa682bb13e3be9c53b58b394cdc6414f05 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 7 Dec 2013 18:38:47 -0800 Subject: [PATCH 05/15] add pic_parse --- include/picrin.h | 1 + src/parse.y | 13 +++++++++++++ 2 files changed, 14 insertions(+) diff --git a/include/picrin.h b/include/picrin.h index afce63bf..fb8079db 100644 --- a/include/picrin.h +++ b/include/picrin.h @@ -114,6 +114,7 @@ void pic_vec_extend_ip(pic_state *, struct pic_vector *, int); int pic_parse_file(pic_state *, FILE *file, pic_value *); int pic_parse_cstr(pic_state *, const char *, pic_value *); +pic_value pic_parse(pic_state *, const char *); pic_value pic_apply(pic_state *pic, struct pic_proc *, pic_value); pic_value pic_apply_argv(pic_state *pic, struct pic_proc *, size_t, ...); diff --git a/src/parse.y b/src/parse.y index 00bf58a2..23853488 100644 --- a/src/parse.y +++ b/src/parse.y @@ -431,3 +431,16 @@ pic_parse_cstr(pic_state *pic, const char *str, pic_value *v) return r; } + +pic_value +pic_parse(pic_state *pic, const char *src) +{ + pic_value vs; + int r; + + r = pic_parse_cstr(pic, src, &vs); + if (r != 1) { + return pic_undef_value(); + } + return pic_car(pic, vs); +} From 8720ffa0c5c4cc72df06829a6d60ae48ac23df4e Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 7 Dec 2013 20:42:10 -0800 Subject: [PATCH 06/15] s/DEFINE_MATH_PRED/DEFINE_ARITH_CMP/g --- src/number.c | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/src/number.c b/src/number.c index b5ac9c21..82543d69 100644 --- a/src/number.c +++ b/src/number.c @@ -79,7 +79,7 @@ pic_number_nan_p(pic_state *pic) return pic_false_value(); } -#define DEFINE_MATH_PRED(op, name) \ +#define DEFINE_ARITH_CMP(op, name) \ static pic_value \ pic_number_##name(pic_state *pic) \ { \ @@ -108,11 +108,11 @@ pic_number_nan_p(pic_state *pic) return pic_true_value(); \ } -DEFINE_MATH_PRED(=, eq) -DEFINE_MATH_PRED(<, lt) -DEFINE_MATH_PRED(>, gt) -DEFINE_MATH_PRED(<=, le) -DEFINE_MATH_PRED(>=, ge) +DEFINE_ARITH_CMP(=, eq) +DEFINE_ARITH_CMP(<, lt) +DEFINE_ARITH_CMP(>, gt) +DEFINE_ARITH_CMP(<=, le) +DEFINE_ARITH_CMP(>=, ge) static pic_value pic_number_abs(pic_state *pic) From bea04325e51e9280d96df05a38fb863935e1304f Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Sat, 7 Dec 2013 20:43:36 -0800 Subject: [PATCH 07/15] define arithmetic operators as c functions --- src/number.c | 77 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 76 insertions(+), 1 deletion(-) diff --git a/src/number.c b/src/number.c index 82543d69..225a202d 100644 --- a/src/number.c +++ b/src/number.c @@ -114,6 +114,74 @@ DEFINE_ARITH_CMP(>, gt) DEFINE_ARITH_CMP(<=, le) DEFINE_ARITH_CMP(>=, ge) +#define DEFINE_ARITH_OP(op, name, unit) \ + static pic_value \ + pic_number_##name(pic_state *pic) \ + { \ + size_t argc; \ + pic_value *argv; \ + int i; \ + double f; \ + bool e = true; \ + \ + pic_get_args(pic, "*", &argc, &argv); \ + \ + f = unit; \ + for (i = 0; i < argc; ++i) { \ + if (pic_int_p(argv[i])) { \ + f op##= pic_int(argv[i]); \ + } \ + else if (pic_float_p(argv[i])) { \ + e = false; \ + f op##= pic_float(argv[i]); \ + } \ + else { \ + pic_error(pic, #op ": number required"); \ + } \ + } \ + \ + return e ? pic_int_value((int)f) : pic_float_value(f); \ + } + +DEFINE_ARITH_OP(+, add, 0) +DEFINE_ARITH_OP(*, mul, 1) + +#define DEFINE_ARITH_INV_OP(op, name, unit, exact) \ + static pic_value \ + pic_number_##name(pic_state *pic) \ + { \ + size_t argc; \ + pic_value *argv; \ + int i; \ + double f; \ + bool e; \ + \ + pic_get_args(pic, "F*", &f, &e, &argc, &argv); \ + \ + e = e && exact; \ + \ + if (argc == 0) { \ + f = unit op f; \ + } \ + for (i = 0; i < argc; ++i) { \ + if (pic_int_p(argv[i])) { \ + f op##= pic_int(argv[i]); \ + } \ + else if (pic_float_p(argv[i])) { \ + e = false; \ + f op##= pic_float(argv[i]); \ + } \ + else { \ + pic_error(pic, #op ": number required"); \ + } \ + } \ + \ + return e ? pic_int_value((int)f) : pic_float_value(f); \ + } + +DEFINE_ARITH_INV_OP(-, sub, 0, true) +DEFINE_ARITH_INV_OP(/, div, 1, false) + static pic_value pic_number_abs(pic_state *pic) { @@ -439,8 +507,15 @@ pic_init_number(pic_state *pic) pic_defun(pic, ">", pic_number_gt); pic_defun(pic, "<=", pic_number_le); pic_defun(pic, ">=", pic_number_ge); - pic_defun(pic, "abs", pic_number_abs); + pic_gc_arena_restore(pic, ai); + pic_defun(pic, "+", pic_number_add); + pic_defun(pic, "-", pic_number_sub); + pic_defun(pic, "*", pic_number_mul); + pic_defun(pic, "/", pic_number_div); + pic_gc_arena_restore(pic, ai); + + pic_defun(pic, "abs", pic_number_abs); pic_defun(pic, "floor-quotient", pic_number_floor_quotient); pic_defun(pic, "floor-remainder", pic_number_floor_remainder); pic_defun(pic, "truncate-quotient", pic_number_trunc_quotient); From d21db9ae81c3cbf31df0c22653310f009ede72d9 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 9 Dec 2013 13:51:34 +0900 Subject: [PATCH 08/15] execute winded handlers when exit is called --- src/system.c | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/src/system.c b/src/system.c index 097389e0..ab87d58f 100644 --- a/src/system.c +++ b/src/system.c @@ -26,6 +26,7 @@ pic_system_exit(pic_state *pic) { pic_value v; int argc, status = EXIT_SUCCESS; + struct pic_block *blk; argc = pic_get_args(pic, "|o", &v); if (argc == 1) { @@ -41,6 +42,12 @@ pic_system_exit(pic_state *pic) } } + blk = pic->blk; + while (blk) { + pic_apply_argv(pic, blk->out, 0); + blk = blk->prev; + } + exit(status); } From 22e43c385e3724017559df6dc8d843af8df30695 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 9 Dec 2013 13:51:52 +0900 Subject: [PATCH 09/15] update README --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index b84b1d15..3d2f4c8f 100644 --- a/README.md +++ b/README.md @@ -76,7 +76,7 @@ | 6.11 Exceptions | yes | TODO: native error handling | | 6.12 Environments and evaluation | N/A | | | 6.13 Ports | incomplete | | -| 6.14 System interface | incomplete | `exit` is unsafe when used with dynamic-wind | +| 6.14 System interface | yes | | ## Homepage From 80aed24fd7298b8e51a7a8f4ffbf3c02d62ee134 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 9 Dec 2013 15:36:41 +0900 Subject: [PATCH 10/15] add yet another debug print --- tools/main.c | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/tools/main.c b/tools/main.c index 056186f6..103a3a82 100644 --- a/tools/main.c +++ b/tools/main.c @@ -50,6 +50,10 @@ repl(pic_state *pic) while (1) { prompt = code[0] == '\0' ? "> " : "* "; +#if DEBUG + printf("[current ai = %d]\n", ai); +#endif + #if PIC_ENABLE_READLINE read_line = readline(prompt); if (read_line == NULL) { From 3c6fd93b5a6f7e097a6982a344638c1f7f55be55 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 9 Dec 2013 15:37:21 +0900 Subject: [PATCH 11/15] add hygienic `case` syntax --- piclib/built-in.scm | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/piclib/built-in.scm b/piclib/built-in.scm index 27351492..e13777d0 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -610,3 +610,16 @@ (define (compare x y) (identifier=? use-env x use-env y)) (make-syntactic-closure mac-env '() (unwrap (f (wrap expr) inject compare)))))) + +(define-syntax case + (er-macro-transformer + (lambda (expr inject compare) + (let ((key (cadr expr)) + (clauses (cddr expr))) + `(let ((key ,key)) + ,(let loop ((clauses clauses)) + (if (null? clauses) + '#f + `(if (or ,@(map (lambda (x) `(eqv? key ,x)) (caar clauses))) + ,@(cdar clauses) + ,(loop (cdr clauses)))))))))) From daae383938952c16b2cd4e94523b1ea78cf72656 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 9 Dec 2013 15:37:29 +0900 Subject: [PATCH 12/15] add hygienic `or` syntax --- piclib/built-in.scm | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/piclib/built-in.scm b/piclib/built-in.scm index e13777d0..d026d5c2 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -611,6 +611,17 @@ (identifier=? use-env x use-env y)) (make-syntactic-closure mac-env '() (unwrap (f (wrap expr) inject compare)))))) +(define-syntax or + (er-macro-transformer + (lambda (expr inject compare) + (let ((exprs (cdr expr))) + (if (null? exprs) + #f + `(let ((it ,(car exprs))) + (if it + it + (or ,@(cdr exprs))))))))) + (define-syntax case (er-macro-transformer (lambda (expr inject compare) From 1ad4c309f49731b087ffab00632fb21f95fdf356 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 9 Dec 2013 15:41:57 +0900 Subject: [PATCH 13/15] [bugfix] case and or should be declared by ir-macro-transformer --- piclib/built-in.scm | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/piclib/built-in.scm b/piclib/built-in.scm index d026d5c2..a7fcd64d 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -612,7 +612,7 @@ (make-syntactic-closure mac-env '() (unwrap (f (wrap expr) inject compare)))))) (define-syntax or - (er-macro-transformer + (ir-macro-transformer (lambda (expr inject compare) (let ((exprs (cdr expr))) (if (null? exprs) @@ -623,14 +623,14 @@ (or ,@(cdr exprs))))))))) (define-syntax case - (er-macro-transformer + (ir-macro-transformer (lambda (expr inject compare) (let ((key (cadr expr)) (clauses (cddr expr))) `(let ((key ,key)) ,(let loop ((clauses clauses)) (if (null? clauses) - '#f + #f `(if (or ,@(map (lambda (x) `(eqv? key ,x)) (caar clauses))) ,@(cdar clauses) ,(loop (cdr clauses)))))))))) From 0dddddab55b049a0f9da2668dbf1701b4c29c688 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 9 Dec 2013 07:26:51 -0800 Subject: [PATCH 14/15] ir-macro-transformer was broken --- piclib/built-in.scm | 24 ++++++------------------ src/macro.c | 16 +++++++++++++++- 2 files changed, 21 insertions(+), 19 deletions(-) diff --git a/piclib/built-in.scm b/piclib/built-in.scm index a7fcd64d..568cff08 100644 --- a/piclib/built-in.scm +++ b/piclib/built-in.scm @@ -583,9 +583,6 @@ (identifier=? use-env x use-env y)) (make-syntactic-closure use-env '() (f expr rename compare)))) -(define (acons key val alist) - (cons (cons key val) alist)) - (define (walk f obj) (if (pair? obj) (cons (walk f (car obj)) (walk f (cdr obj))) @@ -595,21 +592,12 @@ (define (ir-macro-transformer f) (lambda (expr use-env mac-env) - (let ((wrapped '())) - (define (inject obj) - (let ((s (make-syntactic-closure use-env '() obj))) - (set! wrapped (acons s obj wrapped)) - s)) - (define (extract obj) - (let ((t (assq obj wrapped))) - (if t (cdr t) obj))) - (define (wrap expr) - (walk inject expr)) - (define (unwrap expr) - (walk extract expr)) - (define (compare x y) - (identifier=? use-env x use-env y)) - (make-syntactic-closure mac-env '() (unwrap (f (wrap expr) inject compare)))))) + (define (inject identifier) + (make-syntactic-closure use-env '() identifier)) + (define (compare x y) + (identifier=? mac-env x mac-env y)) + (let ((expr (walk (lambda (x) (if (symbol? x) (inject x) x)) expr))) + (make-syntactic-closure mac-env '() (f expr inject compare))))) (define-syntax or (ir-macro-transformer diff --git a/src/macro.c b/src/macro.c index 213b759a..531ffb1f 100644 --- a/src/macro.c +++ b/src/macro.c @@ -153,6 +153,20 @@ pic_identifier_p(pic_value obj) return false; } +static pic_value +strip(pic_state *pic, pic_value expr) +{ + if (pic_sc_p(expr)) { + return strip(pic, pic_sc(expr)->expr); + } + else if (pic_pair_p(expr)) { + return pic_cons(pic, + strip(pic, pic_car(pic, expr)), + strip(pic, pic_cdr(pic, expr))); + } + return expr; +} + static void pic_defsyntax(pic_state *pic, const char *name, struct pic_proc *macro, struct pic_senv *mac_env) { @@ -365,7 +379,7 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) pic_gc_protect(pic, v); return v; case PIC_STX_QUOTE: - v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym), pic_cdr(pic, expr)); + v = pic_cons(pic, pic_symbol_value(pic_syntax(car)->sym), strip(pic, pic_cdr(pic, expr))); pic_gc_arena_restore(pic, ai); pic_gc_protect(pic, v); return v; From e05a469a066ca75dc54705fe99c2fdeb41bcc9b8 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 9 Dec 2013 07:27:11 -0800 Subject: [PATCH 15/15] fix ir-macro-transformer --- src/macro.c | 6 +++++ t/ir-macro.scm | 61 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 67 insertions(+) create mode 100644 t/ir-macro.scm diff --git a/src/macro.c b/src/macro.c index 531ffb1f..57f79423 100644 --- a/src/macro.c +++ b/src/macro.c @@ -347,6 +347,9 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) /* defined symbol */ a = pic_car(pic, var); + if (! pic_symbol_p(a)) { + a = macroexpand(pic, a, senv); + } if (! pic_symbol_p(a)) { pic_error(pic, "binding to non-symbol object"); } @@ -364,6 +367,9 @@ macroexpand(pic_state *pic, pic_value expr, struct pic_senv *senv) return v; } + if (! pic_symbol_p(var)) { + var = macroexpand(pic, var, senv); + } if (! pic_symbol_p(var)) { pic_error(pic, "binding to non-symbol object"); } diff --git a/t/ir-macro.scm b/t/ir-macro.scm new file mode 100644 index 00000000..28d4985c --- /dev/null +++ b/t/ir-macro.scm @@ -0,0 +1,61 @@ +(define-syntax aif + (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)))))) + +(aif (member 'b '(a b c)) (car it) #f) + +;;; test hygiene begin + +(define-syntax mif + (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)))))) + +(let ((if 42)) + (mif 1 2 3)) +; => 2 + +(let ((it 42)) + (mif 1 it 2)) +; => 42 + +;;; end + + + +;;; test core syntax begin + +(mif 'a 'b 'c) +; => b + +(define-syntax loop + (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) +(loop + (if (= a 2) (exit #f)) + (set! a 2)) +; => #f + +(loop + (define a 1) + (if (= a 1) (exit #f))) +; => #f + +;;; end