HCoop
/
bpt
/
guile.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
The struct data is now an array of scm_bits_t variables.
[bpt/guile.git]
/
libguile
/
eval.c
diff --git
a/libguile/eval.c
b/libguile/eval.c
index
9652637
..
c17e478
100644
(file)
--- a/
libguile/eval.c
+++ b/
libguile/eval.c
@@
-93,8
+93,12
@@
char *alloca ();
#include "srcprop.h"
#include "stackchk.h"
#include "objects.h"
#include "srcprop.h"
#include "stackchk.h"
#include "objects.h"
+#include "async.h"
#include "feature.h"
#include "modules.h"
#include "feature.h"
#include "modules.h"
+#include "ports.h"
+#include "root.h"
+#include "vectors.h"
#include "validate.h"
#include "eval.h"
#include "validate.h"
#include "eval.h"
@@
-274,18
+278,18
@@
scm_lookupcar (SCM vloc, SCM genv, int check)
#endif
for (; SCM_NIMP (env); env = SCM_CDR (env))
{
#endif
for (; SCM_NIMP (env); env = SCM_CDR (env))
{
- if (SCM_
BOOL_T == scm_procedure_p (SCM_CAR (env
)))
+ if (SCM_
TRUE_P (scm_procedure_p (SCM_CAR (env)
)))
break;
al = SCM_CARLOC (env);
for (fl = SCM_CAR (*al); SCM_NIMP (fl); fl = SCM_CDR (fl))
{
if (SCM_NCONSP (fl))
{
break;
al = SCM_CARLOC (env);
for (fl = SCM_CAR (*al); SCM_NIMP (fl); fl = SCM_CDR (fl))
{
if (SCM_NCONSP (fl))
{
- if (
fl == var
)
+ if (
SCM_EQ_P (fl, var)
)
{
#ifdef MEMOIZE_LOCALS
#ifdef USE_THREADS
{
#ifdef MEMOIZE_LOCALS
#ifdef USE_THREADS
- if (
SCM_CAR (vloc) != var
)
+ if (
! SCM_EQ_P (SCM_CAR (vloc), var)
)
goto race;
#endif
SCM_SETCAR (vloc, iloc + SCM_ICDR);
goto race;
#endif
SCM_SETCAR (vloc, iloc + SCM_ICDR);
@@
-296,7
+300,7
@@
scm_lookupcar (SCM vloc, SCM genv, int check)
break;
}
al = SCM_CDRLOC (*al);
break;
}
al = SCM_CDRLOC (*al);
- if (SCM_
CAR (fl) == var
)
+ if (SCM_
EQ_P (SCM_CAR (fl), var)
)
{
#ifdef MEMOIZE_LOCALS
#ifndef SCM_RECKLESS /* letrec inits to SCM_UNDEFINED */
{
#ifdef MEMOIZE_LOCALS
#ifndef SCM_RECKLESS /* letrec inits to SCM_UNDEFINED */
@@
-332,7
+336,7
@@
scm_lookupcar (SCM vloc, SCM genv, int check)
else
top_thunk = SCM_BOOL_F;
vcell = scm_sym2vcell (var, top_thunk, SCM_BOOL_F);
else
top_thunk = SCM_BOOL_F;
vcell = scm_sym2vcell (var, top_thunk, SCM_BOOL_F);
- if (
vcell == SCM_BOOL_F
)
+ if (
SCM_FALSEP (vcell)
)
goto errout;
else
var = vcell;
goto errout;
else
var = vcell;
@@
-410,7
+414,7
@@
scm_unmemocar (SCM form, SCM env)
return form;
c = SCM_CAR (form);
if (1 == (SCM_UNPACK (c) & 7))
return form;
c = SCM_CAR (form);
if (1 == (SCM_UNPACK (c) & 7))
- SCM_SETCAR (form, SCM_
CAR (c - 1
));
+ SCM_SETCAR (form, SCM_
GLOC_SYM (c
));
#ifdef MEMOIZE_LOCALS
#ifdef DEBUG_EXTENSIONS
else if (SCM_ILOCP (c))
#ifdef MEMOIZE_LOCALS
#ifdef DEBUG_EXTENSIONS
else if (SCM_ILOCP (c))
@@
-634,7
+638,7
@@
scm_m_case (SCM xorig, SCM env)
proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 2, xorig, scm_s_clauses, s_case);
SCM_ASSYNT (scm_ilength (SCM_CAR (proc)) >= 0
proc = SCM_CAR (x);
SCM_ASSYNT (scm_ilength (proc) >= 2, xorig, scm_s_clauses, s_case);
SCM_ASSYNT (scm_ilength (SCM_CAR (proc)) >= 0
- ||
scm_sym_else == SCM_CAR (proc
),
+ ||
SCM_EQ_P (scm_sym_else, SCM_CAR (proc)
),
xorig, scm_s_clauses, s_case);
}
return scm_cons (SCM_IM_CASE, cdrx);
xorig, scm_s_clauses, s_case);
}
return scm_cons (SCM_IM_CASE, cdrx);
@@
-656,13
+660,13
@@
scm_m_cond (SCM xorig, SCM env)
arg1 = SCM_CAR (x);
len = scm_ilength (arg1);
SCM_ASSYNT (len >= 1, xorig, scm_s_clauses, s_cond);
arg1 = SCM_CAR (x);
len = scm_ilength (arg1);
SCM_ASSYNT (len >= 1, xorig, scm_s_clauses, s_cond);
- if (
scm_sym_else == SCM_CAR (arg1
))
+ if (
SCM_EQ_P (scm_sym_else, SCM_CAR (arg1)
))
{
SCM_ASSYNT (SCM_NULLP (SCM_CDR (x)) && len >= 2,
xorig, "bad ELSE clause", s_cond);
SCM_SETCAR (arg1, SCM_BOOL_T);
}
{
SCM_ASSYNT (SCM_NULLP (SCM_CDR (x)) && len >= 2,
xorig, "bad ELSE clause", s_cond);
SCM_SETCAR (arg1, SCM_BOOL_T);
}
- if (len >= 2 &&
scm_sym_arrow == SCM_CAR (SCM_CDR (arg1
)))
+ if (len >= 2 &&
SCM_EQ_P (scm_sym_arrow, SCM_CAR (SCM_CDR (arg1)
)))
SCM_ASSYNT (3 == len && SCM_NIMP (SCM_CAR (SCM_CDR (SCM_CDR (arg1)))),
xorig, "bad recipient", s_cond);
x = SCM_CDR (x);
SCM_ASSYNT (3 == len && SCM_NIMP (SCM_CAR (SCM_CDR (SCM_CDR (arg1)))),
xorig, "bad recipient", s_cond);
x = SCM_CDR (x);
@@
-682,7
+686,7
@@
scm_m_lambda (SCM xorig, SCM env)
proc = SCM_CAR (x);
if (SCM_NULLP (proc))
goto memlambda;
proc = SCM_CAR (x);
if (SCM_NULLP (proc))
goto memlambda;
- if (SCM_
IM_LET == proc
) /* named let */
+ if (SCM_
EQ_P (SCM_IM_LET, proc)
) /* named let */
goto memlambda;
if (SCM_IMP (proc))
goto badforms;
goto memlambda;
if (SCM_IMP (proc))
goto badforms;
@@
-831,12
+835,12
@@
iqq (SCM form,SCM env,int depth)
if (SCM_NCONSP(form))
return form;
tmp = SCM_CAR (form);
if (SCM_NCONSP(form))
return form;
tmp = SCM_CAR (form);
- if (
scm_sym_quasiquote == tmp
)
+ if (
SCM_EQ_P (scm_sym_quasiquote, tmp)
)
{
depth++;
goto label;
}
{
depth++;
goto label;
}
- if (
scm_sym_unquote == tmp
)
+ if (
SCM_EQ_P (scm_sym_unquote, tmp)
)
{
--depth;
label:
{
--depth;
label:
@@
-847,7
+851,7
@@
iqq (SCM form,SCM env,int depth)
return evalcar (form, env);
return scm_cons2 (tmp, iqq (SCM_CAR (form), env, depth), SCM_EOL);
}
return evalcar (form, env);
return scm_cons2 (tmp, iqq (SCM_CAR (form), env, depth), SCM_EOL);
}
- if (SCM_NIMP (tmp) && (
scm_sym_uq_splicing == SCM_CAR (tmp
)))
+ if (SCM_NIMP (tmp) && (
SCM_EQ_P (scm_sym_uq_splicing, SCM_CAR (tmp)
)))
{
tmp = SCM_CDR (tmp);
if (0 == --edepth)
{
tmp = SCM_CDR (tmp);
if (0 == --edepth)
@@
-899,10
+903,10
@@
scm_m_define (SCM x, SCM env)
proc:
if (SCM_CLOSUREP (arg1)
/* Only the first definition determines the name. */
proc:
if (SCM_CLOSUREP (arg1)
/* Only the first definition determines the name. */
- &&
scm_procedure_property (arg1, scm_sym_name) == SCM_BOOL_F
)
+ &&
SCM_FALSEP (scm_procedure_property (arg1, scm_sym_name))
)
scm_set_procedure_property_x (arg1, scm_sym_name, proc);
else if (SCM_TYP16 (arg1) == scm_tc16_macro
scm_set_procedure_property_x (arg1, scm_sym_name, proc);
else if (SCM_TYP16 (arg1) == scm_tc16_macro
- &&
SCM_CDR (arg1) != arg1
)
+ &&
!SCM_EQ_P (SCM_CDR (arg1), arg1)
)
{
arg1 = SCM_CDR (arg1);
goto proc;
{
arg1 = SCM_CDR (arg1);
goto proc;
@@
-1193,7
+1197,7
@@
scm_m_expand_body (SCM xorig, SCM env)
SCM_CDR (form)),
env);
SCM_CDR (form)),
env);
- if (SCM_
IM_DEFINE == SCM_CAR (form
))
+ if (SCM_
EQ_P (SCM_IM_DEFINE, SCM_CAR (form)
))
{
defs = scm_cons (SCM_CDR (form), defs);
x = SCM_CDR(x);
{
defs = scm_cons (SCM_CDR (form), defs);
x = SCM_CDR(x);
@@
-1202,7
+1206,7
@@
scm_m_expand_body (SCM xorig, SCM env)
{
break;
}
{
break;
}
- else if (SCM_
IM_BEGIN == SCM_CAR (form
))
+ else if (SCM_
EQ_P (SCM_IM_BEGIN, SCM_CAR (form)
))
{
x = scm_append (scm_cons2 (SCM_CDR (form), SCM_CDR (x), SCM_EOL));
}
{
x = scm_append (scm_cons2 (SCM_CDR (form), SCM_CDR (x), SCM_EOL));
}
@@
-1344,10
+1348,10
@@
unmemocopy (SCM x, SCM env)
z = EXTEND_ENV (f, SCM_EOL, env);
/* inits */
e = scm_reverse (unmemocopy (SCM_CAR (x),
z = EXTEND_ENV (f, SCM_EOL, env);
/* inits */
e = scm_reverse (unmemocopy (SCM_CAR (x),
- SCM_
CAR (ls) == scm_sym_letrec
? z : env));
+ SCM_
EQ_P (SCM_CAR (ls), scm_sym_letrec)
? z : env));
env = z;
/* increments */
env = z;
/* increments */
- s = SCM_
CAR (ls) == scm_sym_do
+ s = SCM_
EQ_P (SCM_CAR (ls), scm_sym_do)
? scm_reverse (unmemocopy (SCM_CDR (SCM_CDR (SCM_CDR (x))), env))
: f;
/* build transformed binding list */
? scm_reverse (unmemocopy (SCM_CDR (SCM_CDR (SCM_CDR (x))), env))
: f;
/* build transformed binding list */
@@
-1356,7
+1360,7
@@
unmemocopy (SCM x, SCM env)
{
z = scm_acons (SCM_CAR (v),
scm_cons (SCM_CAR (e),
{
z = scm_acons (SCM_CAR (v),
scm_cons (SCM_CAR (e),
- SCM_
CAR (s) == SCM_CAR (v
)
+ SCM_
EQ_P (SCM_CAR (s), SCM_CAR (v)
)
? SCM_EOL
: scm_cons (SCM_CAR (s), SCM_EOL)),
z);
? SCM_EOL
: scm_cons (SCM_CAR (s), SCM_EOL)),
z);
@@
-1367,7
+1371,7
@@
unmemocopy (SCM x, SCM env)
while (SCM_NIMP (v));
z = scm_cons (z, SCM_UNSPECIFIED);
SCM_SETCDR (ls, z);
while (SCM_NIMP (v));
z = scm_cons (z, SCM_UNSPECIFIED);
SCM_SETCDR (ls, z);
- if (SCM_
CAR (ls) == scm_sym_do
)
+ if (SCM_
EQ_P (SCM_CAR (ls), scm_sym_do)
)
{
x = SCM_CDR (x);
/* test clause */
{
x = SCM_CDR (x);
/* test clause */
@@
-1973,7
+1977,7
@@
dispatch:
while (SCM_NIMP (x = SCM_CDR (x)))
{
proc = SCM_CAR (x);
while (SCM_NIMP (x = SCM_CDR (x)))
{
proc = SCM_CAR (x);
- if (
scm_sym_else == SCM_CAR (proc
))
+ if (
SCM_EQ_P (scm_sym_else, SCM_CAR (proc)
))
{
x = SCM_CDR (proc);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
{
x = SCM_CDR (proc);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
@@
-2006,7
+2010,7
@@
dispatch:
{
RETURN (t.arg1)
}
{
RETURN (t.arg1)
}
- if (
scm_sym_arrow != SCM_CAR (x
))
+ if (
! SCM_EQ_P (scm_sym_arrow, SCM_CAR (x)
))
{
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto begin;
{
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto begin;
@@
-2295,8
+2299,8
@@
dispatch:
if (SCM_NIMP (t.arg1))
do
{
if (SCM_NIMP (t.arg1))
do
{
- i += SCM_
UNPACK ((SCM_STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1)
)))
-
[scm_si_hashsets + hashset])
;
+ i += SCM_
STRUCT_DATA (scm_class_of (SCM_CAR (t.arg1
)))
+
[scm_si_hashsets + hashset]
;
t.arg1 = SCM_CDR (t.arg1);
}
while (--j && SCM_NIMP (t.arg1));
t.arg1 = SCM_CDR (t.arg1);
}
while (--j && SCM_NIMP (t.arg1));
@@
-2314,7
+2318,7
@@
dispatch:
do
{
/* More arguments than specifiers => CLASS != ENV */
do
{
/* More arguments than specifiers => CLASS != ENV */
- if (
scm_class_of (SCM_CAR (t.arg1)) != SCM_CAR (z
))
+ if (
! SCM_EQ_P (scm_class_of (SCM_CAR (t.arg1)), SCM_CAR (z)
))
goto next_method;
t.arg1 = SCM_CDR (t.arg1);
z = SCM_CDR (z);
goto next_method;
t.arg1 = SCM_CDR (t.arg1);
z = SCM_CDR (z);
@@
-2340,15
+2344,15
@@
dispatch:
case (SCM_ISYMNUM (SCM_IM_SLOT_REF)):
x = SCM_CDR (x);
t.arg1 = EVALCAR (x, env);
case (SCM_ISYMNUM (SCM_IM_SLOT_REF)):
x = SCM_CDR (x);
t.arg1 = EVALCAR (x, env);
- RETURN (SCM_
STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CADR (x))]
)
+ RETURN (SCM_
PACK (SCM_STRUCT_DATA (t.arg1) [SCM_INUM (SCM_CADR (x))])
)
case (SCM_ISYMNUM (SCM_IM_SLOT_SET_X)):
x = SCM_CDR (x);
t.arg1 = EVALCAR (x, env);
x = SCM_CDR (x);
proc = SCM_CDR (x);
case (SCM_ISYMNUM (SCM_IM_SLOT_SET_X)):
x = SCM_CDR (x);
t.arg1 = EVALCAR (x, env);
x = SCM_CDR (x);
proc = SCM_CDR (x);
- SCM_STRUCT_DATA (t.arg1)[SCM_INUM (SCM_CAR (x))]
- =
EVALCAR (proc, env
);
+ SCM_STRUCT_DATA (t.arg1)
[SCM_INUM (SCM_CAR (x))]
+ =
SCM_UNPACK (EVALCAR (proc, env)
);
RETURN (SCM_UNSPECIFIED)
case (SCM_ISYMNUM (SCM_IM_NIL_COND)):
RETURN (SCM_UNSPECIFIED)
case (SCM_ISYMNUM (SCM_IM_NIL_COND)):
@@
-2358,7
+2362,7
@@
dispatch:
if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env))
|| t.arg1 == scm_lisp_nil))
{
if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env))
|| t.arg1 == scm_lisp_nil))
{
- if (SCM_
CAR (x) == SCM_UNSPECIFIED
)
+ if (SCM_
EQ_P (SCM_CAR (x), SCM_UNSPECIFIED)
)
RETURN (t.arg1);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto carloop;
RETURN (t.arg1);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto carloop;
@@
-2386,7
+2390,7
@@
dispatch:
if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env))
|| t.arg1 == SCM_INUM0))
{
if (!(SCM_FALSEP (t.arg1 = EVALCAR (proc, env))
|| t.arg1 == SCM_INUM0))
{
- if (SCM_
CAR (x) == SCM_UNSPECIFIED
)
+ if (SCM_
EQ_P (SCM_CAR (x), SCM_UNSPECIFIED)
)
RETURN (t.arg1);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto carloop;
RETURN (t.arg1);
PREP_APPLY (SCM_UNDEFINED, SCM_EOL);
goto carloop;
@@
-2417,7
+2421,8
@@
dispatch:
while (SCM_NIMP (arg2))
{
proc = SCM_GLOC_VAL (SCM_CAR (t.arg1));
while (SCM_NIMP (arg2))
{
proc = SCM_GLOC_VAL (SCM_CAR (t.arg1));
- SCM_SETCDR (SCM_CAR (t.arg1) - 1L, SCM_CAR (arg2));
+ SCM_SETCDR (SCM_PACK (SCM_UNPACK (SCM_CAR (t.arg1)) - 1L),
+ SCM_CAR (arg2));
SCM_SETCAR (arg2, proc);
t.arg1 = SCM_CDR (t.arg1);
arg2 = SCM_CDR (arg2);
SCM_SETCAR (arg2, proc);
t.arg1 = SCM_CDR (t.arg1);
arg2 = SCM_CDR (arg2);
@@
-2437,7
+2442,8
@@
dispatch:
arg2 = SCM_CDAR (env);
while (SCM_NIMP (arg2))
{
arg2 = SCM_CDAR (env);
while (SCM_NIMP (arg2))
{
- SCM_SETCDR (SCM_CAR (t.arg1) - 1L, SCM_CAR (arg2));
+ SCM_SETCDR (SCM_PACK (SCM_UNPACK (SCM_CAR (t.arg1)) - 1L),
+ SCM_CAR (arg2));
t.arg1 = SCM_CDR (t.arg1);
arg2 = SCM_CDR (arg2);
}
t.arg1 = SCM_CDR (t.arg1);
arg2 = SCM_CDR (arg2);
}
@@
-3679,7
+3685,7
@@
long scm_tc16_promise;
SCM
scm_makprom (SCM code)
{
SCM
scm_makprom (SCM code)
{
- SCM_RETURN_NEWSMOB (scm_tc16_promise,
code
);
+ SCM_RETURN_NEWSMOB (scm_tc16_promise,
SCM_UNPACK (code)
);
}
}
@@
-3890,3
+3896,9
@@
scm_init_eval ()
}
#endif /* !DEVAL */
}
#endif /* !DEVAL */
+
+/*
+ Local Variables:
+ c-file-style: "gnu"
+ End:
+*/