From 2fb924f64f6cf47a9b4d6e8a22433ac2c5739379 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 20 Aug 2009 14:27:38 +0200 Subject: [PATCH] programs have their own tc7 now * libguile/tags.h (scm_tc7_program): * libguile/programs.h: Programs now have their own tc7 code. Fix up the macros appropriately. * libguile/programs.c: Remove smobby bits, leaving marking, printing, and application for other parts of Guile. * libguile/debug.c (scm_procedure_source): * libguile/eval.c (scm_trampoline_0, scm_trampoline_1) (scm_trampoline_2): Add cases for tc7_program. * libguile/eval.i.c (CEVAL, SCM_APPLY): * libguile/evalext.c (scm_self_evaluating_p): * libguile/gc-card.c (scm_i_sweep_card, scm_i_tag_name): * libguile/gc-mark.c (1): * libguile/print.c (iprin1): * libguile/procs.c (scm_procedure_p, scm_thunk_p) * libguile/vm-i-system.c (make-closure): Adapt to new procedure representation. * libguile/procprop.c (scm_i_procedure_arity): Do the right thing for programs. * test-suite/tests/procprop.test ("procedure-arity"): Arity test now succeeds. * libguile/goops.c (scm_class_of): Programs now belong to the class , not a smob class. * libguile/vm.h (struct vm, struct vm_cont): * libguile/vm-engine.c (vm_engine): * libguile/frames.h (SCM_FRAME_BYTE_CAST, struct vm_frame): * libguile/frames.c (scm_c_make_vm_frame): Fix usages of scm_byte_t, changing them to scm_t_uint8. --- libguile/debug.c | 1 + libguile/eval.c | 3 ++ libguile/eval.i.c | 22 +++++++++++ libguile/evalext.c | 1 + libguile/frames.c | 2 +- libguile/frames.h | 7 ++-- libguile/gc-card.c | 4 ++ libguile/gc-mark.c | 8 ++++ libguile/goops.c | 1 + libguile/print.c | 4 ++ libguile/procprop.c | 6 +++ libguile/procs.c | 5 +++ libguile/programs.c | 70 ++++++++-------------------------- libguile/programs.h | 18 ++++----- libguile/tags.h | 4 +- libguile/vm-engine.c | 2 +- libguile/vm-i-system.c | 4 +- libguile/vm.h | 6 +-- test-suite/tests/procprop.test | 4 +- 19 files changed, 91 insertions(+), 81 deletions(-) diff --git a/libguile/debug.c b/libguile/debug.c index 71278c5e4..4bf311136 100644 --- a/libguile/debug.c +++ b/libguile/debug.c @@ -363,6 +363,7 @@ SCM_DEFINE (scm_procedure_source, "procedure-source", 1, 0, 0, if (!SCM_SMOB_DESCRIPTOR (proc).apply) break; case scm_tcs_subrs: + case scm_tc7_program: procprop: /* It would indeed be a nice thing if we supplied source even for built in procedures! */ diff --git a/libguile/eval.c b/libguile/eval.c index 6a6a0ce7b..1563b5125 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -3328,6 +3328,7 @@ scm_trampoline_0 (SCM proc) case scm_tc7_rpsubr: case scm_tc7_gsubr: case scm_tc7_pws: + case scm_tc7_program: trampoline = scm_call_0; break; default: @@ -3454,6 +3455,7 @@ scm_trampoline_1 (SCM proc) case scm_tc7_rpsubr: case scm_tc7_gsubr: case scm_tc7_pws: + case scm_tc7_program: trampoline = scm_call_1; break; default: @@ -3548,6 +3550,7 @@ scm_trampoline_2 (SCM proc) break; case scm_tc7_gsubr: case scm_tc7_pws: + case scm_tc7_program: trampoline = scm_call_2; break; default: diff --git a/libguile/eval.i.c b/libguile/eval.i.c index 99aa265de..461349a2b 100644 --- a/libguile/eval.i.c +++ b/libguile/eval.i.c @@ -1132,6 +1132,8 @@ dispatch: RETURN (SCM_BOOL_T); case scm_tc7_asubr: RETURN (SCM_SUBRF (proc) (SCM_UNDEFINED, SCM_UNDEFINED)); + case scm_tc7_program: + RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0)); case scm_tc7_smob: if (!SCM_SMOB_APPLICABLE_P (proc)) goto badfun; @@ -1243,6 +1245,8 @@ dispatch: RETURN (scm_i_chase_pairs (arg1, (scm_t_bits) SCM_SUBRF (proc))); case scm_tc7_rpsubr: RETURN (SCM_BOOL_T); + case scm_tc7_program: + RETURN (scm_c_vm_run (scm_the_vm (), proc, &arg1, 1)); case scm_tc7_asubr: RETURN (SCM_SUBRF (proc) (arg1, SCM_UNDEFINED)); case scm_tc7_lsubr: @@ -1353,6 +1357,12 @@ dispatch: case scm_tc7_rpsubr: case scm_tc7_asubr: RETURN (SCM_SUBRF (proc) (arg1, arg2)); + case scm_tc7_program: + { SCM args[2]; + args[0] = arg1; + args[1] = arg2; + RETURN (scm_c_vm_run (scm_the_vm (), proc, args, 2)); + } case scm_tc7_smob: if (!SCM_SMOB_APPLICABLE_P (proc)) goto badfun; @@ -1492,6 +1502,8 @@ dispatch: SCM_CDDR (debug.info->a.args))); case scm_tc7_gsubr: RETURN (scm_i_gsubr_apply_list (proc, debug.info->a.args)); + case scm_tc7_program: + RETURN (scm_vm_apply (scm_the_vm (), proc, debug.info->a.args)); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); debug.info->a.proc = proc; @@ -1563,6 +1575,11 @@ dispatch: scm_cons2 (arg1, arg2, scm_ceval_args (x, env, proc)))); + case scm_tc7_program: + RETURN (scm_vm_apply + (scm_the_vm (), proc, + scm_cons (arg1, scm_cons (arg2, + scm_ceval_args (x, env, proc))))); case scm_tc7_pws: proc = SCM_PROCEDURE (proc); if (!SCM_CLOSUREP (proc)) @@ -1798,6 +1815,11 @@ tail: args = SCM_CDR (args); } RETURN (arg1); + case scm_tc7_program: + if (SCM_UNBNDP (arg1)) + RETURN (scm_c_vm_run (scm_the_vm (), proc, NULL, 0)); + else + RETURN (scm_vm_apply (scm_the_vm (), proc, scm_cons (arg1, args))); case scm_tc7_rpsubr: if (scm_is_null (args)) RETURN (SCM_BOOL_T); diff --git a/libguile/evalext.c b/libguile/evalext.c index 19d8f2e02..b1f185cc5 100644 --- a/libguile/evalext.c +++ b/libguile/evalext.c @@ -82,6 +82,7 @@ SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0, case scm_tc7_string: case scm_tc7_smob: case scm_tc7_pws: + case scm_tc7_program: case scm_tcs_subrs: case scm_tcs_struct: return SCM_BOOL_T; diff --git a/libguile/frames.c b/libguile/frames.c index 86480e352..737babc1a 100644 --- a/libguile/frames.c +++ b/libguile/frames.c @@ -33,7 +33,7 @@ scm_t_bits scm_tc16_vm_frame; SCM scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp, - scm_byte_t *ip, scm_t_ptrdiff offset) + scm_t_uint8 *ip, scm_t_ptrdiff offset) { struct scm_vm_frame *p = scm_gc_malloc (sizeof (struct scm_vm_frame), "vmframe"); diff --git a/libguile/frames.h b/libguile/frames.h index cce661f8f..0165924a7 100644 --- a/libguile/frames.h +++ b/libguile/frames.h @@ -56,7 +56,7 @@ + SCM_PROGRAM_DATA (SCM_FRAME_PROGRAM (fp))->nlocs) #define SCM_FRAME_LOWER_ADDRESS(fp) (fp - 4) -#define SCM_FRAME_BYTE_CAST(x) ((scm_byte_t *) SCM_UNPACK (x)) +#define SCM_FRAME_BYTE_CAST(x) ((scm_t_uint8 *) SCM_UNPACK (x)) #define SCM_FRAME_STACK_CAST(x) ((SCM *) SCM_UNPACK (x)) #define SCM_FRAME_RETURN_ADDRESS(fp) \ @@ -86,7 +86,7 @@ struct scm_vm_frame SCM stack_holder; SCM *fp; SCM *sp; - scm_byte_t *ip; + scm_t_uint8 *ip; scm_t_ptrdiff offset; }; @@ -99,9 +99,8 @@ struct scm_vm_frame #define SCM_VM_FRAME_OFFSET(f) SCM_VM_FRAME_DATA(f)->offset #define SCM_VALIDATE_VM_FRAME(p,x) SCM_MAKE_VALIDATE (p, x, VM_FRAME_P) -/* FIXME rename scm_byte_t */ SCM_API SCM scm_c_make_vm_frame (SCM stack_holder, SCM *fp, SCM *sp, - scm_byte_t *ip, scm_t_ptrdiff offset); + scm_t_uint8 *ip, scm_t_ptrdiff offset); SCM_API SCM scm_vm_frame_p (SCM obj); SCM_API SCM scm_vm_frame_program (SCM frame); SCM_API SCM scm_vm_frame_arguments (SCM frame); diff --git a/libguile/gc-card.c b/libguile/gc-card.c index 85520f8e4..af2923396 100644 --- a/libguile/gc-card.c +++ b/libguile/gc-card.c @@ -162,6 +162,8 @@ scm_i_sweep_card (scm_t_cell *card, SCM *free_list, scm_t_heap_segment *seg) break; case scm_tc7_variable: break; + case scm_tc7_program: + break; case scm_tcs_subrs: /* the various "subrs" (primitives) are never freed */ continue; @@ -386,6 +388,8 @@ scm_i_tag_name (scm_t_bits tag) return "closures"; case scm_tc7_pws: return "pws"; + case scm_tc7_program: + return "program"; case scm_tc7_wvect: return "weak vector"; case scm_tc7_vector: diff --git a/libguile/gc-mark.c b/libguile/gc-mark.c index 84714507b..ccbcdcc2f 100644 --- a/libguile/gc-mark.c +++ b/libguile/gc-mark.c @@ -40,6 +40,7 @@ extern unsigned long * __libc_ia64_register_backing_store_base; #include "libguile/smob.h" #include "libguile/unif.h" #include "libguile/async.h" +#include "libguile/programs.h" #include "libguile/ports.h" #include "libguile/root.h" #include "libguile/strings.h" @@ -285,6 +286,13 @@ scm_gc_mark_dependencies (SCM p) scm_gc_mark (SCM_CLOSCAR (ptr)); ptr = SCM_ENV (ptr); goto gc_mark_nimp; + case scm_tc7_program: + if (SCM_PROGRAM_FREE_VARIABLES (ptr) != SCM_BOOL_F) + scm_gc_mark (SCM_PROGRAM_FREE_VARIABLES (ptr)); + if (SCM_PROGRAM_OBJTABLE (ptr) != SCM_BOOL_F) + scm_gc_mark (SCM_PROGRAM_OBJTABLE (ptr)); + ptr = SCM_PROGRAM_OBJCODE (ptr); + goto gc_mark_nimp; case scm_tc7_vector: i = SCM_SIMPLE_VECTOR_LENGTH (ptr); if (i == 0) diff --git a/libguile/goops.c b/libguile/goops.c index c286dbe4c..8145e4162 100644 --- a/libguile/goops.c +++ b/libguile/goops.c @@ -241,6 +241,7 @@ SCM_DEFINE (scm_class_of, "class-of", 1, 0, 0, else return scm_class_procedure; case scm_tc7_gsubr: + case scm_tc7_program: return scm_class_procedure; case scm_tc7_pws: return scm_class_procedure_with_setter; diff --git a/libguile/print.c b/libguile/print.c index 152baef6e..74f7d8db6 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -35,6 +35,7 @@ #include "libguile/procprop.h" #include "libguile/read.h" #include "libguile/weaks.h" +#include "libguile/programs.h" #include "libguile/unif.h" #include "libguile/alist.h" #include "libguile/struct.h" @@ -682,6 +683,9 @@ iprin1 (SCM exp, SCM port, scm_print_state *pstate) case scm_tc7_variable: scm_i_variable_print (exp, port, pstate); break; + case scm_tc7_program: + scm_i_program_print (exp, port, pstate); + break; case scm_tc7_wvect: ENTER_NESTED_DATA (pstate, exp, circref); if (SCM_IS_WHVEC (exp)) diff --git a/libguile/procprop.c b/libguile/procprop.c index df96eaad4..5054291b1 100644 --- a/libguile/procprop.c +++ b/libguile/procprop.c @@ -33,6 +33,7 @@ #include "libguile/root.h" #include "libguile/vectors.h" #include "libguile/hashtab.h" +#include "libguile/programs.h" #include "libguile/validate.h" #include "libguile/procprop.h" @@ -72,6 +73,11 @@ scm_i_procedure_arity (SCM proc) case scm_tc7_lsubr: r = 1; break; + case scm_tc7_program: + a += SCM_PROGRAM_DATA (proc)->nargs; + r = SCM_PROGRAM_DATA (proc)->nrest; + a -= r; + break; case scm_tc7_lsubr_2: a += 2; r = 1; diff --git a/libguile/procs.c b/libguile/procs.c index d873ff55e..815e29fe7 100644 --- a/libguile/procs.c +++ b/libguile/procs.c @@ -112,6 +112,7 @@ SCM_DEFINE (scm_procedure_p, "procedure?", 1, 0, 0, case scm_tcs_closures: case scm_tcs_subrs: case scm_tc7_pws: + case scm_tc7_program: return SCM_BOOL_T; case scm_tc7_smob: return scm_from_bool (SCM_SMOB_DESCRIPTOR (obj).apply); @@ -151,6 +152,10 @@ SCM_DEFINE (scm_thunk_p, "thunk?", 1, 0, 0, return SCM_BOOL_T; case scm_tc7_gsubr: return scm_from_bool (SCM_GSUBR_REQ (SCM_GSUBR_TYPE (obj)) == 0); + case scm_tc7_program: + return scm_from_bool (SCM_PROGRAM_DATA (obj)->nargs == 0 + || (SCM_PROGRAM_DATA (obj)->nargs == 1 + && SCM_PROGRAM_DATA (obj)->nrest)); case scm_tc7_pws: obj = SCM_PROCEDURE (obj); goto again; diff --git a/libguile/programs.c b/libguile/programs.c index 5c43ac525..b2bf80674 100644 --- a/libguile/programs.c +++ b/libguile/programs.c @@ -31,8 +31,6 @@ #include "vm.h" -scm_t_bits scm_tc16_program; - static SCM write_program = SCM_BOOL_F; SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0, @@ -50,49 +48,13 @@ SCM_DEFINE (scm_make_program, "make-program", 1, 2, 0, else if (free_variables != SCM_BOOL_F) SCM_VALIDATE_VECTOR (3, free_variables); - SCM_RETURN_NEWSMOB3 (scm_tc16_program, objcode, objtable, free_variables); + return scm_double_cell (scm_tc7_program, (scm_t_bits)objcode, + (scm_t_bits)objtable, (scm_t_bits)free_variables); } #undef FUNC_NAME -static SCM -program_mark (SCM obj) -{ - if (scm_is_true (SCM_PROGRAM_OBJTABLE (obj))) - scm_gc_mark (SCM_PROGRAM_OBJTABLE (obj)); - if (scm_is_true (SCM_PROGRAM_FREE_VARIABLES (obj))) - scm_gc_mark (SCM_PROGRAM_FREE_VARIABLES (obj)); - return SCM_PROGRAM_OBJCODE (obj); -} - -static SCM -program_apply (SCM program, SCM args) -{ - return scm_vm_apply (scm_the_vm (), program, args); -} - -static SCM -program_apply_0 (SCM program) -{ - return scm_c_vm_run (scm_the_vm (), program, NULL, 0); -} - -static SCM -program_apply_1 (SCM program, SCM a) -{ - return scm_c_vm_run (scm_the_vm (), program, &a, 1); -} - -static SCM -program_apply_2 (SCM program, SCM a, SCM b) -{ - SCM args[2]; - args[0] = a; - args[1] = b; - return scm_c_vm_run (scm_the_vm (), program, args, 2); -} - -static int -program_print (SCM program, SCM port, scm_print_state *pstate) +void +scm_i_program_print (SCM program, SCM port, scm_print_state *pstate) { static int print_error = 0; @@ -102,12 +64,17 @@ program_print (SCM program, SCM port, scm_print_state *pstate) scm_from_locale_symbol ("write-program")); if (SCM_FALSEP (write_program) || print_error) - return scm_smob_print (program, port, pstate); - - print_error = 1; - scm_call_2 (SCM_VARIABLE_REF (write_program), program, port); - print_error = 0; - return 1; + { + scm_puts ("#', port); + } + else + { + print_error = 1; + scm_call_2 (SCM_VARIABLE_REF (write_program), program, port); + print_error = 0; + } } @@ -319,13 +286,6 @@ SCM_DEFINE (scm_program_objcode, "program-objcode", 1, 0, 0, void scm_bootstrap_programs (void) { - scm_tc16_program = scm_make_smob_type ("program", 0); - scm_set_smob_mark (scm_tc16_program, program_mark); - scm_set_smob_apply (scm_tc16_program, program_apply, 0, 0, 1); - scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_0 = program_apply_0; - scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_1 = program_apply_1; - scm_smobs[SCM_TC2SMOBNUM (scm_tc16_program)].apply_2 = program_apply_2; - scm_set_smob_print (scm_tc16_program, program_print); scm_c_register_extension ("libguile", "scm_init_programs", (scm_t_extension_init_func)scm_init_programs, NULL); } diff --git a/libguile/programs.h b/libguile/programs.h index 040e8ea2c..d52631fbb 100644 --- a/libguile/programs.h +++ b/libguile/programs.h @@ -26,19 +26,15 @@ * Programs */ -typedef unsigned char scm_byte_t; +#define SCM_F_PROGRAM_IS_BOOT (1<<16) -SCM_API scm_t_bits scm_tc16_program; - -#define SCM_F_PROGRAM_IS_BOOT (1<<0) - -#define SCM_PROGRAM_P(x) (SCM_SMOB_PREDICATE (scm_tc16_program, x)) -#define SCM_PROGRAM_OBJCODE(x) (SCM_SMOB_OBJECT (x)) -#define SCM_PROGRAM_OBJTABLE(x) (SCM_SMOB_OBJECT_2 (x)) -#define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_SMOB_OBJECT_3 (x)) +#define SCM_PROGRAM_P(x) (!SCM_IMP (x) && SCM_TYP7(x) == scm_tc7_program) +#define SCM_PROGRAM_OBJCODE(x) (SCM_CELL_OBJECT_1 (x)) +#define SCM_PROGRAM_OBJTABLE(x) (SCM_CELL_OBJECT_2 (x)) +#define SCM_PROGRAM_FREE_VARIABLES(x) (SCM_CELL_OBJECT_3 (x)) #define SCM_PROGRAM_DATA(x) (SCM_OBJCODE_DATA (SCM_PROGRAM_OBJCODE (x))) #define SCM_VALIDATE_PROGRAM(p,x) SCM_MAKE_VALIDATE (p, x, PROGRAM_P) -#define SCM_PROGRAM_IS_BOOT(x) (SCM_SMOB_FLAGS (x) & SCM_F_PROGRAM_IS_BOOT) +#define SCM_PROGRAM_IS_BOOT(x) (SCM_CELL_WORD_0 (x) & SCM_F_PROGRAM_IS_BOOT) SCM_API SCM scm_make_program (SCM objcode, SCM objtable, SCM free_variables); @@ -58,6 +54,8 @@ SCM_API SCM scm_program_objcode (SCM program); SCM_API SCM scm_c_program_source (SCM program, size_t ip); +SCM_INTERNAL void scm_i_program_print (SCM program, SCM port, + scm_print_state *pstate); SCM_INTERNAL void scm_bootstrap_programs (void); SCM_INTERNAL void scm_init_programs (void); diff --git a/libguile/tags.h b/libguile/tags.h index 329453341..9a11df51f 100644 --- a/libguile/tags.h +++ b/libguile/tags.h @@ -3,7 +3,7 @@ #ifndef SCM_TAGS_H #define SCM_TAGS_H -/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008 +/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2008,2009 * Free Software Foundation, Inc. * * This library is free software; you can redistribute it and/or @@ -453,11 +453,11 @@ typedef unsigned long scm_t_bits; #define scm_tc7_unused_6 55 #define scm_tc7_unused_7 71 #define scm_tc7_unused_8 77 -#define scm_tc7_unused_9 79 #define scm_tc7_dsubr 61 #define scm_tc7_gsubr 63 #define scm_tc7_rpsubr 69 +#define scm_tc7_program 79 #define scm_tc7_subr_0 85 #define scm_tc7_subr_1 87 #define scm_tc7_cxr 93 diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c index 32780b87a..b373cd017 100644 --- a/libguile/vm-engine.c +++ b/libguile/vm-engine.c @@ -41,7 +41,7 @@ static SCM VM_NAME (struct scm_vm *vp, SCM program, SCM *argv, int nargs) { /* VM registers */ - register scm_byte_t *ip IP_REG; /* instruction pointer */ + register scm_t_uint8 *ip IP_REG; /* instruction pointer */ register SCM *sp SP_REG; /* stack pointer */ register SCM *fp FP_REG; /* frame pointer */ diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c index cda985d15..0662f8188 100644 --- a/libguile/vm-i-system.c +++ b/libguile/vm-i-system.c @@ -1032,8 +1032,8 @@ VM_DEFINE_INSTRUCTION (59, make_closure, "make-closure", 0, 2, 1) POP (vect); SYNC_BEFORE_GC (); /* fixme underflow */ - SCM_NEWSMOB3 (*sp, scm_tc16_program, SCM_PROGRAM_OBJCODE (*sp), - SCM_PROGRAM_OBJTABLE (*sp), vect); + *sp = scm_double_cell (scm_tc7_program, (scm_t_bits)SCM_PROGRAM_OBJCODE (*sp), + (scm_t_bits)SCM_PROGRAM_OBJTABLE (*sp), (scm_t_bits)vect); NEXT; } diff --git a/libguile/vm.h b/libguile/vm.h index b079c7aa0..eace1cb69 100644 --- a/libguile/vm.h +++ b/libguile/vm.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2001 Free Software Foundation, Inc. +/* Copyright (C) 2001, 2009 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 License @@ -41,7 +41,7 @@ typedef SCM (*scm_t_vm_engine) (struct scm_vm *vp, SCM program, SCM *argv, int n #define SCM_VM_NUM_ENGINES 2 struct scm_vm { - scm_byte_t *ip; /* instruction pointer */ + scm_t_uint8 *ip; /* instruction pointer */ SCM *sp; /* stack pointer */ SCM *fp; /* frame pointer */ size_t stack_size; /* stack size */ @@ -88,7 +88,7 @@ SCM_API SCM scm_vm_stats (SCM vm); SCM_API SCM scm_vm_trace_frame (SCM vm); struct scm_vm_cont { - scm_byte_t *ip; + scm_t_uint8 *ip; SCM *sp; SCM *fp; scm_t_ptrdiff stack_size; diff --git a/test-suite/tests/procprop.test b/test-suite/tests/procprop.test index 5768e1a64..6af73f6bb 100644 --- a/test-suite/tests/procprop.test +++ b/test-suite/tests/procprop.test @@ -43,9 +43,7 @@ '(1 0 #f))) (pass-if "apply" - (equal? (if ((@ (system vm program) program?) apply) - (throw 'unresolved) - (procedure-property apply 'arity)) + (equal? (procedure-property apply 'arity) '(1 0 #t))) (pass-if "cons*" -- 2.20.1