-/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010
+/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002,2003,2004,2005,2006,2007,2008,2009,2010,2011
* Free Software Foundation, Inc.
*
* This library is free software; you can redistribute it and/or
#include "libguile/deprecation.h"
#include "libguile/dynwind.h"
#include "libguile/eq.h"
+#include "libguile/expand.h"
#include "libguile/feature.h"
#include "libguile/fluids.h"
#include "libguile/goops.h"
#include "libguile/hash.h"
#include "libguile/hashtab.h"
-#include "libguile/lang.h"
#include "libguile/list.h"
#include "libguile/macros.h"
#include "libguile/memoize.h"
#define BOOT_CLOSURE_P(obj) SCM_TYP16_PREDICATE (scm_tc16_boot_closure, (obj))
#define BOOT_CLOSURE_CODE(x) SCM_SMOB_OBJECT (x)
#define BOOT_CLOSURE_ENV(x) SCM_SMOB_OBJECT_2 (x)
-#define BOOT_CLOSURE_NUM_REQUIRED_ARGS(x) SCM_I_INUM (CAR (BOOT_CLOSURE_CODE (x)))
-#define BOOT_CLOSURE_HAS_REST_ARGS(x) scm_is_true (CADR (BOOT_CLOSURE_CODE (x)))
-#define BOOT_CLOSURE_BODY(x) CDDR (BOOT_CLOSURE_CODE (x))
+#define BOOT_CLOSURE_BODY(x) CAR (BOOT_CLOSURE_CODE (x))
+#define BOOT_CLOSURE_NUM_REQUIRED_ARGS(x) SCM_I_INUM (CADR (BOOT_CLOSURE_CODE (x)))
+#define BOOT_CLOSURE_IS_FIXED(x) scm_is_null (CDDR (BOOT_CLOSURE_CODE (x)))
+/* NB: One may only call the following accessors if the closure is not FIXED. */
+#define BOOT_CLOSURE_HAS_REST_ARGS(x) scm_is_true (CADDR (BOOT_CLOSURE_CODE (x)))
+#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_PARSE_FULL(fu_,body,nargs,rest,nopt,kw,inits,alt) \
+ do { SCM fu = fu_; \
+ body = CAR (fu); fu = CDR (fu); \
+ \
+ rest = kw = alt = SCM_BOOL_F; \
+ inits = SCM_EOL; \
+ nopt = 0; \
+ \
+ nreq = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \
+ if (scm_is_pair (fu)) \
+ { \
+ rest = CAR (fu); fu = CDR (fu); \
+ if (scm_is_pair (fu)) \
+ { \
+ nopt = SCM_I_INUM (CAR (fu)); fu = CDR (fu); \
+ kw = CAR (fu); fu = CDR (fu); \
+ inits = CAR (fu); fu = CDR (fu); \
+ alt = CAR (fu); \
+ } \
+ } \
+ } while (0)
+static void prepare_boot_closure_env_for_apply (SCM proc, SCM args,
+ SCM *out_body, SCM *out_env);
+static void prepare_boot_closure_env_for_eval (SCM proc, unsigned int argc,
+ SCM exps, SCM *out_body,
+ SCM *inout_env);
-
-#if 0
#define CAR(x) SCM_CAR(x)
#define CDR(x) SCM_CDR(x)
#define CAAR(x) SCM_CAAR(x)
#define CDDR(x) SCM_CDDR(x)
#define CADDR(x) SCM_CADDR(x)
#define CDDDR(x) SCM_CDDDR(x)
-#else
-#define CAR(x) scm_car(x)
-#define CDR(x) scm_cdr(x)
-#define CAAR(x) scm_caar(x)
-#define CADR(x) scm_cadr(x)
-#define CDAR(x) scm_cdar(x)
-#define CDDR(x) scm_cddr(x)
-#define CADDR(x) scm_caddr(x)
-#define CDDDR(x) scm_cdddr(x)
-#endif
SCM_SYMBOL (scm_unbound_variable_key, "unbound-variable");
"Variable used before given a value", SCM_EOL, SCM_BOOL_F);
}
-int
-scm_badargsp (SCM formals, SCM args)
+static void error_invalid_keyword (SCM proc)
{
- while (!scm_is_null (formals))
- {
- if (!scm_is_pair (formals))
- return 0;
- if (scm_is_null (args))
- return 1;
- formals = CDR (formals);
- args = CDR (args);
- }
- return !scm_is_null (args) ? 1 : 0;
+ scm_error_scm (scm_from_latin1_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_latin1_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
{
SCM mx;
SCM proc = SCM_UNDEFINED, args = SCM_EOL;
+ unsigned int argc;
loop:
SCM_TICK;
* ARGS is the list of arguments. */
if (BOOT_CLOSURE_P (proc))
{
- int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc);
- SCM new_env = BOOT_CLOSURE_ENV (proc);
- if (BOOT_CLOSURE_HAS_REST_ARGS (proc))
- {
- if (SCM_UNLIKELY (scm_ilength (args) < nreq))
- scm_wrong_num_args (proc);
- for (; nreq; nreq--, args = CDR (args))
- new_env = scm_cons (CAR (args), new_env);
- new_env = scm_cons (args, new_env);
- }
- else
- {
- if (SCM_UNLIKELY (scm_ilength (args) != nreq))
- scm_wrong_num_args (proc);
- for (; scm_is_pair (args); args = CDR (args))
- new_env = scm_cons (CAR (args), new_env);
- }
- x = BOOT_CLOSURE_BODY (proc);
- env = new_env;
+ prepare_boot_closure_env_for_apply (proc, args, &x, &env);
goto loop;
}
else
- return scm_vm_apply (scm_the_vm (), proc, args);
+ return scm_call_with_vm (scm_the_vm (), proc, args);
case SCM_M_CALL:
/* Evaluate the procedure to be applied. */
proc = eval (CAR (mx), env);
- /* int nargs = CADR (mx); */
+ argc = SCM_I_INUM (CADR (mx));
mx = CDDR (mx);
if (BOOT_CLOSURE_P (proc))
{
- int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc);
- SCM new_env = BOOT_CLOSURE_ENV (proc);
- if (BOOT_CLOSURE_HAS_REST_ARGS (proc))
- {
- if (SCM_UNLIKELY (scm_ilength (mx) < nreq))
- scm_wrong_num_args (proc);
- for (; nreq; nreq--, mx = CDR (mx))
- new_env = scm_cons (eval (CAR (mx), env), new_env);
- {
- SCM rest = SCM_EOL;
- for (; scm_is_pair (mx); mx = CDR (mx))
- rest = scm_cons (eval (CAR (mx), env), rest);
- new_env = scm_cons (scm_reverse (rest),
- new_env);
- }
- }
- else
- {
- for (; scm_is_pair (mx); mx = CDR (mx), nreq--)
- new_env = scm_cons (eval (CAR (mx), env), new_env);
- if (SCM_UNLIKELY (nreq != 0))
- scm_wrong_num_args (proc);
- }
- x = BOOT_CLOSURE_BODY (proc);
- env = new_env;
+ prepare_boot_closure_env_for_eval (proc, argc, mx, &x, &env);
goto loop;
}
else
{
- SCM rest = SCM_EOL;
- /* FIXME: use alloca */
- for (; scm_is_pair (mx); mx = CDR (mx))
- rest = scm_cons (eval (CAR (mx), env), rest);
- return scm_vm_apply (scm_the_vm (), proc, scm_reverse (rest));
+ SCM *argv;
+ unsigned int i;
+
+ argv = alloca (argc * sizeof (SCM));
+ for (i = 0; i < argc; i++, mx = CDR (mx))
+ argv[i] = eval (CAR (mx), env);
+
+ return scm_c_vm_run (scm_the_vm (), proc, argv, argc);
}
-
+
case SCM_M_CONT:
return scm_i_call_with_current_continuation (eval (mx, env));
producer = eval (CAR (mx), env);
proc = eval (CDR (mx), env); /* proc is the consumer. */
- v = scm_vm_apply (scm_the_vm (), producer, SCM_EOL);
+ v = scm_call_with_vm (scm_the_vm (), producer, SCM_EOL);
if (SCM_VALUESP (v))
args = scm_struct_ref (v, SCM_INUM0);
else
case SCM_M_PROMPT:
{
- SCM prompt, handler, res;
+ SCM vm, prompt, handler, res;
- prompt = scm_c_make_prompt (scm_the_vm (), eval (CAR (mx), env), 0);
+ vm = scm_the_vm ();
+ prompt = scm_c_make_prompt (eval (CAR (mx), env), SCM_VM_DATA (vm)->fp,
+ SCM_VM_DATA (vm)->sp, SCM_VM_DATA (vm)->ip,
+ 0, -1, scm_i_dynwinds ());
handler = eval (CDDR (mx), env);
scm_i_set_dynwinds (scm_cons (prompt, scm_i_dynwinds ()));
if (SCM_PROMPT_SETJMP (prompt))
{
- /* The prompt exited nonlocally. The args are on the VM stack. */
- size_t i, n;
- SCM vals = SCM_EOL;
- n = scm_to_size_t (SCM_PROMPT_REGISTERS (prompt)->sp[0]);
- for (i = 0; i < n; i++)
- vals = scm_cons (SCM_PROMPT_REGISTERS (prompt)->sp[-(i + 1)], vals);
- /* The abort did reset the VM's registers, but then these values
- were pushed on; so we need to pop them ourselves. */
- SCM_VM_DATA (scm_the_vm ())->sp -= n + 1;
- /* FIXME NULLSTACK */
-
- /* FIXME mark cont as non-reentrant */
+ /* The prompt exited nonlocally. */
proc = handler;
- args = vals;
+ args = scm_i_prompt_pop_abort_args_x (prompt);
goto apply_proc;
}
}
}
-scm_t_option scm_eval_opts[] = {
- { SCM_OPTION_INTEGER, "stack", 22000, "Size of thread stacks (in machine words)." },
- { 0 }
-};
-
-scm_t_option scm_debug_opts[] = {
- { SCM_OPTION_BOOLEAN, "cheap", 1,
- "*This option is now obsolete. Setting it has no effect." },
- { SCM_OPTION_BOOLEAN, "breakpoints", 0, "*Check for breakpoints." },
- { SCM_OPTION_BOOLEAN, "trace", 0, "*Trace mode." },
- { SCM_OPTION_BOOLEAN, "procnames", 1,
- "Record procedure names at definition." },
- { SCM_OPTION_BOOLEAN, "backwards", 0,
- "Display backtrace in anti-chronological order." },
- { SCM_OPTION_INTEGER, "width", 79, "Maximal width of backtrace." },
- { SCM_OPTION_INTEGER, "indent", 10, "Maximal indentation in backtrace." },
- { SCM_OPTION_INTEGER, "frames", 3,
- "Maximum number of tail-recursive frames in backtrace." },
- { SCM_OPTION_INTEGER, "maxdepth", 1000,
- "Maximal number of stored backtrace frames." },
- { SCM_OPTION_INTEGER, "depth", 20, "Maximal length of printed backtrace." },
- { SCM_OPTION_BOOLEAN, "backtrace", 0, "Show backtrace on error." },
- { SCM_OPTION_BOOLEAN, "debug", 0, "Use the debugging evaluator." },
- /* This default stack limit will be overridden by debug.c:init_stack_limit(),
- if we have getrlimit() and the stack limit is not INFINITY. But it is still
- important, as some systems have both the soft and the hard limits set to
- INFINITY; in that case we fall back to this value.
-
- The situation is aggravated by certain compilers, which can consume
- "beaucoup de stack", as they say in France.
-
- See http://thread.gmane.org/gmane.lisp.guile.devel/8599/focus=8662 for
- more discussion. This setting is 640 KB on 32-bit arches (should be enough
- for anyone!) or a whoppin' 1280 KB on 64-bit arches.
- */
- { SCM_OPTION_INTEGER, "stack", 160000, "Stack size limit (measured in words; 0 = no check)." },
- { SCM_OPTION_SCM, "show-file-name", (unsigned long)SCM_BOOL_T,
- "Show file names and line numbers "
- "in backtraces when not `#f'. A value of `base' "
- "displays only base names, while `#t' displays full names."},
- { SCM_OPTION_BOOLEAN, "warn-deprecated", 0,
- "Warn when deprecated features are used." },
- { 0 },
-};
-
-
-/*
- * this ordering is awkward and illogical, but we maintain it for
- * compatibility. --hwn
- */
-scm_t_option scm_evaluator_trap_table[] = {
- { SCM_OPTION_BOOLEAN, "traps", 0, "Enable evaluator traps." },
- { SCM_OPTION_BOOLEAN, "enter-frame", 0, "Trap when eval enters new frame." },
- { SCM_OPTION_BOOLEAN, "apply-frame", 0, "Trap when entering apply." },
- { SCM_OPTION_BOOLEAN, "exit-frame", 0, "Trap when exiting eval or apply." },
- { SCM_OPTION_SCM, "enter-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for enter-frame traps." },
- { SCM_OPTION_SCM, "apply-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for apply-frame traps." },
- { SCM_OPTION_SCM, "exit-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for exit-frame traps." },
- { SCM_OPTION_BOOLEAN, "memoize-symbol", 0, "Trap when memoizing a symbol." },
- { SCM_OPTION_SCM, "memoize-symbol-handler", (unsigned long)SCM_BOOL_F, "The handler for memoization." },
- { 0 }
-};
-
-
-SCM_DEFINE (scm_eval_options_interface, "eval-options-interface", 0, 1, 0,
- (SCM setting),
- "Option interface for the evaluation options. Instead of using\n"
- "this procedure directly, use the procedures @code{eval-enable},\n"
- "@code{eval-disable}, @code{eval-set!} and @code{eval-options}.")
-#define FUNC_NAME s_scm_eval_options_interface
-{
- SCM ans;
-
- scm_dynwind_begin (0);
- scm_dynwind_critical_section (SCM_BOOL_F);
- ans = scm_options (setting,
- scm_eval_opts,
- FUNC_NAME);
- scm_dynwind_end ();
-
- return ans;
-}
-#undef FUNC_NAME
-
-
-SCM_DEFINE (scm_evaluator_traps, "evaluator-traps-interface", 0, 1, 0,
- (SCM setting),
- "Option interface for the evaluator trap options.")
-#define FUNC_NAME s_scm_evaluator_traps
-{
- SCM ans;
-
-
- scm_options_try (setting,
- scm_evaluator_trap_table,
- FUNC_NAME, 1);
- SCM_CRITICAL_SECTION_START;
- ans = scm_options (setting,
- scm_evaluator_trap_table,
- FUNC_NAME);
-
- /* njrev: same again. */
- SCM_CRITICAL_SECTION_END;
- return ans;
-}
-#undef FUNC_NAME
-
-
-
\f
/* Simple procedure calls
static SCM
scm_c_primitive_eval (SCM exp)
{
- SCM transformer = scm_current_module_transformer ();
- if (scm_is_true (transformer))
- exp = scm_call_1 (transformer, exp);
- exp = scm_memoize_expression (exp);
- return eval (exp, SCM_EOL);
+ if (!SCM_EXPANDED_P (exp))
+ exp = scm_call_1 (scm_current_module_transformer (), exp);
+ return eval (scm_memoize_expression (exp), SCM_EOL);
}
static SCM var_primitive_eval;
else
args = scm_cons_star (arg1, args);
- return scm_vm_apply (scm_the_vm (), proc, args);
+ return scm_call_with_vm (scm_the_vm (), proc, args);
}
-
-static SCM
-boot_closure_apply (SCM closure, SCM args)
+static void
+prepare_boot_closure_env_for_apply (SCM proc, SCM args,
+ SCM *out_body, SCM *out_env)
{
- int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (closure);
- SCM new_env = BOOT_CLOSURE_ENV (closure);
- if (BOOT_CLOSURE_HAS_REST_ARGS (closure))
+ int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc);
+ SCM env = BOOT_CLOSURE_ENV (proc);
+
+ if (BOOT_CLOSURE_IS_FIXED (proc)
+ || (BOOT_CLOSURE_IS_REST (proc)
+ && !BOOT_CLOSURE_HAS_REST_ARGS (proc)))
+ {
+ if (SCM_UNLIKELY (scm_ilength (args) != nreq))
+ scm_wrong_num_args (proc);
+ for (; scm_is_pair (args); args = CDR (args))
+ env = scm_cons (CAR (args), env);
+ *out_body = BOOT_CLOSURE_BODY (proc);
+ *out_env = env;
+ }
+ else if (BOOT_CLOSURE_IS_REST (proc))
{
if (SCM_UNLIKELY (scm_ilength (args) < nreq))
- scm_wrong_num_args (closure);
+ scm_wrong_num_args (proc);
for (; nreq; nreq--, args = CDR (args))
- new_env = scm_cons (CAR (args), new_env);
- new_env = scm_cons (args, new_env);
+ env = scm_cons (CAR (args), env);
+ env = scm_cons (args, env);
+ *out_body = BOOT_CLOSURE_BODY (proc);
+ *out_env = env;
}
else
{
- if (SCM_UNLIKELY (scm_ilength (args) != nreq))
- scm_wrong_num_args (closure);
- for (; scm_is_pair (args); args = CDR (args))
- new_env = scm_cons (CAR (args), new_env);
+ int i, argc, nreq, nopt;
+ SCM body, rest, kw, inits, alt;
+ SCM mx = BOOT_CLOSURE_CODE (proc);
+
+ loop:
+ BOOT_CLOSURE_PARSE_FULL (mx, body, nargs, rest, nopt, kw, inits, alt);
+
+ argc = scm_ilength (args);
+ if (argc < nreq)
+ {
+ if (scm_is_true (alt))
+ {
+ mx = alt;
+ goto loop;
+ }
+ else
+ scm_wrong_num_args (proc);
+ }
+ if (scm_is_false (kw) && argc > nreq + nopt && scm_is_false (rest))
+ {
+ if (scm_is_true (alt))
+ {
+ mx = alt;
+ goto loop;
+ }
+ 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)));
+ }
+ }
+ }
+
+ *out_body = body;
+ *out_env = env;
}
- return eval (BOOT_CLOSURE_BODY (closure), new_env);
+}
+
+static void
+prepare_boot_closure_env_for_eval (SCM proc, unsigned int argc,
+ SCM exps, SCM *out_body, SCM *inout_env)
+{
+ int nreq = BOOT_CLOSURE_NUM_REQUIRED_ARGS (proc);
+ SCM new_env = BOOT_CLOSURE_ENV (proc);
+ if (BOOT_CLOSURE_IS_FIXED (proc)
+ || (BOOT_CLOSURE_IS_REST (proc)
+ && !BOOT_CLOSURE_HAS_REST_ARGS (proc)))
+ {
+ for (; scm_is_pair (exps); exps = CDR (exps), nreq--)
+ new_env = scm_cons (eval (CAR (exps), *inout_env), new_env);
+ if (SCM_UNLIKELY (nreq != 0))
+ scm_wrong_num_args (proc);
+ *out_body = BOOT_CLOSURE_BODY (proc);
+ *inout_env = new_env;
+ }
+ else if (BOOT_CLOSURE_IS_REST (proc))
+ {
+ if (SCM_UNLIKELY (argc < nreq))
+ scm_wrong_num_args (proc);
+ for (; nreq; nreq--, exps = CDR (exps))
+ new_env = scm_cons (eval (CAR (exps), *inout_env), new_env);
+ {
+ SCM rest = SCM_EOL;
+ for (; scm_is_pair (exps); exps = CDR (exps))
+ rest = scm_cons (eval (CAR (exps), *inout_env), rest);
+ new_env = scm_cons (scm_reverse (rest),
+ new_env);
+ }
+ *out_body = BOOT_CLOSURE_BODY (proc);
+ *inout_env = new_env;
+ }
+ else
+ {
+ SCM args = SCM_EOL;
+ for (; scm_is_pair (exps); exps = CDR (exps))
+ args = scm_cons (eval (CAR (exps), *inout_env), args);
+ args = scm_reverse_x (args, SCM_UNDEFINED);
+ prepare_boot_closure_env_for_apply (proc, args, out_body, inout_env);
+ }
+}
+
+static SCM
+boot_closure_apply (SCM closure, SCM args)
+{
+ SCM body, env;
+ prepare_boot_closure_env_for_apply (closure, args, &body, &env);
+ return eval (body, env);
}
static int
{
SCM args;
scm_puts ("#<boot-closure ", port);
- scm_uintprint ((unsigned long)SCM2PTR (closure), 16, port);
+ scm_uintprint ((scm_t_bits)SCM2PTR (closure), 16, port);
scm_putc (' ', port);
args = scm_make_list (scm_from_int (BOOT_CLOSURE_NUM_REQUIRED_ARGS (closure)),
- scm_from_locale_symbol ("_"));
- if (BOOT_CLOSURE_HAS_REST_ARGS (closure))
- args = scm_cons_star (scm_from_locale_symbol ("_"), args);
+ scm_from_latin1_symbol ("_"));
+ if (!BOOT_CLOSURE_IS_FIXED (closure) && BOOT_CLOSURE_HAS_REST_ARGS (closure))
+ args = scm_cons_star (scm_from_latin1_symbol ("_"), args);
+ /* FIXME: optionals and rests */
scm_display (args, port);
scm_putc ('>', port);
return 1;
{
SCM primitive_eval;
- scm_init_opts (scm_evaluator_traps,
- scm_evaluator_trap_table);
- scm_init_opts (scm_eval_options_interface,
- scm_eval_opts);
-
f_apply = scm_c_define_gsubr ("apply", 2, 0, 1, scm_apply);
scm_tc16_boot_closure = scm_make_smob_type ("boot-closure", 0);
HCoop / bpt / guile.git / blobdiff