diff options
author | Andy Wingo <wingo@pobox.com> | 2010-05-13 17:15:10 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2010-05-14 00:28:32 +0200 |
commit | d8a071fc4e709ee83cd3c7fc935f7ec21375e624 (patch) | |
tree | 50cfb2eca1aa4d7b275c992862d9a677471a588c | |
parent | 9658182d5f51368e2888cb461edfc2f35f91c6ac (diff) | |
download | guile-d8a071fc4e709ee83cd3c7fc935f7ec21375e624.tar.gz |
primitive support for lambda*
* libguile/memoize.c (scm_m_lambda_star): Define lambda* in the
pre-psyntax env, and make it memoize lambda* expressions.
* libguile/eval.c (BOOT_CLOSURE_PARSE_FULL): New helper.
(error_invalid_keyword, error_unrecognized_keyword): New helpers.
(prepare_boot_closure_env_for_apply): Flesh out application of boot
closures with "full" arity.
(prepare_boot_closure_env_for_eval): Punt to
prepare_boot_closure_env_for_eval for the full-arity case.
* module/ice-9/eval.scm (make-fixed-closure): Rename from `closure', and
just handle fixed arities, where there is no rest argument..
(make-general-closure): New helper, a procedure, that returns a
closure that can take rest, optional, and keyword arguments.
(eval): Adapt to call make-fixed-closure or make-general-closure as
appropriate.
* test-suite/tests/optargs.test ("lambda* inits"): Test the memoizer as
well.
-rw-r--r-- | libguile/eval.c | 149 | ||||
-rw-r--r-- | libguile/memoize.c | 171 | ||||
-rw-r--r-- | module/ice-9/eval.scm | 150 | ||||
-rw-r--r-- | test-suite/tests/optargs.test | 33 |
4 files changed, 472 insertions, 31 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index fca599f61..ac004da55 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -114,8 +114,16 @@ static scm_t_bits scm_tc16_boot_closure; #define BOOT_CLOSURE_IS_REST(x) scm_is_null (CDDDR (BOOT_CLOSURE_CODE (x))) /* NB: One may only call the following accessors if the closure is not REST. */ #define BOOT_CLOSURE_IS_FULL(x) (1) -#define BOOT_CLOSURE_OPT(x) CAR (CDDDR (BOOT_CLOSURE_CODE (x))) -#define BOOT_CLOSURE_ALT(x) CADR (CDDDR (BOOT_CLOSURE_CODE (x))) +#define BOOT_CLOSURE_PARSE_FULL(x,body,nargs,rest,nopt,kw,inits,alt) \ + do { SCM mx = BOOT_CLOSURE_CODE (x); \ + body = CAR (mx); mx = CDR (mx); \ + nreq = SCM_I_INUM (CAR (mx)); mx = CDR (mx); \ + rest = CAR (mx); mx = CDR (mx); \ + nopt = SCM_I_INUM (CAR (mx)); mx = CDR (mx); \ + kw = CAR (mx); mx = CDR (mx); \ + inits = CAR (mx); mx = CDR (mx); \ + alt = CAR (mx); \ + } while (0) static SCM prepare_boot_closure_env_for_apply (SCM proc, SCM args); static SCM prepare_boot_closure_env_for_eval (SCM proc, unsigned int argc, SCM exps, SCM env); @@ -139,6 +147,21 @@ static void error_used_before_defined (void) "Variable used before given a value", SCM_EOL, SCM_BOOL_F); } +static void error_invalid_keyword (SCM proc) +{ + scm_error_scm (scm_from_locale_symbol ("keyword-argument-error"), proc, + scm_from_locale_string ("Invalid keyword"), SCM_EOL, + SCM_BOOL_F); +} + +static void error_unrecognized_keyword (SCM proc) +{ + scm_error_scm (scm_from_locale_symbol ("keyword-argument-error"), proc, + scm_from_locale_string ("Unrecognized keyword"), SCM_EOL, + SCM_BOOL_F); +} + + /* the environment: (VAL ... . MOD) If MOD is #f, it means the environment was captured before modules were @@ -900,7 +923,119 @@ prepare_boot_closure_env_for_apply (SCM proc, SCM args) env = scm_cons (args, env); } else - abort (); + { + int i, argc, nreq, nopt; + SCM body, rest, kw, inits, alt; + + BOOT_CLOSURE_PARSE_FULL (proc, body, nargs, rest, nopt, kw, inits, alt); + + argc = scm_ilength (args); + if (argc < nreq) + { + if (scm_is_true (alt)) + abort (); + else + scm_wrong_num_args (proc); + } + if (scm_is_false (kw) && argc > nreq + nopt && scm_is_false (rest)) + { + if (scm_is_true (alt)) + abort (); + else + scm_wrong_num_args (proc); + } + + for (i = 0; i < nreq; i++, args = CDR (args)) + env = scm_cons (CAR (args), env); + + if (scm_is_false (kw)) + { + /* Optional args (possibly), but no keyword args. */ + for (; i < argc && i < nreq + nopt; + i++, args = CDR (args)) + { + env = scm_cons (CAR (args), env); + inits = CDR (inits); + } + + for (; i < nreq + nopt; i++, inits = CDR (inits)) + env = scm_cons (eval (CAR (inits), env), env); + + if (scm_is_true (rest)) + env = scm_cons (args, env); + } + else + { + SCM aok; + + aok = CAR (kw); + kw = CDR (kw); + + /* Keyword args. As before, but stop at the first keyword. */ + for (; i < argc && i < nreq + nopt && !scm_is_keyword (CAR (args)); + i++, args = CDR (args), inits = CDR (inits)) + env = scm_cons (CAR (args), env); + + for (; i < nreq + nopt; i++, inits = CDR (inits)) + env = scm_cons (eval (CAR (inits), env), env); + + if (scm_is_true (rest)) + { + env = scm_cons (args, env); + i++; + } + + /* Now fill in env with unbound values, limn the rest of the args for + keywords, and fill in unbound values with their inits. */ + { + int imax = i - 1; + int kw_start_idx = i; + SCM walk, k, v; + for (walk = kw; scm_is_pair (walk); walk = CDR (walk)) + if (SCM_I_INUM (CDAR (walk)) > imax) + imax = SCM_I_INUM (CDAR (walk)); + for (; i <= imax; i++) + env = scm_cons (SCM_UNDEFINED, env); + + if (scm_is_pair (args) && scm_is_pair (CDR (args))) + for (; scm_is_pair (args) && scm_is_pair (CDR (args)); + args = CDR (args)) + { + k = CAR (args); v = CADR (args); + if (!scm_is_keyword (k)) + { + if (scm_is_true (rest)) + continue; + else + break; + } + for (walk = kw; scm_is_pair (walk); walk = CDR (walk)) + if (scm_is_eq (k, CAAR (walk))) + { + /* Well... ok, list-set! isn't the nicest interface, but + hey. */ + int iset = imax - SCM_I_INUM (CDAR (walk)); + scm_list_set_x (env, SCM_I_MAKINUM (iset), v); + args = CDR (args); + break; + } + if (scm_is_null (walk) && scm_is_false (aok)) + error_unrecognized_keyword (proc); + } + if (scm_is_pair (args) && scm_is_false (rest)) + error_invalid_keyword (proc); + + /* Now fill in unbound values, evaluating init expressions in their + appropriate environment. */ + for (i = imax - kw_start_idx; scm_is_pair (inits); i--, inits = CDR (inits)) + { + SCM tail = scm_list_tail (env, SCM_I_MAKINUM (i)); + if (SCM_UNBNDP (CAR (tail))) + SCM_SETCAR (tail, eval (CAR (inits), CDR (tail))); + } + } + } + } return env; } @@ -935,7 +1070,13 @@ prepare_boot_closure_env_for_eval (SCM proc, unsigned int argc, } } else - abort (); + { + SCM args = SCM_EOL; + for (; scm_is_pair (exps); exps = CDR (exps)) + args = scm_cons (eval (CAR (exps), env), args); + scm_reverse_x (args, SCM_UNDEFINED); + new_env = prepare_boot_closure_env_for_apply (proc, args); + } return new_env; } diff --git a/libguile/memoize.c b/libguile/memoize.c index 2cfb0cb00..1b54a4b98 100644 --- a/libguile/memoize.c +++ b/libguile/memoize.c @@ -272,6 +272,7 @@ static SCM scm_m_with_fluids (SCM xorig, SCM env); static SCM scm_m_eval_when (SCM xorig, SCM env); static SCM scm_m_if (SCM xorig, SCM env); static SCM scm_m_lambda (SCM xorig, SCM env); +static SCM scm_m_lambda_star (SCM xorig, SCM env); static SCM scm_m_let (SCM xorig, SCM env); static SCM scm_m_letrec (SCM xorig, SCM env); static SCM scm_m_letstar (SCM xorig, SCM env); @@ -429,6 +430,7 @@ SCM_SYNTAX (s_cond, "cond", scm_m_cond); SCM_SYNTAX (s_letrec, "letrec", scm_m_letrec); SCM_SYNTAX (s_letstar, "let*", scm_m_letstar); SCM_SYNTAX (s_or, "or", scm_m_or); +SCM_SYNTAX (s_lambda_star, "lambda*", scm_m_lambda_star); SCM_GLOBAL_SYMBOL (scm_sym_apply, "apply"); SCM_GLOBAL_SYMBOL (scm_sym_arrow, "=>"); @@ -454,6 +456,7 @@ SCM_GLOBAL_SYMBOL (scm_sym_or, "or"); SCM_GLOBAL_SYMBOL (scm_sym_at_prompt, "@prompt"); SCM_GLOBAL_SYMBOL (scm_sym_quote, "quote"); SCM_GLOBAL_SYMBOL (scm_sym_set_x, "set!"); +SCM_SYMBOL (sym_lambda_star, "lambda*"); SCM_SYMBOL (sym_eval, "eval"); SCM_SYMBOL (sym_load, "load"); @@ -461,6 +464,11 @@ SCM_GLOBAL_SYMBOL (scm_sym_unquote, "unquote"); SCM_GLOBAL_SYMBOL (scm_sym_quasiquote, "quasiquote"); SCM_GLOBAL_SYMBOL (scm_sym_uq_splicing, "unquote-splicing"); +SCM_KEYWORD (kw_allow_other_keys, "allow-other-keys"); +SCM_KEYWORD (kw_optional, "optional"); +SCM_KEYWORD (kw_key, "key"); +SCM_KEYWORD (kw_rest, "rest"); + static SCM scm_m_at (SCM expr, SCM env SCM_UNUSED) @@ -732,6 +740,169 @@ scm_m_lambda (SCM expr, SCM env SCM_UNUSED) return MAKMEMO_LAMBDA (body, FIXED_ARITY (nreq)); } +static SCM +scm_m_lambda_star (SCM expr, SCM env) +{ + SCM req, opt, kw, allow_other_keys, rest, formals, body; + SCM inits, kw_indices; + int nreq, nopt; + + const long length = scm_ilength (expr); + ASSERT_SYNTAX (length >= 1, s_bad_expression, expr); + ASSERT_SYNTAX (length >= 3, s_missing_expression, expr); + + formals = CADR (expr); + body = CDDR (expr); + + nreq = nopt = 0; + req = opt = kw = SCM_EOL; + rest = allow_other_keys = SCM_BOOL_F; + + while (scm_is_pair (formals) && scm_is_symbol (CAR (formals))) + { + nreq++; + req = scm_cons (CAR (formals), req); + formals = scm_cdr (formals); + } + + if (scm_is_pair (formals) && scm_is_eq (CAR (formals), kw_optional)) + { + formals = CDR (formals); + while (scm_is_pair (formals) + && (scm_is_symbol (CAR (formals)) || scm_is_pair (CAR (formals)))) + { + nopt++; + opt = scm_cons (CAR (formals), opt); + formals = scm_cdr (formals); + } + } + + if (scm_is_pair (formals) && scm_is_eq (CAR (formals), kw_key)) + { + formals = CDR (formals); + while (scm_is_pair (formals) + && (scm_is_symbol (CAR (formals)) || scm_is_pair (CAR (formals)))) + { + kw = scm_cons (CAR (formals), kw); + formals = scm_cdr (formals); + } + } + + if (scm_is_pair (formals) && scm_is_eq (CAR (formals), kw_allow_other_keys)) + { + formals = CDR (formals); + allow_other_keys = SCM_BOOL_T; + } + + if (scm_is_pair (formals) && scm_is_eq (CAR (formals), kw_rest)) + { + if (scm_ilength (formals) != 2) + syntax_error (s_bad_formals, CADR (expr), expr); + else + rest = CADR (formals); + } + else if (scm_is_symbol (formals)) + rest = formals; + else if (!scm_is_null (formals)) + syntax_error (s_bad_formals, CADR (expr), expr); + else + rest = SCM_BOOL_F; + + /* Now, iterate through them a second time, building up an expansion-time + environment, checking, expanding and canonicalizing the opt/kw init forms, + and eventually memoizing the body as well. Note that the rest argument, if + any, is expanded before keyword args, thus necessitating the second + pass. + + Also note that the specific environment during expansion of init + expressions here needs to coincide with the environment when psyntax + expands. A lot of effort for something that is only used in the bootstrap + memoizer, you say? Yes. Yes it is. + */ + + inits = SCM_EOL; + + /* nreq is already set, and req is already reversed: simply extend. */ + env = memoize_env_extend (env, req); + + /* Build up opt inits and env */ + opt = scm_reverse_x (opt, SCM_EOL); + while (scm_is_pair (opt)) + { + SCM x = CAR (opt); + if (scm_is_symbol (x)) + inits = scm_cons (MAKMEMO_QUOTE (SCM_BOOL_F), inits); + else if (scm_ilength (x) == 2 && scm_is_symbol (CAR (x))) + inits = scm_cons (memoize (CADR (x), env), inits); + else + syntax_error (s_bad_formals, CADR (expr), expr); + env = scm_cons (scm_is_symbol (x) ? x : CAR (x), env); + opt = CDR (opt); + } + + /* Process rest before keyword args */ + if (scm_is_true (rest)) + env = scm_cons (rest, env); + + /* Build up kw inits, env, and kw-indices alist */ + if (scm_is_null (kw)) + kw_indices = SCM_BOOL_F; + else + { + int idx = nreq + nopt + (scm_is_true (rest) ? 1 : 0); + + kw_indices = SCM_EOL; + kw = scm_reverse_x (kw, SCM_EOL); + while (scm_is_pair (kw)) + { + SCM x, sym, k, init; + x = CAR (kw); + if (scm_is_symbol (x)) + { + sym = x; + init = SCM_BOOL_F; + k = scm_symbol_to_keyword (sym); + } + else if (scm_ilength (x) == 2 && scm_is_symbol (CAR (x))) + { + sym = CAR (x); + init = CADR (x); + k = scm_symbol_to_keyword (sym); + } + else if (scm_ilength (x) == 3 && scm_is_symbol (CAR (x)) + && scm_is_keyword (CADDR (x))) + { + sym = CAR (x); + init = CADR (x); + k = CADDR (x); + } + else + syntax_error (s_bad_formals, CADR (expr), expr); + + kw_indices = scm_acons (k, SCM_I_MAKINUM (idx++), kw_indices); + inits = scm_cons (memoize (init, env), inits); + env = scm_cons (sym, env); + kw = CDR (kw); + } + kw_indices = scm_cons (allow_other_keys, + scm_reverse_x (kw_indices, SCM_UNDEFINED)); + } + + /* We should check for no duplicates, but given that psyntax does this + already, we can punt on it here... */ + + inits = scm_reverse_x (inits, SCM_UNDEFINED); + body = memoize_sequence (body, env); + + if (scm_is_false (kw_indices) && scm_is_false (rest) && !nopt) + return MAKMEMO_LAMBDA (body, FIXED_ARITY (nreq)); + if (scm_is_false (kw_indices) && !nopt) + return MAKMEMO_LAMBDA (body, REST_ARITY (nreq, SCM_BOOL_T)); + else + return MAKMEMO_LAMBDA (body, FULL_ARITY (nreq, rest, nopt, kw_indices, inits, + SCM_BOOL_F)); +} + /* Check if the format of the bindings is ((<symbol> <init-form>) ...). */ static void check_bindings (const SCM bindings, const SCM expr) diff --git a/module/ice-9/eval.scm b/module/ice-9/eval.scm index ad3606a62..d4d4eb86d 100644 --- a/module/ice-9/eval.scm +++ b/module/ice-9/eval.scm @@ -55,7 +55,8 @@ (and (current-module) the-root-module) env))))) - (define-syntax make-closure + ;; Fast case for procedures with fixed arities. + (define-syntax make-fixed-closure (lambda (x) (define *max-static-argument-count* 8) (define (make-formals n) @@ -66,22 +67,17 @@ (string (integer->char (+ (char->integer #\a) i)))))) (iota n))) (syntax-case x () - ((_ eval nreq rest? body env) (not (identifier? #'env)) + ((_ eval nreq body env) (not (identifier? #'env)) #'(let ((e env)) - (make-closure eval nreq rest? body e))) - ((_ eval nreq rest? body env) + (make-fixed-closure eval nreq body e))) + ((_ eval nreq body env) #`(case nreq #,@(map (lambda (nreq) (let ((formals (make-formals nreq))) #`((#,nreq) - (if rest? - (lambda (#,@formals . rest) - (eval body - (cons* rest #,@(reverse formals) - env))) - (lambda (#,@formals) - (eval body - (cons* #,@(reverse formals) env))))))) + (lambda (#,@formals) + (eval body + (cons* #,@(reverse formals) env)))))) (iota *max-static-argument-count*)) (else #,(let ((formals (make-formals *max-static-argument-count*))) @@ -91,13 +87,11 @@ (args more)) (if (zero? nreq) (eval body - (if rest? - (cons args new-env) - (if (not (null? args)) - (scm-error 'wrong-number-of-args - "eval" "Wrong number of arguments" - '() #f) - new-env))) + (if (null? args) + new-env + (scm-error 'wrong-number-of-args + "eval" "Wrong number of arguments" + '() #f))) (if (null? args) (scm-error 'wrong-number-of-args "eval" "Wrong number of arguments" @@ -218,6 +212,114 @@ (define primitive-eval (let () + ;; We pre-generate procedures with fixed arities, up to some number of + ;; arguments; see make-fixed-closure above. + + ;; A unique marker for unbound keywords. + (define unbound-arg (list 'unbound-arg)) + + ;; Procedures with rest, optional, or keyword arguments. + (define (make-general-closure env body nreq rest? nopt kw inits alt) + (lambda args + (let lp ((env env) + (nreq nreq) + (args args)) + (if (> nreq 0) + ;; First, bind required arguments. + (if (null? args) + (scm-error 'wrong-number-of-args + "eval" "Wrong number of arguments" + '() #f) + (lp (cons (car args) env) + (1- nreq) + (cdr args))) + ;; Move on to optional arguments. + (if (not kw) + ;; Without keywords, bind optionals from arguments. + (let lp ((env env) + (nopt nopt) + (args args) + (inits inits)) + (if (zero? nopt) + (if rest? + (eval body (cons args env)) + (if (null? args) + (eval body env) + (scm-error 'wrong-number-of-args + "eval" "Wrong number of arguments" + '() #f))) + (if (null? args) + (lp (cons (eval (car inits) env) env) + (1- nopt) args (cdr inits)) + (lp (cons (car args) env) + (1- nopt) (cdr args) (cdr inits))))) + ;; With keywords, we stop binding optionals at the first + ;; keyword. + (let lp ((env env) + (nopt* nopt) + (args args) + (inits inits)) + (if (> nopt* 0) + (if (or (null? args) (keyword? (car args))) + (lp (cons (eval (car inits) env) env) + (1- nopt*) args (cdr inits)) + (lp (cons (car args) env) + (1- nopt*) (cdr args) (cdr inits))) + ;; Finished with optionals. + (let* ((aok (car kw)) + (kw (cdr kw)) + (kw-base (+ nopt nreq (if rest? 1 0))) + (imax (let lp ((imax (1- kw-base)) (kw kw)) + (if (null? kw) + imax + (lp (max (cdar kw) imax) + (cdr kw))))) + ;; Fill in kwargs with "undefined" vals. + (env (let lp ((i kw-base) + ;; Also, here we bind the rest + ;; arg, if any. + (env (if rest? (cons args env) env))) + (if (<= i imax) + (lp (1+ i) (cons unbound-arg env)) + env)))) + ;; Now scan args for keywords. + (let lp ((args args)) + (if (and (pair? args) (pair? (cdr args)) + (keyword? (car args))) + (let ((kw-pair (assq (car args) kw)) + (v (cadr args))) + (if kw-pair + ;; Found a known keyword; set its value. + (list-set! env (- imax (cdr kw-pair)) v) + ;; Unknown keyword. + (if (not aok) + (scm-error 'keyword-argument-error + "eval" "Unrecognized keyword" + '() #f))) + (lp (cddr args))) + (if (pair? args) + (if rest? + ;; Be lenient parsing rest args. + (lp (cdr args)) + (scm-error 'keyword-argument-error + "eval" "Invalid keyword" + '() #f)) + ;; Finished parsing keywords. Fill in + ;; uninitialized kwargs by evalling init + ;; expressions in their appropriate + ;; environment. + (let lp ((i (- imax kw-base)) + (inits inits)) + (if (pair? inits) + (let ((tail (list-tail env i))) + (if (eq? (car tail) unbound-arg) + (set-car! tail + (eval (car inits) + (cdr tail)))) + (lp (1- i) (cdr inits))) + ;; Finally, eval the body. + (eval body env)))))))))))))) + ;; The "engine". EXP is a memoized expression. (define (eval exp env) (memoized-expression-case exp @@ -256,9 +358,13 @@ (cons (eval (car inits) env) new-env))))) (('lambda (body nreq . tail)) - (make-closure eval nreq (and (pair? tail) (car tail)) - body (capture-env env))) - + (if (null? tail) + (make-fixed-closure eval nreq body (capture-env env)) + (if (null? (cdr tail)) + (make-general-closure (capture-env env) body nreq (car tail) + 0 #f '() #f) + (apply make-general-closure (capture-env env) body nreq tail)))) + (('begin (first . rest)) (let lp ((first first) (rest rest)) (if (null? rest) diff --git a/test-suite/tests/optargs.test b/test-suite/tests/optargs.test index 1f9313bfd..f3e4e03a3 100644 --- a/test-suite/tests/optargs.test +++ b/test-suite/tests/optargs.test @@ -1,7 +1,7 @@ ;;;; optargs.test --- test suite for optional arg processing -*- scheme -*- ;;;; Matthias Koeppe <mkoeppe@mail.math.uni-magdeburg.de> --- June 2001 ;;;; -;;;; Copyright (C) 2001, 2006, 2009 Free Software Foundation, Inc. +;;;; Copyright (C) 2001, 2006, 2009, 2010 Free Software Foundation, Inc. ;;;; ;;;; This library is free software; you can redistribute it and/or ;;;; modify it under the terms of the GNU Lesser General Public @@ -45,11 +45,34 @@ exc (compile 'exp #:to 'value #:env (current-module))))))) +(define-syntax c&m&e + (syntax-rules (pass-if pass-if-exception) + ((_ (pass-if test-name exp)) + (begin (pass-if (string-append test-name " (eval)") + (primitive-eval 'exp)) + (pass-if (string-append test-name " (memoized eval)") + (primitive-eval (memoize-expression 'exp))) + (pass-if (string-append test-name " (compile)") + (compile 'exp #:to 'value #:env (current-module))))) + ((_ (pass-if-exception test-name exc exp)) + (begin (pass-if-exception (string-append test-name " (eval)") + exc (primitive-eval 'exp)) + (pass-if-exception (string-append test-name " (memoized eval)") + exc (primitive-eval (memoize-expression 'exp))) + (pass-if-exception (string-append test-name " (compile)") + exc (compile 'exp #:to 'value + #:env (current-module))))))) + (define-syntax with-test-prefix/c&e (syntax-rules () ((_ section-name exp ...) (with-test-prefix section-name (c&e exp) ...)))) +(define-syntax with-test-prefix/c&m&e + (syntax-rules () + ((_ section-name exp ...) + (with-test-prefix section-name (c&m&e exp) ...)))) + (with-test-prefix/c&e "optional argument processing" (pass-if "local defines work with optional arguments" (eval '(begin @@ -174,12 +197,12 @@ (equal? (f 1 2 3 #:x 'x #:z 'z) '(x #f z (1 2 3 #:x x #:z z)))))) -(with-test-prefix/c&e "lambda* inits" +(with-test-prefix/c&m&e "lambda* inits" (pass-if "can bind lexicals within inits" (begin - (define* (qux #:optional a - #:key (b (or a 13) #:a)) - b) + (define qux + (lambda* (#:optional a #:key (b (or a 13) #:a)) + b)) #t)) (pass-if "testing qux" (and (equal? (qux) 13) |