mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-04-30 03:40:34 +02:00
f36878ba2d
* libguile/pairs.h: * libguile/pairs.c: Previously scm_cdadr et al were implemented as #defines that called scm_i_chase_pairs, and the Scheme-exposed functions themselves were cxr subrs, which got special help in the interpreter. Since now the special help is unnecessary (because the compiler inlines and expands calls to car, cdadr, etc), the complexity is a loss. So just implement cdadr etc using normal functions. There's an advantage too, in that the compiler can unroll the cxring, reducing branches. * libguile/tags.h (scm_tc7_cxr): Remove this tag. (scm_tcs_subrs): Now there's only one kind of subr, yay! * libguile/debug.c (scm_procedure_name) * libguile/evalext.c (scm_self_evaluating_p) * libguile/gc.c (scm_i_tag_name) * libguile/goops.c (scm_class_of) * libguile/hash.c (scm_hasher) * libguile/print.c (iprin1) * libguile/procprop.c (scm_i_procedure_arity) * libguile/procs.c (scm_procedure_p, scm_subr_p) (scm_make_procedure_with_setter) * libguile/vm.c (apply_foreign): Remove cxr cases. Replace uses of scm_tcs_subrs with scm_tc7_gsubr.
110 lines
2.7 KiB
C
110 lines
2.7 KiB
C
/* Copyright (C) 1998,1999,2000,2001,2002,2003, 2006, 2008, 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
|
||
* as published by the Free Software Foundation; either version 3 of
|
||
* the License, or (at your option) any later version.
|
||
*
|
||
* This library is distributed in the hope that it will be useful, but
|
||
* WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
* Lesser General Public License for more details.
|
||
*
|
||
* You should have received a copy of the GNU Lesser General Public
|
||
* License along with this library; if not, write to the Free Software
|
||
* Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
|
||
* 02110-1301 USA
|
||
*/
|
||
|
||
|
||
|
||
#ifdef HAVE_CONFIG_H
|
||
# include <config.h>
|
||
#endif
|
||
|
||
#include "libguile/_scm.h"
|
||
#include "libguile/eval.h"
|
||
#include "libguile/fluids.h"
|
||
#include "libguile/modules.h"
|
||
|
||
#include "libguile/validate.h"
|
||
#include "libguile/evalext.h"
|
||
|
||
SCM_DEFINE (scm_defined_p, "defined?", 1, 1, 0,
|
||
(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.")
|
||
#define FUNC_NAME s_scm_defined_p
|
||
{
|
||
SCM var;
|
||
|
||
SCM_VALIDATE_SYMBOL (1, sym);
|
||
|
||
if (SCM_UNBNDP (module))
|
||
module = scm_current_module ();
|
||
else
|
||
SCM_VALIDATE_MODULE (2, module);
|
||
|
||
var = scm_module_variable (module, sym);
|
||
|
||
return (scm_is_false (var) || SCM_UNBNDP (SCM_VARIABLE_REF (var))
|
||
? SCM_BOOL_F
|
||
: SCM_BOOL_T);
|
||
}
|
||
#undef FUNC_NAME
|
||
|
||
|
||
SCM_REGISTER_PROC (s_map_in_order, "map-in-order", 2, 0, 1, scm_map);
|
||
|
||
|
||
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 */
|
||
return scm_from_bool (!scm_is_null (obj));
|
||
case scm_tc3_cons:
|
||
switch (SCM_TYP7 (obj))
|
||
{
|
||
case scm_tcs_closures:
|
||
case scm_tc7_vector:
|
||
case scm_tc7_wvect:
|
||
case scm_tc7_number:
|
||
case scm_tc7_string:
|
||
case scm_tc7_smob:
|
||
case scm_tc7_pws:
|
||
case scm_tc7_program:
|
||
case scm_tc7_bytevector:
|
||
case scm_tc7_gsubr:
|
||
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
|
||
|
||
void
|
||
scm_init_evalext ()
|
||
{
|
||
#include "libguile/evalext.x"
|
||
}
|
||
|
||
/*
|
||
Local Variables:
|
||
c-file-style: "gnu"
|
||
End:
|
||
*/
|