mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-15 16:20:17 +02:00
* backtrace.c (SCM_ASSERT), debug.c (scm_debug_options), eval.c
(scm_lookupcar, scm_lookupcar1, scm_badargsp, SCM_CEVAL, SCM_APPLY, scm_map, scm_for_each), feature.c (scm_init_feature), gsubr.c (scm_gsubr_apply), numbers.c (scm_logand, scm_logior, scm_logxor, scm_i_dbl2big), srcprop.c (scm_source_properties, scm_set_source_properties_x, scm_source_property): Removed compile time option SCM_RECKLESS to clean up the code. Full number of arguments checking of closures is mandatory now. However, the option to disable the checking has most probably not been used anyway. * srcprop.c (scm_source_properties, scm_set_source_properties_x, scm_source_property): Use !SCM_CONSP instead of SCM_NCONSP.
This commit is contained in:
parent
732b932732
commit
8505e285ec
10 changed files with 30 additions and 72 deletions
5
NEWS
5
NEWS
|
@ -173,6 +173,11 @@ Now, caching of local variable positions during memoization is mandatory.
|
||||||
However, the option to disable the caching has most probably not been used
|
However, the option to disable the caching has most probably not been used
|
||||||
anyway.
|
anyway.
|
||||||
|
|
||||||
|
** Removed compile time option SCM_RECKLESS
|
||||||
|
|
||||||
|
Full number of arguments checking of closures is mandatory now. However, the
|
||||||
|
option to disable the checking has most probably not been used anyway.
|
||||||
|
|
||||||
** Removed definitions: scm_lisp_nil, scm_lisp_t, s_nil_ify, scm_m_nil_ify,
|
** Removed definitions: scm_lisp_nil, scm_lisp_t, s_nil_ify, scm_m_nil_ify,
|
||||||
s_t_ify, scm_m_t_ify, s_0_cond, scm_m_0_cond, s_0_ify, scm_m_0_ify, s_1_ify,
|
s_t_ify, scm_m_t_ify, s_0_cond, scm_m_0_cond, s_0_ify, scm_m_0_ify, s_1_ify,
|
||||||
scm_m_1_ify, scm_debug_newcell, scm_debug_newcell2, scm_tc16_allocated,
|
scm_m_1_ify, scm_debug_newcell, scm_debug_newcell2, scm_tc16_allocated,
|
||||||
|
|
|
@ -1,3 +1,19 @@
|
||||||
|
2002-06-30 Dirk Herrmann <D.Herrmann@tu-bs.de>
|
||||||
|
|
||||||
|
* backtrace.c (SCM_ASSERT), debug.c (scm_debug_options), eval.c
|
||||||
|
(scm_lookupcar, scm_lookupcar1, scm_badargsp, SCM_CEVAL,
|
||||||
|
SCM_APPLY, scm_map, scm_for_each), feature.c (scm_init_feature),
|
||||||
|
gsubr.c (scm_gsubr_apply), numbers.c (scm_logand, scm_logior,
|
||||||
|
scm_logxor, scm_i_dbl2big), srcprop.c (scm_source_properties,
|
||||||
|
scm_set_source_properties_x, scm_source_property): Removed
|
||||||
|
compile time option SCM_RECKLESS to clean up the code. Full
|
||||||
|
number of arguments checking of closures is mandatory now.
|
||||||
|
However, the option to disable the checking has most probably not
|
||||||
|
been used anyway.
|
||||||
|
|
||||||
|
* srcprop.c (scm_source_properties, scm_set_source_properties_x,
|
||||||
|
scm_source_property): Use !SCM_CONSP instead of SCM_NCONSP.
|
||||||
|
|
||||||
2002-06-30 Gary Houston <ghouston@arglist.com>
|
2002-06-30 Gary Houston <ghouston@arglist.com>
|
||||||
|
|
||||||
* dynl.c: Removed all SCM_DEFER_INTS/SCM_ALLOW_INTS, which won't
|
* dynl.c: Removed all SCM_DEFER_INTS/SCM_ALLOW_INTS, which won't
|
||||||
|
|
|
@ -100,16 +100,8 @@
|
||||||
/* #define GUILE_DEBUG_FREELIST */
|
/* #define GUILE_DEBUG_FREELIST */
|
||||||
|
|
||||||
/* If the compile FLAG `SCM_CAUTIOUS' is #defined then the number of
|
/* If the compile FLAG `SCM_CAUTIOUS' is #defined then the number of
|
||||||
* arguments is always checked for application of closures. If the
|
* arguments is always checked for application of closures.
|
||||||
* compile FLAG `SCM_RECKLESS' is #defined then they are not checked.
|
|
||||||
* Otherwise, number of argument checks for closures are made only
|
|
||||||
* when the function position (whose value is the closure) of a
|
|
||||||
* combination is not an ILOC or a variable (true?). When the
|
|
||||||
* function position of a combination is a symbol it will be checked
|
|
||||||
* only the first time it is evaluated because it will then be
|
|
||||||
* replaced with an ILOC or variable.
|
|
||||||
*/
|
*/
|
||||||
#undef SCM_RECKLESS
|
|
||||||
#define SCM_CAUTIOUS
|
#define SCM_CAUTIOUS
|
||||||
|
|
||||||
/* All the number support there is.
|
/* All the number support there is.
|
||||||
|
|
|
@ -77,12 +77,10 @@
|
||||||
* Note that these functions shouldn't generate errors themselves.
|
* Note that these functions shouldn't generate errors themselves.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
#undef SCM_ASSERT
|
#undef SCM_ASSERT
|
||||||
#define SCM_ASSERT(_cond, _arg, _pos, _subr) \
|
#define SCM_ASSERT(_cond, _arg, _pos, _subr) \
|
||||||
if (!(_cond)) \
|
if (!(_cond)) \
|
||||||
return SCM_BOOL_F;
|
return SCM_BOOL_F;
|
||||||
#endif
|
|
||||||
|
|
||||||
SCM scm_the_last_stack_fluid_var;
|
SCM scm_the_last_stack_fluid_var;
|
||||||
|
|
||||||
|
|
|
@ -81,17 +81,12 @@ SCM_DEFINE (scm_debug_options, "debug-options-interface", 0, 1, 0,
|
||||||
{
|
{
|
||||||
SCM ans;
|
SCM ans;
|
||||||
SCM_DEFER_INTS;
|
SCM_DEFER_INTS;
|
||||||
ans = scm_options (setting,
|
ans = scm_options (setting, scm_debug_opts, SCM_N_DEBUG_OPTIONS, FUNC_NAME);
|
||||||
scm_debug_opts,
|
|
||||||
SCM_N_DEBUG_OPTIONS,
|
|
||||||
FUNC_NAME);
|
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE))
|
if (!(1 <= SCM_N_FRAMES && SCM_N_FRAMES <= SCM_MAX_FRAME_SIZE))
|
||||||
{
|
{
|
||||||
scm_options (ans, scm_debug_opts, SCM_N_DEBUG_OPTIONS, FUNC_NAME);
|
scm_options (ans, scm_debug_opts, SCM_N_DEBUG_OPTIONS, FUNC_NAME);
|
||||||
SCM_OUT_OF_RANGE (1, setting);
|
SCM_OUT_OF_RANGE (1, setting);
|
||||||
}
|
}
|
||||||
#endif
|
|
||||||
SCM_RESET_DEBUG_MODE;
|
SCM_RESET_DEBUG_MODE;
|
||||||
scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
|
scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
|
||||||
scm_debug_eframe_size = 2 * SCM_N_FRAMES;
|
scm_debug_eframe_size = 2 * SCM_N_FRAMES;
|
||||||
|
|
|
@ -281,13 +281,11 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
|
||||||
al = SCM_CDRLOC (*al);
|
al = SCM_CDRLOC (*al);
|
||||||
if (SCM_EQ_P (SCM_CAR (fl), var))
|
if (SCM_EQ_P (SCM_CAR (fl), var))
|
||||||
{
|
{
|
||||||
#ifndef SCM_RECKLESS /* letrec inits to SCM_UNDEFINED */
|
|
||||||
if (SCM_UNBNDP (SCM_CAR (*al)))
|
if (SCM_UNBNDP (SCM_CAR (*al)))
|
||||||
{
|
{
|
||||||
env = SCM_EOL;
|
env = SCM_EOL;
|
||||||
goto errout;
|
goto errout;
|
||||||
}
|
}
|
||||||
#endif
|
|
||||||
#ifdef USE_THREADS
|
#ifdef USE_THREADS
|
||||||
if (!SCM_EQ_P (SCM_CAR (vloc), var))
|
if (!SCM_EQ_P (SCM_CAR (vloc), var))
|
||||||
goto race;
|
goto race;
|
||||||
|
@ -313,7 +311,6 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
|
||||||
if (SCM_FALSEP (real_var))
|
if (SCM_FALSEP (real_var))
|
||||||
goto errout;
|
goto errout;
|
||||||
|
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
if (!SCM_NULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var)))
|
if (!SCM_NULLP (env) || SCM_UNBNDP (SCM_VARIABLE_REF (real_var)))
|
||||||
{
|
{
|
||||||
errout:
|
errout:
|
||||||
|
@ -335,7 +332,6 @@ scm_lookupcar (SCM vloc, SCM genv, int check)
|
||||||
return &undef_object;
|
return &undef_object;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef USE_THREADS
|
#ifdef USE_THREADS
|
||||||
if (!SCM_EQ_P (SCM_CAR (vloc), var))
|
if (!SCM_EQ_P (SCM_CAR (vloc), var))
|
||||||
|
@ -1540,7 +1536,6 @@ scm_unmemocopy (SCM x, SCM env)
|
||||||
return unmemocopy (x, env);
|
return unmemocopy (x, env);
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
|
|
||||||
int
|
int
|
||||||
scm_badargsp (SCM formals, SCM args)
|
scm_badargsp (SCM formals, SCM args)
|
||||||
|
@ -1557,7 +1552,6 @@ scm_badargsp (SCM formals, SCM args)
|
||||||
return !SCM_NULLP (args) ? 1 : 0;
|
return !SCM_NULLP (args) ? 1 : 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
|
||||||
|
|
||||||
static int
|
static int
|
||||||
scm_badformalsp (SCM closure, int n)
|
scm_badformalsp (SCM closure, int n)
|
||||||
|
@ -2339,10 +2333,8 @@ dispatch:
|
||||||
#ifdef DEVAL
|
#ifdef DEVAL
|
||||||
debug.info->a.args = arg1;
|
debug.info->a.args = arg1;
|
||||||
#endif
|
#endif
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
if (scm_badargsp (formals, arg1))
|
if (scm_badargsp (formals, arg1))
|
||||||
scm_wrong_num_args (proc);
|
scm_wrong_num_args (proc);
|
||||||
#endif
|
|
||||||
ENTER_APPLY;
|
ENTER_APPLY;
|
||||||
/* Copy argument list */
|
/* Copy argument list */
|
||||||
if (SCM_NULL_OR_NIL_P (arg1))
|
if (SCM_NULL_OR_NIL_P (arg1))
|
||||||
|
@ -2697,10 +2689,8 @@ dispatch:
|
||||||
case SCM_BIT8(SCM_ILOC00):
|
case SCM_BIT8(SCM_ILOC00):
|
||||||
proc = *scm_ilookup (SCM_CAR (x), env);
|
proc = *scm_ilookup (SCM_CAR (x), env);
|
||||||
SCM_ASRTGO (SCM_NIMP (proc), badfun);
|
SCM_ASRTGO (SCM_NIMP (proc), badfun);
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
#ifdef SCM_CAUTIOUS
|
#ifdef SCM_CAUTIOUS
|
||||||
goto checkargs;
|
goto checkargs;
|
||||||
#endif
|
|
||||||
#endif
|
#endif
|
||||||
break;
|
break;
|
||||||
|
|
||||||
|
@ -2786,7 +2776,6 @@ dispatch:
|
||||||
else
|
else
|
||||||
proc = SCM_CEVAL (SCM_CAR (x), env);
|
proc = SCM_CEVAL (SCM_CAR (x), env);
|
||||||
SCM_ASRTGO (!SCM_IMP (proc), badfun);
|
SCM_ASRTGO (!SCM_IMP (proc), badfun);
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
#ifdef SCM_CAUTIOUS
|
#ifdef SCM_CAUTIOUS
|
||||||
checkargs:
|
checkargs:
|
||||||
#endif
|
#endif
|
||||||
|
@ -2808,7 +2797,6 @@ dispatch:
|
||||||
}
|
}
|
||||||
else if (SCM_MACROP (proc))
|
else if (SCM_MACROP (proc))
|
||||||
goto handle_a_macro;
|
goto handle_a_macro;
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
@ -3663,10 +3651,8 @@ tail:
|
||||||
#else
|
#else
|
||||||
arg1 = (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args));
|
arg1 = (SCM_UNBNDP (arg1) ? SCM_EOL : scm_cons (arg1, args));
|
||||||
#endif
|
#endif
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
if (scm_badargsp (SCM_CLOSURE_FORMALS (proc), arg1))
|
if (scm_badargsp (SCM_CLOSURE_FORMALS (proc), arg1))
|
||||||
scm_wrong_num_args (proc);
|
scm_wrong_num_args (proc);
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Copy argument list */
|
/* Copy argument list */
|
||||||
if (SCM_IMP (arg1))
|
if (SCM_IMP (arg1))
|
||||||
|
@ -3877,9 +3863,7 @@ scm_map (SCM proc, SCM arg1, SCM args)
|
||||||
}
|
}
|
||||||
args = scm_vector (arg1 = scm_cons (arg1, args));
|
args = scm_vector (arg1 = scm_cons (arg1, args));
|
||||||
ve = SCM_VELTS (args);
|
ve = SCM_VELTS (args);
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
check_map_args (args, len, g_map, proc, arg1, s_map);
|
check_map_args (args, len, g_map, proc, arg1, s_map);
|
||||||
#endif
|
|
||||||
while (1)
|
while (1)
|
||||||
{
|
{
|
||||||
arg1 = SCM_EOL;
|
arg1 = SCM_EOL;
|
||||||
|
@ -3920,9 +3904,7 @@ scm_for_each (SCM proc, SCM arg1, SCM args)
|
||||||
}
|
}
|
||||||
args = scm_vector (arg1 = scm_cons (arg1, args));
|
args = scm_vector (arg1 = scm_cons (arg1, args));
|
||||||
ve = SCM_VELTS (args);
|
ve = SCM_VELTS (args);
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
check_map_args (args, len, g_for_each, proc, arg1, s_for_each);
|
check_map_args (args, len, g_for_each, proc, arg1, s_for_each);
|
||||||
#endif
|
|
||||||
while (1)
|
while (1)
|
||||||
{
|
{
|
||||||
arg1 = SCM_EOL;
|
arg1 = SCM_EOL;
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1995, 1996, 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
|
/* Copyright (C) 1995,1996,1998,1999,2000,2001,2002 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* This program is free software; you can redistribute it and/or modify
|
* This program is free software; you can redistribute it and/or modify
|
||||||
* it under the terms of the GNU General Public License as published by
|
* it under the terms of the GNU General Public License as published by
|
||||||
|
@ -102,9 +102,6 @@ void
|
||||||
scm_init_feature()
|
scm_init_feature()
|
||||||
{
|
{
|
||||||
features_var = scm_c_define ("*features*", SCM_EOL);
|
features_var = scm_c_define ("*features*", SCM_EOL);
|
||||||
#ifdef SCM_RECKLESS
|
|
||||||
scm_add_feature("reckless");
|
|
||||||
#endif
|
|
||||||
#ifndef _Windows
|
#ifndef _Windows
|
||||||
scm_add_feature("system");
|
scm_add_feature("system");
|
||||||
#endif
|
#endif
|
||||||
|
|
|
@ -223,10 +223,8 @@ scm_gsubr_apply (SCM args)
|
||||||
#endif
|
#endif
|
||||||
args = SCM_CDR (args);
|
args = SCM_CDR (args);
|
||||||
for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
|
for (i = 0; i < SCM_GSUBR_REQ (typ); i++) {
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
if (SCM_NULLP (args))
|
if (SCM_NULLP (args))
|
||||||
scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self)));
|
scm_wrong_num_args (SCM_SNAME (SCM_GSUBR_PROC (self)));
|
||||||
#endif
|
|
||||||
v[i] = SCM_CAR(args);
|
v[i] = SCM_CAR(args);
|
||||||
args = SCM_CDR(args);
|
args = SCM_CDR(args);
|
||||||
}
|
}
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation, Inc.
|
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 Free Software Foundation, Inc.
|
||||||
*
|
*
|
||||||
* Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
|
* Portions Copyright 1990, 1991, 1992, 1993 by AT&T Bell Laboratories
|
||||||
* and Bellcore. See scm_divide.
|
* and Bellcore. See scm_divide.
|
||||||
|
@ -898,15 +898,10 @@ SCM_DEFINE1 (scm_logand, "logand", scm_tc7_asubr,
|
||||||
return SCM_MAKINUM (-1);
|
return SCM_MAKINUM (-1);
|
||||||
} else if (!SCM_NUMBERP (n1)) {
|
} else if (!SCM_NUMBERP (n1)) {
|
||||||
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
|
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
} else if (SCM_NUMBERP (n1)) {
|
} else if (SCM_NUMBERP (n1)) {
|
||||||
return n1;
|
return n1;
|
||||||
} else {
|
} else {
|
||||||
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
|
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
|
||||||
#else
|
|
||||||
} else {
|
|
||||||
return n1;
|
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -982,15 +977,10 @@ SCM_DEFINE1 (scm_logior, "logior", scm_tc7_asubr,
|
||||||
if (SCM_UNBNDP (n2)) {
|
if (SCM_UNBNDP (n2)) {
|
||||||
if (SCM_UNBNDP (n1)) {
|
if (SCM_UNBNDP (n1)) {
|
||||||
return SCM_INUM0;
|
return SCM_INUM0;
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
} else if (SCM_NUMBERP (n1)) {
|
} else if (SCM_NUMBERP (n1)) {
|
||||||
return n1;
|
return n1;
|
||||||
} else {
|
} else {
|
||||||
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
|
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
|
||||||
#else
|
|
||||||
} else {
|
|
||||||
return n1;
|
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -1069,15 +1059,10 @@ SCM_DEFINE1 (scm_logxor, "logxor", scm_tc7_asubr,
|
||||||
if (SCM_UNBNDP (n2)) {
|
if (SCM_UNBNDP (n2)) {
|
||||||
if (SCM_UNBNDP (n1)) {
|
if (SCM_UNBNDP (n1)) {
|
||||||
return SCM_INUM0;
|
return SCM_INUM0;
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
} else if (SCM_NUMBERP (n1)) {
|
} else if (SCM_NUMBERP (n1)) {
|
||||||
return n1;
|
return n1;
|
||||||
} else {
|
} else {
|
||||||
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
|
SCM_WRONG_TYPE_ARG (SCM_ARG1, n1);
|
||||||
#else
|
|
||||||
} else {
|
|
||||||
return n1;
|
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -4537,10 +4522,8 @@ scm_i_dbl2big (double d)
|
||||||
u -= c;
|
u -= c;
|
||||||
digits[i] = c;
|
digits[i] = c;
|
||||||
}
|
}
|
||||||
#ifndef SCM_RECKLESS
|
|
||||||
if (u != 0)
|
if (u != 0)
|
||||||
scm_num_overflow ("dbl2big");
|
scm_num_overflow ("dbl2big");
|
||||||
#endif
|
|
||||||
return ans;
|
return ans;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001 Free Software Foundation
|
/* Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002 Free Software Foundation
|
||||||
*
|
*
|
||||||
* This program is free software; you can redistribute it and/or modify
|
* This program is free software; you can redistribute it and/or modify
|
||||||
* it under the terms of the GNU General Public License as published by
|
* it under the terms of the GNU General Public License as published by
|
||||||
|
@ -182,10 +182,8 @@ SCM_DEFINE (scm_source_properties, "source-properties", 1, 0, 0,
|
||||||
SCM_VALIDATE_NIM (1,obj);
|
SCM_VALIDATE_NIM (1,obj);
|
||||||
if (SCM_MEMOIZEDP (obj))
|
if (SCM_MEMOIZEDP (obj))
|
||||||
obj = SCM_MEMOIZED_EXP (obj);
|
obj = SCM_MEMOIZED_EXP (obj);
|
||||||
#ifndef SCM_RECKLESS
|
else if (!SCM_CONSP (obj))
|
||||||
else if (SCM_NCONSP (obj))
|
|
||||||
SCM_WRONG_TYPE_ARG (1, obj);
|
SCM_WRONG_TYPE_ARG (1, obj);
|
||||||
#endif
|
|
||||||
p = scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F);
|
p = scm_hashq_ref (scm_source_whash, obj, SCM_BOOL_F);
|
||||||
if (SRCPROPSP (p))
|
if (SRCPROPSP (p))
|
||||||
return scm_srcprops_to_plist (p);
|
return scm_srcprops_to_plist (p);
|
||||||
|
@ -205,10 +203,8 @@ SCM_DEFINE (scm_set_source_properties_x, "set-source-properties!", 2, 0, 0,
|
||||||
SCM_VALIDATE_NIM (1,obj);
|
SCM_VALIDATE_NIM (1,obj);
|
||||||
if (SCM_MEMOIZEDP (obj))
|
if (SCM_MEMOIZEDP (obj))
|
||||||
obj = SCM_MEMOIZED_EXP (obj);
|
obj = SCM_MEMOIZED_EXP (obj);
|
||||||
#ifndef SCM_RECKLESS
|
else if (!SCM_CONSP (obj))
|
||||||
else if (SCM_NCONSP (obj))
|
|
||||||
SCM_WRONG_TYPE_ARG(1, obj);
|
SCM_WRONG_TYPE_ARG(1, obj);
|
||||||
#endif
|
|
||||||
handle = scm_hashq_create_handle_x (scm_source_whash, obj, plist);
|
handle = scm_hashq_create_handle_x (scm_source_whash, obj, plist);
|
||||||
SCM_SETCDR (handle, plist);
|
SCM_SETCDR (handle, plist);
|
||||||
return plist;
|
return plist;
|
||||||
|
@ -225,10 +221,8 @@ SCM_DEFINE (scm_source_property, "source-property", 2, 0, 0,
|
||||||
SCM_VALIDATE_NIM (1,obj);
|
SCM_VALIDATE_NIM (1,obj);
|
||||||
if (SCM_MEMOIZEDP (obj))
|
if (SCM_MEMOIZEDP (obj))
|
||||||
obj = SCM_MEMOIZED_EXP (obj);
|
obj = SCM_MEMOIZED_EXP (obj);
|
||||||
#ifndef SCM_RECKLESS
|
else if (!SCM_CONSP (obj))
|
||||||
else if (SCM_NCONSP (obj))
|
|
||||||
SCM_WRONG_TYPE_ARG (1, obj);
|
SCM_WRONG_TYPE_ARG (1, obj);
|
||||||
#endif
|
|
||||||
p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
|
p = scm_hashq_ref (scm_source_whash, obj, SCM_EOL);
|
||||||
if (!SRCPROPSP (p))
|
if (!SRCPROPSP (p))
|
||||||
goto plist;
|
goto plist;
|
||||||
|
@ -259,10 +253,8 @@ SCM_DEFINE (scm_set_source_property_x, "set-source-property!", 3, 0, 0,
|
||||||
SCM_VALIDATE_NIM (1,obj);
|
SCM_VALIDATE_NIM (1,obj);
|
||||||
if (SCM_MEMOIZEDP (obj))
|
if (SCM_MEMOIZEDP (obj))
|
||||||
obj = SCM_MEMOIZED_EXP (obj);
|
obj = SCM_MEMOIZED_EXP (obj);
|
||||||
#ifndef SCM_RECKLESS
|
else if (!SCM_CONSP (obj))
|
||||||
else if (SCM_NCONSP (obj))
|
|
||||||
SCM_WRONG_TYPE_ARG (1, obj);
|
SCM_WRONG_TYPE_ARG (1, obj);
|
||||||
#endif
|
|
||||||
h = scm_whash_get_handle (scm_source_whash, obj);
|
h = scm_whash_get_handle (scm_source_whash, obj);
|
||||||
if (SCM_WHASHFOUNDP (h))
|
if (SCM_WHASHFOUNDP (h))
|
||||||
p = SCM_WHASHREF (scm_source_whash, h);
|
p = SCM_WHASHREF (scm_source_whash, h);
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue