mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-15 16:20:17 +02:00
Code Activity

* read.c (scm_init_read): intitialise scm_read_hash_procedures

Browse source 
(idea from Mikael: make it a pair so scm_permanent object only
	called once.)
	(scm_read_hash_extend): don't call scm_permanent_object.
	(ideas from Mikael): if chr is already in the list, replace its
	procedure instead of appending it again.  If chr is #f, remove
	it from the list.
	(scm_get_hash_procedure): take CDR of scm_read_hash_procedures.
This commit is contained in:
Gary Houston 1997-03-08 22:52:56 +00:00
parent 00c34e457c
commit fed9c9a2d4
3 changed files with 83 additions and 43 deletions
Download patch file Download diff file Expand all files Collapse all files

55
libguile/read.c
View file

@ -82,8 +82,9 @@ scm_read_options (setting)
return ans;
}
/* Association list mapping extra hash characters to procedures. */
static SCM scm_read_hash_procedures = SCM_EOL;
/* CDR contains an association list mapping extra hash characters to
procedures. */
static SCM scm_read_hash_procedures;
SCM_PROC (s_read, "read", 0, 1, 0, scm_read);
@ -762,16 +763,42 @@ scm_read_hash_extend (chr, proc)
SCM chr;
SCM proc;
{
SCM_ASSERT (SCM_ICHRP(chr), chr, SCM_ARG1, s_read_hash_extend);
SCM_ASSERT (SCM_NIMP(proc), proc, SCM_ARG2, s_read_hash_extend);
SCM this;
SCM prev;
SCM_ASSERT (SCM_ICHRP(chr), chr, SCM_ARG1, s_read_hash_extend);
SCM_ASSERT (SCM_FALSEP (proc) || SCM_NIMP(proc), proc, SCM_ARG2,
s_read_hash_extend);
/* See it this chr is already in the alist. */
this = SCM_CDR (scm_read_hash_procedures);
prev = scm_read_hash_procedures;
while (1)
{
if (SCM_NULLP (this))
{
/* not found, so add it to the beginning. */
if (SCM_NFALSEP (proc))
{
scm_set_cdr_x (scm_read_hash_procedures,
scm_cons (scm_cons (chr, proc),
SCM_CDR (scm_read_hash_procedures)));
}
break;
}
if (chr == SCM_CAAR (this))
{
/* already in the alist. */
if (SCM_FALSEP (proc))
scm_set_cdr_x (prev, SCM_CDR (this)); /* remove it. */
else
scm_set_cdr_x (SCM_CAR (this), proc); /* replace it. */
break;
}
prev = this;
this = SCM_CDR (this);
}
/* We are making every member of this list a permanent object.
Is that bad? */
SCM_DEFER_INTS;
scm_read_hash_procedures = scm_cons (scm_cons (chr, proc),
scm_read_hash_procedures);
scm_permanent_object (scm_read_hash_procedures);
SCM_ALLOW_INTS;
return SCM_UNSPECIFIED;
}
@ -780,7 +807,8 @@ static SCM
scm_get_hash_procedure (c)
int c;
{
SCM rest = scm_read_hash_procedures;
SCM rest = SCM_CDR (scm_read_hash_procedures);
while (1)
{
if (SCM_NULLP (rest))
@ -796,6 +824,9 @@ scm_get_hash_procedure (c)
void
scm_init_read ()
{
scm_read_hash_procedures = scm_cons (SCM_BOOL_F, SCM_EOL);
scm_permanent_object (scm_read_hash_procedures);
scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS);
#include "read.x"
}