Remove "compiled closures" ("cclos") in favor of a simpler mechanism.
The idea is to introduce `gsubrs' whose arity is encoded in their type
(more precisely in the sizeof (void *) - 8 MSBs). This removes the
indirection introduced by cclos and simplifies the code.
* libguile/__scm.h (CCLO): Remove.
* libguile/debug.c (scm_procedure_source, scm_procedure_environment):
Remove references to `scm_tc7_cclo'.
* libguile/eval.c (scm_trampoline_0, scm_trampoline_1,
scm_trampoline_2): Replace `scm_tc7_cclo' with `scm_tc7_gsubr'.
* libguile/eval.i.c (CEVAL): Likewise. No longer make PROC the first
argument. Directly invoke `scm_gsubr_apply ()' instead of jump to the
`evap(N+1)' label or call to `SCM_APPLY ()'.
* libguile/evalext.c (scm_self_evaluating_p): Remove reference to
`scm_tc7_cclo'.
* libguile/gc-card.c (scm_i_sweep_card, scm_i_tag_name): Likewise.
* libguile/gc-mark.c (scm_gc_mark_dependencies): Likewise.
* libguile/goops.c (scm_class_of): Likewise.
* libguile/print.c (iprin1): Likewise.
* libguile/gsubr.c (create_gsubr): Use `unsigned int's for REQ, OPT and
RST. Use `scm_tc7_gsubr' instead of `scm_makcclo ()' in the default
case.
(scm_gsubr_apply): Remove calls to `SCM_GSUBR_PROC ()'.
(scm_f_gsubr_apply): Remove.
* libguile/gsubr.h (SCM_GSUBR_TYPE): New definition.
(SCM_GSUBR_MAX): Changed to 33.
(SCM_SET_GSUBR_TYPE, SCM_GSUBR_PROC, SCM_SET_GSUBR_PROC,
scm_f_gsubr_apply): Remove.
* libguile/procprop.c (scm_i_procedure_arity): Remove reference to
`scm_tc7_cclo'; add proper handling of `scm_tc7_gsubr'.
* libguile/procs.c (scm_makcclo, scm_make_cclo): Remove.
(scm_procedure_p): Remove reference to `scm_tc7_cclo'.
(scm_thunk_p): Likewise, plus add proper `scm_tc7_gsubr' handling.
* libguile/procs.h (SCM_CCLO_LENGTH, SCM_MAKE_CCLO_TAG,
SCM_SET_CCLO_LENGTH, SCM_CCLO_BASE, SCM_SET_CCLO_BASE, SCM_CCLO_REF,
SCM_CCLO_SET, SCM_CCLO_SUBR, SCM_SET_CCLO_SUBR, scm_makcclo,
scm_make_cclo): Remove.
* libguile/stacks.c (read_frames): Remove reference to `scm_f_gsubr_apply'.
* libguile/tags.h (scm_tc7_cclo): Remove.
(scm_tc7_gsubr): New.
(scm_tcs_subrs): Add `scm_tc7_gsubr'.
2009-02-16 00:24:00 +01:00
|
|
|
|
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 2009 Free Software Foundation, Inc.
|
1998-10-31 13:31:25 +00:00
|
|
|
|
*
|
2003-04-05 19:15:35 +00:00
|
|
|
|
* This library is free software; you can redistribute it and/or
|
2009-06-17 00:22:09 +01:00
|
|
|
|
* modify it under the terms of the GNU Lesser General Public License
|
|
|
|
|
|
* as published by the Free Software Foundation; either version 3 of
|
|
|
|
|
|
* the License, or (at your option) any later version.
|
1998-10-31 13:31:25 +00:00
|
|
|
|
*
|
2009-06-17 00:22:09 +01:00
|
|
|
|
* This library is distributed in the hope that it will be useful, but
|
|
|
|
|
|
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
2003-04-05 19:15:35 +00:00
|
|
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
|
|
|
* Lesser General Public License for more details.
|
1998-10-31 13:31:25 +00:00
|
|
|
|
*
|
2003-04-05 19:15:35 +00:00
|
|
|
|
* You should have received a copy of the GNU Lesser General Public
|
|
|
|
|
|
* License along with this library; if not, write to the Free Software
|
2009-06-17 00:22:09 +01:00
|
|
|
|
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
|
|
|
|
|
* 02110-1301 USA
|
2003-04-05 19:15:35 +00:00
|
|
|
|
*/
|
1999-12-12 02:36:16 +00:00
|
|
|
|
|
|
|
|
|
|
|
1998-10-31 13:31:25 +00:00
|
|
|
|
|
2008-09-13 15:35:27 +02:00
|
|
|
|
#ifdef HAVE_CONFIG_H
|
|
|
|
|
|
# include <config.h>
|
|
|
|
|
|
#endif
|
1998-10-31 13:31:25 +00:00
|
|
|
|
|
2000-04-21 14:16:44 +00:00
|
|
|
|
#include "libguile/_scm.h"
|
|
|
|
|
|
#include "libguile/eval.h"
|
2000-06-21 02:46:01 +00:00
|
|
|
|
#include "libguile/fluids.h"
|
2003-05-06 20:05:04 +00:00
|
|
|
|
#include "libguile/modules.h"
|
1998-10-31 13:31:25 +00:00
|
|
|
|
|
2000-04-21 14:16:44 +00:00
|
|
|
|
#include "libguile/validate.h"
|
|
|
|
|
|
#include "libguile/evalext.h"
|
1998-10-31 13:31:25 +00:00
|
|
|
|
|
2002-10-19 09:07:23 +00:00
|
|
|
|
SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
|
2009-08-10 19:24:34 +02:00
|
|
|
|
(SCM sym, SCM module),
|
|
|
|
|
|
"Return @code{#t} if @var{sym} is defined in the module "
|
|
|
|
|
|
"@var{module} or the current module when @var{module} is not"
|
|
|
|
|
|
"specified.")
|
2002-10-19 09:07:23 +00:00
|
|
|
|
#define FUNC_NAME s_scm_defined_p
|
1998-10-31 13:31:25 +00:00
|
|
|
|
{
|
2001-05-15 14:57:22 +00:00
|
|
|
|
SCM var;
|
1998-10-31 13:31:25 +00:00
|
|
|
|
|
2002-07-20 14:08:34 +00:00
|
|
|
|
SCM_VALIDATE_SYMBOL (1, sym);
|
1998-10-31 13:31:25 +00:00
|
|
|
|
|
2009-08-10 19:24:34 +02:00
|
|
|
|
if (SCM_UNBNDP (module))
|
|
|
|
|
|
module = scm_current_module ();
|
1998-11-20 17:14:41 +00:00
|
|
|
|
else
|
2009-08-10 19:24:34 +02:00
|
|
|
|
SCM_VALIDATE_MODULE (2, module);
|
|
|
|
|
|
|
|
|
|
|
|
var = scm_module_variable (module, sym);
|
|
|
|
|
|
|
2004-07-06 10:59:25 +00:00
|
|
|
|
return (scm_is_false (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var))
|
1998-11-20 17:14:41 +00:00
|
|
|
|
? SCM_BOOL_F
|
|
|
|
|
|
: SCM_BOOL_T);
|
1998-10-31 13:31:25 +00:00
|
|
|
|
}
|
1999-12-12 02:36:16 +00:00
|
|
|
|
#undef FUNC_NAME
|
1998-10-31 13:31:25 +00:00
|
|
|
|
|
2002-11-24 18:21:48 +00:00
|
|
|
|
|
1999-12-12 02:36:16 +00:00
|
|
|
|
SCM_REGISTER_PROC (s_map_in_order, "map-in-order", 2, 0, 1, scm_map);
|
1998-12-07 16:48:35 +00:00
|
|
|
|
|
2003-05-06 20:05:04 +00:00
|
|
|
|
|
2003-01-20 10:12:39 +00:00
|
|
|
|
SCM_DEFINE (scm_self_evaluating_p, "self-evaluating?", 1, 0, 0,
|
|
|
|
|
|
(SCM obj),
|
|
|
|
|
|
"Return #t for objects which Guile considers self-evaluating")
|
|
|
|
|
|
#define FUNC_NAME s_scm_self_evaluating_p
|
|
|
|
|
|
{
|
|
|
|
|
|
switch (SCM_ITAG3 (obj))
|
|
|
|
|
|
{
|
|
|
|
|
|
case scm_tc3_int_1:
|
|
|
|
|
|
case scm_tc3_int_2:
|
|
|
|
|
|
/* inum */
|
|
|
|
|
|
return SCM_BOOL_T;
|
|
|
|
|
|
case scm_tc3_imm24:
|
|
|
|
|
|
/* characters, booleans, other immediates */
|
2004-09-22 17:41:37 +00:00
|
|
|
|
return scm_from_bool (!scm_is_null (obj));
|
2003-01-20 10:12:39 +00:00
|
|
|
|
case scm_tc3_cons:
|
|
|
|
|
|
switch (SCM_TYP7 (obj))
|
|
|
|
|
|
{
|
|
|
|
|
|
case scm_tc7_vector:
|
|
|
|
|
|
case scm_tc7_wvect:
|
This set of patches introduces a new tc7 code scm_tc7_number for
numbers. Bignums, reals and complex numbers are turned from smobs
into subtypes of scm_tc7_number.
* tags.h (scm_tc7_number): New.
* eq.c (scm_equal_p), eval.c (SCM_CEVAL), evalext.c
(scm_self_evaluating_p), gc-card.c (scm_i_sweep_card), gc-mark.c
(scm_gc_mark_dependencies), goops.c (create_smob_classes), hash.c
(scm_hasher), numbers.c, numbers.h (SCM_NUMP), objects.c
(scm_class_of), print.c (scm_iprin1), smob.c
(scm_smob_prehistory): Don't handle bignums, reals and complex
numbers as subtypes of scm_tc7_smob any more.
* numbers.h, tags.h (scm_tc16_big, scm_tc16_real,
scm_tc16_complex): Moved definitions from tags.h to numbers.h.
2003-09-18 20:55:40 +00:00
|
|
|
|
case scm_tc7_number:
|
2003-01-20 10:12:39 +00:00
|
|
|
|
case scm_tc7_string:
|
|
|
|
|
|
case scm_tc7_smob:
|
|
|
|
|
|
case scm_tc7_pws:
|
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
<procedure>, 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.
2009-08-20 14:27:38 +02:00
|
|
|
|
case scm_tc7_program:
|
Use a TC7 tag instead of a SMOB for bytevectors.
* libguile/bytevectors.c (scm_tc16_bytevector): Remove.
(SCM_BYTEVECTOR_SET_LENGTH, SCM_BYTEVECTOR_SET_CONTENTS,
SCM_BYTEVECTOR_SET_INLINE, SCM_BYTEVECTOR_SET_ELEMENT_TYPE,
make_bytevector_from_buffer, scm_is_bytevector,
scm_bootstrap_bytevectors): Adjust to the SMOB->tc7 change.
(scm_i_print_bytevector): New, formerly `print_bytevector ()'.
(bytevector_equal_p): Remove.
* libguile/bytevectors.h (SCM_BYTEVECTOR_LENGTH,
SCM_BYTEVECTOR_CONTENTS, SCM_BYTEVECTOR_P): Adjust to SMOB->tc7
change.
(SCM_BYTEVECTOR_FLAGS, SCM_SET_BYTEVECTOR_FLAGS): New macros.
(scm_tc16_bytevector): Remove declaration.
(scm_i_print_bytevector): New declaration.
* libguile/eq.c (scm_equal_p): Handle `scm_tc7_bytevector'.
* libguile/evalext.c (scm_self_evaluating_p): Likewise.
* libguile/print.c (iprin1): Likewise.
* libguile/tags.h (scm_tc7_bytevector): New.
(scm_tc7_unused_8): Remove.
* libguile/validate.h (SCM_VALIDATE_BYTEVECTOR): Adjust.
* test-suite/tests/bytevectors.test ("Datum
Syntax")["self-evaluating?"]: New test.
2009-08-30 20:12:09 +02:00
|
|
|
|
case scm_tc7_bytevector:
|
2009-12-04 16:39:34 +01:00
|
|
|
|
case scm_tc7_gsubr:
|
2003-01-20 10:12:39 +00:00
|
|
|
|
case scm_tcs_struct:
|
|
|
|
|
|
return SCM_BOOL_T;
|
|
|
|
|
|
default:
|
|
|
|
|
|
return SCM_BOOL_F;
|
|
|
|
|
|
}
|
|
|
|
|
|
}
|
|
|
|
|
|
SCM_MISC_ERROR ("Internal error: Object ~S has unknown type",
|
|
|
|
|
|
scm_list_1 (obj));
|
|
|
|
|
|
return SCM_UNSPECIFIED; /* never reached */
|
|
|
|
|
|
}
|
|
|
|
|
|
#undef FUNC_NAME
|
|
|
|
|
|
|
1998-10-31 13:31:25 +00:00
|
|
|
|
void
|
|
|
|
|
|
scm_init_evalext ()
|
|
|
|
|
|
{
|
2000-04-21 14:16:44 +00:00
|
|
|
|
#include "libguile/evalext.x"
|
1998-10-31 13:31:25 +00:00
|
|
|
|
}
|
2000-03-19 19:01:16 +00:00
|
|
|
|
|
|
|
|
|
|
/*
|
|
|
|
|
|
Local Variables:
|
|
|
|
|
|
c-file-style: "gnu"
|
|
|
|
|
|
End:
|
|
|
|
|
|
*/
|