mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-10 22:10:21 +02:00
procedure property efficiency tweak
* libguile/procprop.c (scm_procedure_property) scm_set_procedure_property_x): Fix to not call scm_procedure_properties(), and thus to avoid consing up the arity as well.
This commit is contained in:
parent
258344b4db
commit
c783b0827c
1 changed files with 26 additions and 4 deletions
|
@ -194,7 +194,18 @@ SCM_DEFINE (scm_procedure_property, "procedure-property", 2, 0, 0,
|
||||||
/* avoid a cons in this case */
|
/* avoid a cons in this case */
|
||||||
return scm_i_procedure_arity (proc);
|
return scm_i_procedure_arity (proc);
|
||||||
else
|
else
|
||||||
return scm_assq_ref (scm_procedure_properties (proc), key);
|
{
|
||||||
|
SCM props;
|
||||||
|
if (SCM_CLOSUREP (proc))
|
||||||
|
props = SCM_PROCPROPS (proc);
|
||||||
|
else
|
||||||
|
{
|
||||||
|
scm_i_pthread_mutex_lock (&non_closure_props_lock);
|
||||||
|
props = scm_hashq_ref (non_closure_props, proc, SCM_EOL);
|
||||||
|
scm_i_pthread_mutex_unlock (&non_closure_props_lock);
|
||||||
|
}
|
||||||
|
return scm_assq_ref (props, key);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
||||||
|
@ -208,9 +219,20 @@ SCM_DEFINE (scm_set_procedure_property_x, "set-procedure-property!", 3, 0, 0,
|
||||||
|
|
||||||
if (scm_is_eq (key, scm_sym_arity))
|
if (scm_is_eq (key, scm_sym_arity))
|
||||||
SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
|
SCM_MISC_ERROR ("arity is a read-only property", SCM_EOL);
|
||||||
scm_set_procedure_properties_x
|
|
||||||
(proc,
|
if (SCM_CLOSUREP (proc))
|
||||||
scm_assq_set_x (scm_procedure_properties (proc), key, val));
|
SCM_SETPROCPROPS (proc,
|
||||||
|
scm_assq_set_x (SCM_PROCPROPS (proc), key, val));
|
||||||
|
else
|
||||||
|
{
|
||||||
|
scm_i_pthread_mutex_lock (&non_closure_props_lock);
|
||||||
|
scm_hashq_set_x (non_closure_props, proc,
|
||||||
|
scm_assq_set_x (scm_hashq_ref (non_closure_props, proc,
|
||||||
|
SCM_EOL),
|
||||||
|
key, val));
|
||||||
|
scm_i_pthread_mutex_unlock (&non_closure_props_lock);
|
||||||
|
}
|
||||||
|
|
||||||
return SCM_UNSPECIFIED;
|
return SCM_UNSPECIFIED;
|
||||||
}
|
}
|
||||||
#undef FUNC_NAME
|
#undef FUNC_NAME
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue