[uim-commit] r1278 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Mon Aug 22 03:09:43 PDT 2005
Author: kzk
Date: 2005-08-22 03:09:39 -0700 (Mon, 22 Aug 2005)
New Revision: 1278
Added:
branches/r5rs/sigscheme/sigschemeinternal.h
Modified:
branches/r5rs/sigscheme/datas.c
branches/r5rs/sigscheme/debug.c
branches/r5rs/sigscheme/encoding.c
branches/r5rs/sigscheme/error.c
branches/r5rs/sigscheme/eval.c
branches/r5rs/sigscheme/io.c
branches/r5rs/sigscheme/main.c
branches/r5rs/sigscheme/operations-srfi1.c
branches/r5rs/sigscheme/operations-srfi8.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/read.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
branches/r5rs/sigscheme/sigschemetype.h
Log:
* add sigschemeinternal.h
- define non-prefix version of macros and use it in each .c file
* sigscheme/sigschemeinternal.h
- new file
* sigscheme/operations-srfi1.c
* sigscheme/io.c
* sigscheme/sigscheme.c
* sigscheme/read.c
* sigscheme/operations-srfi8.c
* sigscheme/sigscheme.h
* sigscheme/sigschemetype.h
* sigscheme/operations.c
* sigscheme/main.c
* sigscheme/encoding.c
* sigscheme/debug.c
* sigscheme/eval.c
* sigscheme/error.c
* sigscheme/datas.c
- simplify code with non-prefix version of macros defined in
sigschemeinternal.h
Modified: branches/r5rs/sigscheme/datas.c
===================================================================
--- branches/r5rs/sigscheme/datas.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/datas.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -89,6 +89,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
@@ -310,7 +311,7 @@
gc_sweep();
/* we cannot sweep the object, so let's add new heap */
- if (SCM_NULLP(scm_freelist)) {
+ if (NULLP(scm_freelist)) {
#if DEBUG_GC
printf("Cannot sweeped the object, allocating new heap.\n");
#endif
@@ -324,7 +325,7 @@
mark_loop:
/* no need to mark SCM_NIL */
- if (SCM_NULLP(obj))
+ if (NULLP(obj))
return;
/* avoid cyclic marking */
@@ -337,8 +338,8 @@
/* mark recursively */
switch (SCM_TYPE(obj)) {
case ScmCons:
- mark_obj(SCM_CAR(obj));
- obj = SCM_CDR(obj);
+ mark_obj(CAR(obj));
+ obj = CDR(obj);
goto mark_loop;
break;
@@ -840,8 +841,8 @@
/* Search Symbol by name */
list = sym_list;
- for (; !SCM_NULLP(list); list = SCM_CDR(list)) {
- sym = SCM_CAR(list);
+ for (; !NULLP(list); list = CDR(list)) {
+ sym = CAR(list);
if (strcmp(SCM_SYMBOL_NAME(sym), name) == 0) {
return sym;
@@ -862,7 +863,7 @@
int Scm_GetInt(ScmObj num)
{
- if (SCM_FALSEP(ScmOp_numberp(num)))
+ if (FALSEP(ScmOp_numberp(num)))
SigScm_ErrorObj("Scm_GetInt : number required but got ", num);
return SCM_INT_VALUE(num);
@@ -888,7 +889,7 @@
#if SCM_USE_NONSTD_FEATURES
void* Scm_GetCPointer(ScmObj c_ptr)
{
- if (!SCM_C_POINTERP(c_ptr))
+ if (!C_POINTERP(c_ptr))
SigScm_ErrorObj("Scm_GetCPointer : c_ptr required but got ", c_ptr);
return SCM_C_POINTER_DATA(c_ptr);
@@ -896,7 +897,7 @@
C_FUNC Scm_GetCFuncPointer(ScmObj c_funcptr)
{
- if (!SCM_C_FUNCPOINTERP(c_funcptr))
+ if (!C_FUNCPOINTERP(c_funcptr))
SigScm_ErrorObj("Scm_GetCFuncPointer : c_funcptr required but got ", c_funcptr);
return SCM_C_FUNCPOINTER_FUNC(c_funcptr);
Modified: branches/r5rs/sigscheme/debug.c
===================================================================
--- branches/r5rs/sigscheme/debug.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/debug.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -40,6 +40,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
@@ -235,27 +236,27 @@
fprintf(f, "(");
/* get car and cdr */
- car = SCM_CAR(list);
- cdr = SCM_CDR(list);
+ car = CAR(list);
+ cdr = CDR(list);
/* print car */
print_ScmObj_internal(f, car, otype);
- if (!SCM_NULLP(cdr))
+ if (!NULLP(cdr))
fprintf(f, " ");
/* print else for-each */
- for (tmp = cdr; ; tmp = SCM_CDR(tmp)) {
- if (SCM_CONSP(tmp)) {
- print_ScmObj_internal(f, SCM_CAR(tmp), otype);
- if (SCM_NULLP(SCM_CDR(tmp))) {
+ for (tmp = cdr; ; tmp = CDR(tmp)) {
+ if (CONSP(tmp)) {
+ print_ScmObj_internal(f, CAR(tmp), otype);
+ if (NULLP(CDR(tmp))) {
fprintf(f, ")");
return;
} else {
- if (!SCM_NULLP(SCM_CDR(tmp)))
+ if (!NULLP(CDR(tmp)))
fprintf(f, " ");
}
} else {
- if (!SCM_NULLP(tmp)) {
+ if (!NULLP(tmp)) {
fprintf(f, ". ");
print_ScmObj_internal(f, tmp, otype);
}
Modified: branches/r5rs/sigscheme/encoding.c
===================================================================
--- branches/r5rs/sigscheme/encoding.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/encoding.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -64,21 +64,21 @@
=======================================*/
int SigScm_default_encoding_strlen(const char *str)
{
-#if USE_EUCJP
+#if SCM_USE_EUCJP
return eucjp_strlen(str);
#endif
}
const char* SigScm_default_encoding_str_startpos(const char *str, int k)
{
-#if USE_EUCJP
+#if SCM_USE_EUCJP
return eucjp_str_startpos(str, k);
#endif
}
const char* SigScm_default_encoding_str_endpos(const char *str, int k)
{
-#if USE_EUCJP
+#if SCM_USE_EUCJP
return eucjp_str_endpos(str, k);
#endif
}
Modified: branches/r5rs/sigscheme/error.c
===================================================================
--- branches/r5rs/sigscheme/error.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/error.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -41,6 +41,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
Modified: branches/r5rs/sigscheme/eval.c
===================================================================
--- branches/r5rs/sigscheme/eval.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/eval.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -52,6 +52,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
@@ -62,7 +63,7 @@
=======================================*/
#define SCM_INVALID NULL /* TODO: make a more appropriate choice */
-#define IS_LIST_LEN_1(args) (SCM_CONSP(args) && SCM_NULLP(SCM_CDR(args)))
+#define IS_LIST_LEN_1(args) (CONSP(args) && NULLP(CDR(args)))
/* for the quasiquote family */
#define QQUOTE_SET_VERBATIM(x) ((x) = SCM_INVALID)
#define QQUOTE_IS_VERBATIM(x) (EQ((x), SCM_INVALID))
@@ -101,27 +102,27 @@
/* handle dot list */
while (1) {
- if (SCM_NULLP(tmp_vars) || !SCM_CONSP(tmp_vars))
+ if (NULLP(tmp_vars) || !CONSP(tmp_vars))
break;
/* dot list appears */
- if (!SCM_NULLP(SCM_CDR(tmp_vars)) && !SCM_CONSP(SCM_CDR(tmp_vars))) {
+ if (!NULLP(CDR(tmp_vars)) && !CONSP(CDR(tmp_vars))) {
/* create new value */
- SCM_SETCDR(tmp_vals, Scm_NewCons(SCM_CDR(tmp_vals),
+ SCM_SETCDR(tmp_vals, Scm_NewCons(CDR(tmp_vals),
SCM_NIL));
}
- tmp_vars = SCM_CDR(tmp_vars);
- tmp_vals = SCM_CDR(tmp_vals);
+ tmp_vars = CDR(tmp_vars);
+ tmp_vals = CDR(tmp_vals);
}
/* create new frame */
frame = Scm_NewCons(vars, vals);
/* add to env */
- if (SCM_NULLP(env))
+ if (NULLP(env))
env = Scm_NewCons(frame, SCM_NIL);
- else if (SCM_CONSP(env))
+ else if (CONSP(env))
env = Scm_NewCons(frame, env);
else
SigScm_Error("Broken environment.\n");
@@ -136,21 +137,21 @@
ScmObj new_varlist, new_vallist;
/* sanity check */
- if (SCM_NULLP(var))
+ if (NULLP(var))
return env;
/* add (var val) pair to the newest frame in env */
- if (SCM_NULLP(env)) {
+ if (NULLP(env)) {
newest_frame = Scm_NewCons(Scm_NewCons(var, SCM_NIL),
Scm_NewCons(val, SCM_NIL));
env = Scm_NewCons(newest_frame,
SCM_NIL);
- } else if (SCM_CONSP(env)) {
- newest_frame = SCM_CAR(env);
- new_varlist = Scm_NewCons(var, SCM_CAR(newest_frame));
- new_vallist = Scm_NewCons(val, SCM_CDR(newest_frame));
+ } else if (CONSP(env)) {
+ newest_frame = CAR(env);
+ new_varlist = Scm_NewCons(var, CAR(newest_frame));
+ new_vallist = Scm_NewCons(val, CDR(newest_frame));
- tmp = Scm_NewCons(Scm_NewCons(new_varlist, new_vallist), SCM_CDR(env));
+ tmp = Scm_NewCons(Scm_NewCons(new_varlist, new_vallist), CDR(env));
*env = *tmp;
} else {
SigScm_Error("broken environment\n");
@@ -172,16 +173,16 @@
ScmObj val = SCM_NIL;
/* sanity check */
- if (SCM_NULLP(env))
+ if (NULLP(env))
return SCM_NIL;
- if (!SCM_CONSP(env))
+ if (!CONSP(env))
SigScm_ErrorObj("Broken environent : ", env);
/* lookup frames */
- for (; !SCM_NULLP(env); env = SCM_CDR(env)) {
- frame = SCM_CAR(env);
+ for (; !NULLP(env); env = CDR(env)) {
+ frame = CAR(env);
val = lookup_frame(var, frame);
- if (!SCM_NULLP(val))
+ if (!NULLP(val))
return val;
}
@@ -194,33 +195,33 @@
ScmObj vars = SCM_NIL;
/* sanity check */
- if (SCM_NULLP(frame))
+ if (NULLP(frame))
return SCM_NIL;
- else if (!SCM_CONSP(frame))
+ else if (!CONSP(frame))
SigScm_ErrorObj("Broken frame : ", frame);
/* lookup in frame */
- vars = SCM_CAR(frame);
- vals = SCM_CDR(frame);
+ vars = CAR(frame);
+ vals = CDR(frame);
while (1) {
- if (SCM_NULLP(vars))
+ if (NULLP(vars))
break;
- if (!SCM_CONSP(vars)) {
+ if (!CONSP(vars)) {
/* handle dot list */
- if (SCM_EQ(vars, var))
+ if (EQ(vars, var))
return vals;
break;
} else {
/* normal binding */
- if (SCM_EQ(SCM_CAR(vars), var))
+ if (EQ(CAR(vars), var))
return vals;
}
- vars = SCM_CDR(vars);
- vals = SCM_CDR(vals);
+ vars = CDR(vars);
+ vals = CDR(vals);
}
return SCM_NIL;
@@ -258,7 +259,7 @@
/*============================================================
Evaluating CAR
============================================================*/
- tmp = SCM_CAR(obj);
+ tmp = CAR(obj);
switch (SCM_TYPE(tmp)) {
case ScmFunc:
break;
@@ -307,14 +308,14 @@
case FUNCTYPE_L:
{
ret = SCM_FUNC_EXEC_SUBRL(tmp,
- map_eval(SCM_CDR(obj), env),
+ map_eval(CDR(obj), env),
env);
goto eval_done;
}
case FUNCTYPE_R:
{
obj = SCM_FUNC_EXEC_SUBRR(tmp,
- SCM_CDR(obj),
+ CDR(obj),
&env,
&tail_flag);
@@ -333,28 +334,28 @@
}
case FUNCTYPE_2N:
{
- obj = SCM_CDR(obj);
+ obj = CDR(obj);
/* check 1st arg */
- if (SCM_NULLP(obj)) {
+ if (NULLP(obj)) {
ret = SCM_FUNC_EXEC_SUBR2N(tmp, SCM_NIL, SCM_NIL);
goto eval_done;
}
/* eval 1st arg */
- ret = ScmOp_eval(SCM_CAR(obj), env);
+ ret = ScmOp_eval(CAR(obj), env);
/* check 2nd arg */
- if (SCM_NULLP(SCM_CDR(obj))) {
+ if (NULLP(CDR(obj))) {
ret = SCM_FUNC_EXEC_SUBR2N(tmp, ret, SCM_NIL);
goto eval_done;
}
/* call proc with each 2 objs */
- for (obj = SCM_CDR(obj); !SCM_NULLP(obj); obj = SCM_CDR(obj)) {
+ for (obj = CDR(obj); !NULLP(obj); obj = CDR(obj)) {
ret = SCM_FUNC_EXEC_SUBR2N(tmp,
ret,
- ScmOp_eval(SCM_CAR(obj), env));
+ ScmOp_eval(CAR(obj), env));
}
goto eval_done;
}
@@ -365,52 +366,52 @@
}
case FUNCTYPE_1:
{
- ret = SCM_FUNC_EXEC_SUBR1(tmp, ScmOp_eval(SCM_CAR(SCM_CDR(obj)),env));
+ ret = SCM_FUNC_EXEC_SUBR1(tmp, ScmOp_eval(CAR(CDR(obj)),env));
goto eval_done;
}
case FUNCTYPE_2:
{
- obj = SCM_CDR(obj);
- arg = ScmOp_eval(SCM_CAR(obj), env); /* 1st arg */
+ obj = CDR(obj);
+ arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
ret = SCM_FUNC_EXEC_SUBR2(tmp,
arg,
- ScmOp_eval(SCM_CAR(SCM_CDR(obj)), env)); /* 2nd arg */
+ ScmOp_eval(CAR(CDR(obj)), env)); /* 2nd arg */
goto eval_done;
}
case FUNCTYPE_3:
{
- obj = SCM_CDR(obj);
- arg = ScmOp_eval(SCM_CAR(obj), env); /* 1st arg */
- obj = SCM_CDR(obj);
+ obj = CDR(obj);
+ arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
+ obj = CDR(obj);
ret = SCM_FUNC_EXEC_SUBR3(tmp,
arg,
- ScmOp_eval(SCM_CAR(obj), env), /* 2nd arg */
- ScmOp_eval(SCM_CAR(SCM_CDR(obj)), env)); /* 3rd arg */
+ ScmOp_eval(CAR(obj), env), /* 2nd arg */
+ ScmOp_eval(CAR(CDR(obj)), env)); /* 3rd arg */
goto eval_done;
}
case FUNCTYPE_4:
{
- obj = SCM_CDR(obj);
- arg = ScmOp_eval(SCM_CAR(obj), env); /* 1st arg */
- obj = SCM_CDR(obj);
+ obj = CDR(obj);
+ arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
+ obj = CDR(obj);
ret = SCM_FUNC_EXEC_SUBR4(tmp,
arg,
- ScmOp_eval(SCM_CAR(obj), env), /* 2nd arg */
- ScmOp_eval(SCM_CAR(SCM_CDR(obj)), env), /* 3rd arg */
- ScmOp_eval(SCM_CAR(SCM_CDR(SCM_CDR(obj))), env)); /* 4th arg */
+ ScmOp_eval(CAR(obj), env), /* 2nd arg */
+ ScmOp_eval(CAR(CDR(obj)), env), /* 3rd arg */
+ ScmOp_eval(CAR(CDR(CDR(obj))), env)); /* 4th arg */
goto eval_done;
}
case FUNCTYPE_5:
{
- obj = SCM_CDR(obj);
- arg = ScmOp_eval(SCM_CAR(obj), env); /* 1st arg */
- obj = SCM_CDR(obj);
+ obj = CDR(obj);
+ arg = ScmOp_eval(CAR(obj), env); /* 1st arg */
+ obj = CDR(obj);
ret = SCM_FUNC_EXEC_SUBR5(tmp,
arg,
- ScmOp_eval(SCM_CAR(obj), env), /* 2nd arg */
- ScmOp_eval(SCM_CAR(SCM_CDR(obj)), env), /* 3rd arg */
- ScmOp_eval(SCM_CAR(SCM_CDR(SCM_CDR(obj))), env), /* 4th arg */
- ScmOp_eval(SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(obj)))), env)); /* 5th arg */
+ ScmOp_eval(CAR(obj), env), /* 2nd arg */
+ ScmOp_eval(CAR(CDR(obj)), env), /* 3rd arg */
+ ScmOp_eval(CAR(CDR(CDR(obj))), env), /* 4th arg */
+ ScmOp_eval(CAR(CDR(CDR(CDR(obj)))), env)); /* 5th arg */
goto eval_done;
}
default:
@@ -430,15 +431,15 @@
* (2) : (<variable1> <variable2> ...)
* (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
*/
- arg = SCM_CAR(SCM_CLOSURE_EXP(tmp)); /* arg is <formals> */
+ arg = CAR(SCM_CLOSURE_EXP(tmp)); /* arg is <formals> */
- if (SCM_SYMBOLP(arg)) {
+ if (SYMBOLP(arg)) {
/* (1) : <variable> */
env = extend_environment(Scm_NewCons(arg, SCM_NIL),
- Scm_NewCons(map_eval(SCM_CDR(obj), env),
+ Scm_NewCons(map_eval(CDR(obj), env),
SCM_NIL),
SCM_CLOSURE_ENV(tmp));
- } else if (SCM_CONSP(arg)) {
+ } else if (CONSP(arg)) {
/*
* (2) : (<variable1> <variable2> ...)
* (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
@@ -446,9 +447,9 @@
* - dot list is handled in lookup_frame().
*/
env = extend_environment(arg,
- map_eval(SCM_CDR(obj), env),
+ map_eval(CDR(obj), env),
SCM_CLOSURE_ENV(tmp));
- } else if (SCM_NULLP(arg)) {
+ } else if (NULLP(arg)) {
/*
* (2') : <variable> is '()
*/
@@ -465,7 +466,7 @@
* The return obj of ScmExp_begin is the raw S-expression.
* So we need to re-evaluate this!.
*/
- obj = ScmExp_begin(SCM_CDR(SCM_CLOSURE_EXP(tmp)), &env, &tail_flag);
+ obj = ScmExp_begin(CDR(SCM_CLOSURE_EXP(tmp)), &env, &tail_flag);
goto eval_loop;
}
case ScmContinuation:
@@ -482,7 +483,7 @@
* the stack. Is there any efficient way to implement first
* class continuation? (TODO).
*/
- obj = SCM_CAR(SCM_CDR(obj));
+ obj = CAR(CDR(obj));
continuation_thrown_obj = ScmOp_eval(obj, env);
longjmp(SCM_CONTINUATION_JMPENV(tmp), 1);
break;
@@ -514,14 +515,14 @@
/* sanity check */
if CHECK_2_ARGS(args)
SigScm_Error("apply : Wrong number of arguments\n");
- if (!SCM_NULLP(SCM_CDR(SCM_CDR(args))))
+ if (!NULLP(CDR(CDR(args))))
SigScm_Error("apply : Doesn't support multiarg apply\n");
/* 1st elem of list is proc */
- proc = SCM_CAR(args);
+ proc = CAR(args);
/* 2nd elem of list is obj */
- obj = SCM_CAR(SCM_CDR(args));
+ obj = CAR(CDR(args));
/* apply proc */
switch (SCM_TYPE(proc)) {
@@ -539,21 +540,21 @@
args = obj;
/* check 1st arg */
- if (SCM_NULLP(args))
+ if (NULLP(args))
return SCM_FUNC_EXEC_SUBR2N(proc, SCM_NIL, SCM_NIL);
/* eval 1st arg */
- obj = SCM_CAR(args);
+ obj = CAR(args);
/* check 2nd arg */
- if (SCM_NULLP(SCM_CDR(args)))
+ if (NULLP(CDR(args)))
return SCM_FUNC_EXEC_SUBR2N(proc, obj, SCM_NIL);
/* call proc with each 2 objs */
- for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
+ for (args = CDR(args); !NULLP(args); args = CDR(args)) {
obj = SCM_FUNC_EXEC_SUBR2N(proc,
obj,
- SCM_CAR(args));
+ CAR(args));
}
return obj;
}
@@ -564,37 +565,37 @@
case FUNCTYPE_1:
{
return SCM_FUNC_EXEC_SUBR1(proc,
- SCM_CAR(obj));
+ CAR(obj));
}
case FUNCTYPE_2:
{
return SCM_FUNC_EXEC_SUBR2(proc,
- SCM_CAR(obj),
- SCM_CAR(SCM_CDR(obj)));
+ CAR(obj),
+ CAR(CDR(obj)));
}
case FUNCTYPE_3:
{
return SCM_FUNC_EXEC_SUBR3(proc,
- SCM_CAR(obj),
- SCM_CAR(SCM_CDR(obj)),
- SCM_CAR(SCM_CDR(SCM_CDR(obj))));
+ CAR(obj),
+ CAR(CDR(obj)),
+ CAR(CDR(CDR(obj))));
}
case FUNCTYPE_4:
{
return SCM_FUNC_EXEC_SUBR4(proc,
- SCM_CAR(obj),
- SCM_CAR(SCM_CDR(obj)),
- SCM_CAR(SCM_CDR(SCM_CDR(obj))),
- SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(obj)))));
+ CAR(obj),
+ CAR(CDR(obj)),
+ CAR(CDR(CDR(obj))),
+ CAR(CDR(CDR(CDR(obj)))));
}
case FUNCTYPE_5:
{
return SCM_FUNC_EXEC_SUBR5(proc,
- SCM_CAR(obj),
- SCM_CAR(SCM_CDR(obj)),
- SCM_CAR(SCM_CDR(SCM_CDR(obj))),
- SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(obj)))),
- SCM_CAR(SCM_CDR(SCM_CDR(SCM_CDR(SCM_CDR(obj))))));
+ CAR(obj),
+ CAR(CDR(obj)),
+ CAR(CDR(CDR(obj))),
+ CAR(CDR(CDR(CDR(obj)))),
+ CAR(CDR(CDR(CDR(CDR(obj))))));
}
default:
SigScm_ErrorObj("apply : invalid application ", proc);
@@ -613,14 +614,14 @@
* (2) : (<variable1> <variable2> ...)
* (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
*/
- args = SCM_CAR(SCM_CLOSURE_EXP(proc)); /* arg is <formals> */
+ args = CAR(SCM_CLOSURE_EXP(proc)); /* arg is <formals> */
- if (SCM_SYMBOLP(args)) {
+ if (SYMBOLP(args)) {
/* (1) : <variable> */
env = extend_environment(Scm_NewCons(args, SCM_NIL),
Scm_NewCons(obj, SCM_NIL),
SCM_CLOSURE_ENV(proc));
- } else if (SCM_CONSP(args)) {
+ } else if (CONSP(args)) {
/*
* (2) : (<variable1> <variable2> ...)
* (3) : (<variable1> <variable2> ... <variable n-1> . <variable n>)
@@ -630,7 +631,7 @@
env = extend_environment(args,
obj,
SCM_CLOSURE_ENV(proc));
- } else if (SCM_NULLP(args)) {
+ } else if (NULLP(args)) {
/*
* (2') : <variable> is '()
*/
@@ -647,7 +648,7 @@
* The return obj of ScmExp_begin is the raw S-expression.
* So we need to re-evaluate this!.
*/
- obj = ScmExp_begin(SCM_CDR(SCM_CLOSURE_EXP(proc)), &env, &tail_flag);
+ obj = ScmExp_begin(CDR(SCM_CLOSURE_EXP(proc)), &env, &tail_flag);
return ScmOp_eval(obj, env);
}
default:
@@ -663,21 +664,21 @@
ScmObj val = SCM_NIL;
/* sanity check */
- if (!SCM_SYMBOLP(var))
+ if (!SYMBOLP(var))
SigScm_ErrorObj("symbol_value : not symbol : ", var);
/* first, lookup the environment */
val = lookup_environment(var, env);
- if (!SCM_NULLP(val)) {
+ if (!NULLP(val)) {
/* variable is found in environment, so returns its value */
- return SCM_CAR(val);
+ return CAR(val);
}
/* next, lookup the special environment for letrec */
val = lookup_environment(var, letrec_env);
- if (!SCM_NULLP(val)) {
+ if (!NULLP(val)) {
/* variable is found in letrec environment, so returns its value */
- return SCM_CAR(val);
+ return CAR(val);
}
/* finally, look at the VCELL */
@@ -696,15 +697,15 @@
ScmObj newtail = SCM_NIL;
/* sanity check */
- if (SCM_NULLP(args))
+ if (NULLP(args))
return SCM_NIL;
/* eval each element of args */
- result = Scm_NewCons(ScmOp_eval(SCM_CAR(args), env), SCM_NIL);
+ result = Scm_NewCons(ScmOp_eval(CAR(args), env), SCM_NIL);
tail = result;
newtail = SCM_NIL;
- for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
- newtail = Scm_NewCons(ScmOp_eval(SCM_CAR(args), env), SCM_NIL);
+ for (args = CDR(args); !NULLP(args); args = CDR(args)) {
+ newtail = Scm_NewCons(ScmOp_eval(CAR(args), env), SCM_NIL);
SCM_SETCDR(tail, newtail);
tail = newtail;
}
@@ -744,24 +745,24 @@
ScmObj src = qexpr; \
ret_tail = &ret_list; \
while (!EQ(src, end)) { \
- *ret_tail = Scm_NewCons(SCM_CAR(src), SCM_NIL); \
- ret_tail = &SCM_CDR(*ret_tail); \
- src = SCM_CDR(src); \
+ *ret_tail = Scm_NewCons(CAR(src), SCM_NIL); \
+ ret_tail = &CDR(*ret_tail); \
+ src = CDR(src); \
} \
} while (0)
QQUOTE_SET_VERBATIM(ret_list); /* default return value */
- if (SCM_CONSP(qexpr)) {
- car = SCM_CAR(qexpr);
- args = SCM_CDR(qexpr);
+ if (CONSP(qexpr)) {
+ car = CAR(qexpr);
+ args = CDR(qexpr);
if (EQ(car, SCM_UNQUOTE_SPLICING)) {
if (!IS_LIST_LEN_1(args))
SigScm_ErrorObj("syntax error: ", qexpr);
if (--nest == 0)
- return ScmOp_eval(SCM_CAR(args), env);
+ return ScmOp_eval(CAR(args), env);
} else if (EQ(car, SCM_QUASIQUOTE)) {
if (!IS_LIST_LEN_1(args))
SigScm_ErrorObj("syntax error: ", qexpr);
@@ -770,21 +771,21 @@
}
}
- for (ls = qexpr; SCM_CONSP(ls); ls = SCM_CDR(ls)) {
- obj = SCM_CAR(ls);
+ for (ls = qexpr; CONSP(ls); ls = CDR(ls)) {
+ obj = CAR(ls);
splice_flag = 0;
- if (SCM_CONSP(obj)) {
+ if (CONSP(obj)) {
result = qquote_internal(obj, env, nest);
- if (EQ(SCM_CAR(obj), SCM_UNQUOTE_SPLICING) && nest == 1) {
+ if (EQ(CAR(obj), SCM_UNQUOTE_SPLICING) && nest == 1) {
/* , at x */
splice_flag = 1;
}
- } else if (SCM_VECTORP(obj)) {
+ } else if (VECTORP(obj)) {
/* #(x) */
result = qquote_vector(obj, env, nest);
- } else if (EQ(obj, SCM_UNQUOTE) && IS_LIST_LEN_1(SCM_CDR(ls))) {
+ } else if (EQ(obj, SCM_UNQUOTE) && IS_LIST_LEN_1(CDR(ls))) {
/* we're at the comma in (x . ,y) or qexpr was ,z */
if (--nest == 0) {
result = ScmOp_eval(SCM_CADR(ls), env);
@@ -799,7 +800,7 @@
if (QQUOTE_IS_VERBATIM(result)) {
if (!qquote_copy_delayed()) {
*ret_tail = Scm_NewCons(obj, SCM_NIL);
- ret_tail = &SCM_CDR(*ret_tail);
+ ret_tail = &CDR(*ret_tail);
}
} else {
if (qquote_copy_delayed())
@@ -808,21 +809,21 @@
if (splice_flag) {
*ret_tail = result;
/* find the new tail (which may be the current pos) */
- while (SCM_CONSP(*ret_tail))
- ret_tail = &SCM_CDR(*ret_tail);
- if (!SCM_NULLP(*ret_tail))
+ while (CONSP(*ret_tail))
+ ret_tail = &CDR(*ret_tail);
+ if (!NULLP(*ret_tail))
SigScm_ErrorObj("unquote-splicing: bad list: ",
result);
} else {
*ret_tail = Scm_NewCons(result, SCM_NIL);
- ret_tail = &SCM_CDR(*ret_tail);
+ ret_tail = &CDR(*ret_tail);
}
}
} /* foreach ls in qexpr */
/* Handle the leftover of an improper list; if qexpr is a proper
* list, all the following will be a no-op. */
- if (SCM_VECTORP(ls))
+ if (VECTORP(ls))
result = qquote_vector(ls, env, nest);
else
QQUOTE_SET_VERBATIM(result);
@@ -867,7 +868,7 @@
/* local "functions" */
#define qquote_copy_delayed() (copy_buf == NULL)
#define qquote_is_spliced(o) \
- (SCM_CONSP(o) && EQ(SCM_CAR(o), SCM_UNQUOTE_SPLICING))
+ (CONSP(o) && EQ(CAR(o), SCM_UNQUOTE_SPLICING))
#define qquote_force_copy_upto(n) \
do { \
int k; \
@@ -889,7 +890,7 @@
for (i = len - 1; i >= 0; i--) {
expr = SCM_VECTOR_CREF(src, i);
if (qquote_is_spliced(expr)) {
- if (!IS_LIST_LEN_1(SCM_CDR(expr)))
+ if (!IS_LIST_LEN_1(CDR(expr)))
SigScm_ErrorObj("syntax error: ", expr);
result = ScmOp_eval(SCM_CADR(expr), env);
@@ -903,7 +904,7 @@
splices);
}
}
- if (!SCM_NULLP(splices)) {
+ if (!NULLP(splices)) {
next_splice_index = SCM_INT_VALUE(SCM_CDAR(splices));
qquote_force_copy_upto(0);
}
@@ -913,20 +914,20 @@
/* j will be the index for copy_buf */
if (i == next_splice_index) {
/* spliced */
- for (expr=SCM_CAAR(splices); !SCM_NULLP(expr); expr=SCM_CDR(expr))
- copy_buf[j++] = SCM_CAR(expr);
- splices = SCM_CDR(splices);
+ for (expr=SCM_CAAR(splices); !NULLP(expr); expr=CDR(expr))
+ copy_buf[j++] = CAR(expr);
+ splices = CDR(splices);
- if (SCM_NULLP(splices))
+ if (NULLP(splices))
next_splice_index = -1;
else
next_splice_index = SCM_INT_VALUE(SCM_CDAR(splices));
/* continue; */
} else {
expr = SCM_VECTOR_CREF(src, i);
- if (SCM_CONSP(expr))
+ if (CONSP(expr))
result = qquote_internal(expr, env, nest);
- else if (SCM_VECTORP(expr))
+ else if (VECTORP(expr))
result = qquote_vector(expr, env, nest);
else
QQUOTE_SET_VERBATIM(result);
@@ -957,10 +958,10 @@
===========================================================================*/
ScmObj ScmOp_quote(ScmObj obj, ScmObj *envp, int *tail_flag)
{
- if (!SCM_CONSP(obj) || !SCM_NULLP(SCM_CDR(obj)))
+ if (!CONSP(obj) || !NULLP(CDR(obj)))
SigScm_ErrorObj("quote: bad argument list: ", obj);
*tail_flag = 0;
- return SCM_CAR(obj);
+ return CAR(obj);
}
/*===========================================================================
@@ -992,25 +993,25 @@
(*tail_flag) = 1;
/* sanity check */
- if (SCM_NULLP(exp) || SCM_NULLP(SCM_CDR(exp)))
+ if (NULLP(exp) || NULLP(CDR(exp)))
SigScm_ErrorObj("if : syntax error : ", exp);
/* eval predicates */
- pred = ScmOp_eval(SCM_CAR(exp), env);
+ pred = ScmOp_eval(CAR(exp), env);
/* if pred is true value */
- if (SCM_NFALSEP(pred)) {
+ if (NFALSEP(pred)) {
/* doesn't evaluate now for tail-recursion. */
- return SCM_CAR(SCM_CDR(exp));
+ return CAR(CDR(exp));
}
/* if pred is SCM_FALSE */
- false_exp = SCM_CDR(SCM_CDR(exp));
- if (SCM_NULLP(false_exp))
+ false_exp = CDR(CDR(exp));
+ if (NULLP(false_exp))
return SCM_UNDEF;
/* doesn't evaluate now for tail-recursion. */
- return SCM_CAR(false_exp);
+ return CAR(false_exp);
}
/*===========================================================================
@@ -1019,8 +1020,8 @@
ScmObj ScmExp_set(ScmObj arg, ScmObj *envp, int *tail_flag)
{
ScmObj env = *envp;
- ScmObj sym = SCM_CAR(arg);
- ScmObj val = SCM_CAR(SCM_CDR(arg));
+ ScmObj sym = CAR(arg);
+ ScmObj val = CAR(CDR(arg));
ScmObj ret = SCM_NIL;
ScmObj tmp = SCM_NIL;
@@ -1029,12 +1030,10 @@
ret = ScmOp_eval(val, env);
tmp = lookup_environment(sym, env);
- if (SCM_NULLP(tmp)) {
- /*
- * not found in the environment
- * if symbol is not bounded, error occurs
- */
- if (SCM_FALSEP(ScmOp_symbol_boundp(sym)))
+ if (NULLP(tmp)) {
+ /* Not found in the environment
+ If symbol is not bounded, error occurs */
+ if (FALSEP(ScmOp_symbol_boundp(sym)))
SigScm_ErrorObj("set! : unbound variable ", sym);
SCM_SETSYMBOL_VCELL(sym, ret);
@@ -1077,24 +1076,24 @@
(*tail_flag) = 0;
/* looping in each clause */
- for (; !SCM_NULLP(arg); arg = SCM_CDR(arg)) {
- clause = SCM_CAR(arg);
- test = SCM_CAR(clause);
- exps = SCM_CDR(clause);
+ for (; !NULLP(arg); arg = CDR(arg)) {
+ clause = CAR(arg);
+ test = CAR(clause);
+ exps = CDR(clause);
- if (SCM_NULLP(clause) || SCM_NULLP(test))
+ if (NULLP(clause) || NULLP(test))
SigScm_Error("cond : syntax error\n");
/* evaluate test */
test = ScmOp_eval(test, env);
/* check the result */
- if (SCM_NFALSEP(test)) {
+ if (NFALSEP(test)) {
/*
* if the selected <clause> contains only the <test> and no <expression>s,
* then the value of the <test> is returned as the result.
*/
- if (SCM_NULLP(exps))
+ if (NULLP(exps))
return test;
/*
@@ -1103,9 +1102,9 @@
* this procedure is then called on the value of the <test> and the value
* returned by this procedure is returned by the cond expression.
*/
- if (SCM_EQ(Scm_Intern("=>"), SCM_CAR(exps))) {
- proc = ScmOp_eval(SCM_CAR(SCM_CDR(exps)), env);
- if (SCM_FALSEP(ScmOp_procedurep(proc)))
+ if (EQ(Scm_Intern("=>"), CAR(exps))) {
+ proc = ScmOp_eval(CAR(CDR(exps)), env);
+ if (FALSEP(ScmOp_procedurep(proc)))
SigScm_ErrorObj("cond : the value of exp after => must be the procedure but got ", proc);
return ScmOp_apply(Scm_NewCons(proc,
@@ -1124,26 +1123,26 @@
ScmObj ScmExp_case(ScmObj arg, ScmObj *envp, int *tail_flag)
{
ScmObj env = *envp;
- ScmObj key = ScmOp_eval(SCM_CAR(arg), env);
+ ScmObj key = ScmOp_eval(CAR(arg), env);
ScmObj clause = SCM_NIL;
ScmObj datums = SCM_NIL;
ScmObj exps = SCM_NIL;
/* looping in each clause */
- for (arg = SCM_CDR(arg); !SCM_NULLP(arg); arg = SCM_CDR(arg)) {
- clause = SCM_CAR(arg);
- datums = SCM_CAR(clause);
- exps = SCM_CDR(clause);
- if (SCM_NULLP(clause) || SCM_NULLP(datums) || SCM_NULLP(exps))
+ for (arg = CDR(arg); !NULLP(arg); arg = CDR(arg)) {
+ clause = CAR(arg);
+ datums = CAR(clause);
+ exps = CDR(clause);
+ if (NULLP(clause) || NULLP(datums) || NULLP(exps))
SigScm_Error("case : syntax error\n");
/* check "else" symbol */
- if (SCM_NULLP(SCM_CDR(arg)) && !SCM_CONSP(datums) && SCM_NFALSEP(SCM_SYMBOL_VCELL(datums)))
+ if (NULLP(CDR(arg)) && !CONSP(datums) && NFALSEP(SCM_SYMBOL_VCELL(datums)))
return ScmExp_begin(exps, &env, tail_flag);
/* evaluate datums and compare to key by eqv? */
- for (; !SCM_NULLP(datums); datums = SCM_CDR(datums)) {
- if (SCM_NFALSEP(ScmOp_eqvp(SCM_CAR(datums), key))) {
+ for (; !NULLP(datums); datums = CDR(datums)) {
+ if (NFALSEP(ScmOp_eqvp(CAR(datums), key))) {
return ScmExp_begin(exps, &env, tail_flag);
}
}
@@ -1158,17 +1157,17 @@
ScmObj obj = SCM_NIL;
/* sanity check */
- if (SCM_NULLP(arg))
+ if (NULLP(arg))
return SCM_TRUE;
- if (SCM_FALSEP(ScmOp_listp(arg)))
+ if (FALSEP(ScmOp_listp(arg)))
SigScm_ErrorObj("and : list required but got ", arg);
/* check recursively */
- for (; !SCM_NULLP(arg); arg = SCM_CDR(arg)) {
- obj = SCM_CAR(arg);
+ for (; !NULLP(arg); arg = CDR(arg)) {
+ obj = CAR(arg);
/* return last item */
- if (SCM_NULLP(SCM_CDR(arg))) {
+ if (NULLP(CDR(arg))) {
/* set tail_flag */
(*tail_flag) = 1;
@@ -1177,7 +1176,7 @@
/* evaluate obj */
obj = ScmOp_eval(obj, env);
- if (SCM_FALSEP(obj)) {
+ if (FALSEP(obj)) {
/* set tail_flag */
(*tail_flag) = 0;
@@ -1194,17 +1193,17 @@
ScmObj obj = SCM_NIL;
/* sanity check */
- if (SCM_NULLP(arg))
+ if (NULLP(arg))
return SCM_FALSE;
- if (SCM_FALSEP(ScmOp_listp(arg)))
+ if (FALSEP(ScmOp_listp(arg)))
SigScm_ErrorObj("or : list required but got ", arg);
/* check recursively */
- for (; !SCM_NULLP(arg); arg = SCM_CDR(arg)) {
- obj = SCM_CAR(arg);
+ for (; !NULLP(arg); arg = CDR(arg)) {
+ obj = CAR(arg);
/* return last item */
- if (SCM_NULLP(SCM_CDR(arg))) {
+ if (NULLP(CDR(arg))) {
/* set tail_flag */
(*tail_flag) = 1;
@@ -1212,7 +1211,7 @@
}
obj = ScmOp_eval(obj, env);
- if (SCM_NFALSEP(obj)) {
+ if (NFALSEP(obj)) {
/* set tail_flag */
(*tail_flag) = 0;
@@ -1241,12 +1240,12 @@
SigScm_Error("let : syntax error\n");
/* guess whether syntax is "Named let" */
- if (SCM_SYMBOLP(SCM_CAR(arg)))
+ if (SYMBOLP(CAR(arg)))
goto named_let;
/* get bindings and body */
- bindings = SCM_CAR(arg);
- body = SCM_CDR(arg);
+ bindings = CAR(arg);
+ body = CDR(arg);
/*========================================================================
(let <bindings> <body>)
@@ -1254,14 +1253,14 @@
(<variable2> <init2>)
...)
========================================================================*/
- if (SCM_CONSP(bindings) || SCM_NULLP(bindings)) {
- for (; !SCM_NULLP(bindings); bindings = SCM_CDR(bindings)) {
- binding = SCM_CAR(bindings);
- if (SCM_NULLP(binding) || SCM_NULLP(SCM_CDR(binding)))
+ if (CONSP(bindings) || NULLP(bindings)) {
+ for (; !NULLP(bindings); bindings = CDR(bindings)) {
+ binding = CAR(bindings);
+ if (NULLP(binding) || NULLP(CDR(binding)))
SigScm_ErrorObj("let : invalid binding form : ", binding);
- vars = Scm_NewCons(SCM_CAR(binding), vars);
- vals = Scm_NewCons(ScmOp_eval(SCM_CAR(SCM_CDR(binding)), env), vals);
+ vars = Scm_NewCons(CAR(binding), vars);
+ vals = Scm_NewCons(ScmOp_eval(CAR(CDR(binding)), env), vals);
}
/* create new environment for */
@@ -1280,19 +1279,19 @@
(<variable2> <init2>)
...)
========================================================================*/
- bindings = SCM_CAR(SCM_CDR(arg));
- body = SCM_CDR(SCM_CDR(arg));
- for (; !SCM_NULLP(bindings); bindings = SCM_CDR(bindings)) {
- binding = SCM_CAR(bindings);
- vars = Scm_NewCons(SCM_CAR(binding), vars);
- vals = Scm_NewCons(SCM_CAR(SCM_CDR(binding)), vals);
+ bindings = CAR(CDR(arg));
+ body = CDR(CDR(arg));
+ for (; !NULLP(bindings); bindings = CDR(bindings)) {
+ binding = CAR(bindings);
+ vars = Scm_NewCons(CAR(binding), vars);
+ vals = Scm_NewCons(CAR(CDR(binding)), vals);
}
vars = ScmOp_reverse(vars);
vals = ScmOp_reverse(vals);
/* (define (<variable> <variable1> <variable2> ...>) <body>) */
- ScmExp_define(Scm_NewCons(Scm_NewCons(SCM_CAR(arg),
+ ScmExp_define(Scm_NewCons(Scm_NewCons(CAR(arg),
vars),
body),
&env, tail_flag);
@@ -1301,7 +1300,7 @@
(*tail_flag) = 1;
/* (func <init1> <init2> ...) */
- return Scm_NewCons(SCM_CAR(arg), vals);
+ return Scm_NewCons(CAR(arg), vals);
}
ScmObj ScmExp_let_star(ScmObj arg, ScmObj *envp, int *tail_flag)
@@ -1318,8 +1317,8 @@
SigScm_Error("let* : syntax error\n");
/* get bindings and body */
- bindings = SCM_CAR(arg);
- body = SCM_CDR(arg);
+ bindings = CAR(arg);
+ body = CDR(arg);
/*========================================================================
(let* <bindings> <body>)
@@ -1327,14 +1326,14 @@
(<variable2> <init2>)
...)
========================================================================*/
- if (SCM_CONSP(bindings)) {
- for (; !SCM_NULLP(bindings); bindings = SCM_CDR(bindings)) {
- binding = SCM_CAR(bindings);
- if (SCM_NULLP(binding) || SCM_NULLP(SCM_CDR(binding)))
+ if (CONSP(bindings)) {
+ for (; !NULLP(bindings); bindings = CDR(bindings)) {
+ binding = CAR(bindings);
+ if (NULLP(binding) || NULLP(CDR(binding)))
SigScm_ErrorObj("let* : invalid binding form : ", binding);
- vars = Scm_NewCons(SCM_CAR(binding), SCM_NIL);
- vals = Scm_NewCons(ScmOp_eval(SCM_CAR(SCM_CDR(binding)), env), SCM_NIL);
+ vars = Scm_NewCons(CAR(binding), SCM_NIL);
+ vals = Scm_NewCons(ScmOp_eval(CAR(CDR(binding)), env), SCM_NIL);
/* add env to each time!*/
env = extend_environment(vars, vals, env);
@@ -1343,7 +1342,7 @@
*envp = env;
/* evaluate */
return ScmExp_begin(body, &env, tail_flag);
- } else if (SCM_NULLP(bindings)) {
+ } else if (NULLP(bindings)) {
/* extend null environment */
env = extend_environment(SCM_NIL,
SCM_NIL,
@@ -1374,12 +1373,12 @@
ScmObj frame = SCM_NIL;
/* sanity check */
- if (SCM_NULLP(arg) || SCM_NULLP(SCM_CDR(arg)))
+ if (NULLP(arg) || NULLP(CDR(arg)))
SigScm_Error("letrec : syntax error\n");
/* get bindings and body */
- bindings = SCM_CAR(arg);
- body = SCM_CDR(arg);
+ bindings = CAR(arg);
+ body = CDR(arg);
/*========================================================================
(letrec <bindings> <body>)
@@ -1387,14 +1386,14 @@
(<variable2> <init2>)
...)
========================================================================*/
- if (SCM_CONSP(bindings) || SCM_NULLP(bindings)) {
- for (; !SCM_NULLP(bindings); bindings = SCM_CDR(bindings)) {
- binding = SCM_CAR(bindings);
- if (SCM_NULLP(binding) || SCM_NULLP(SCM_CDR(binding)))
+ if (CONSP(bindings) || NULLP(bindings)) {
+ for (; !NULLP(bindings); bindings = CDR(bindings)) {
+ binding = CAR(bindings);
+ if (NULLP(binding) || NULLP(CDR(binding)))
SigScm_ErrorObj("letrec : invalid binding form : ", binding);
- var = SCM_CAR(binding);
- val = SCM_CAR(SCM_CDR(binding));
+ var = CAR(binding);
+ val = CAR(CDR(binding));
/* construct vars and vals list */
vars = Scm_NewCons(var, vars);
@@ -1406,7 +1405,7 @@
letrec_env = Scm_NewCons(frame, letrec_env);
/* extend environment by letrec_env */
- env = extend_environment(SCM_CAR(frame), SCM_CDR(frame), env);
+ env = extend_environment(CAR(frame), CDR(frame), env);
/* ok, vars of letrec is extended to env */
letrec_env = SCM_NIL;
@@ -1415,8 +1414,8 @@
*envp = env;
/* evaluate vals */
- for (; !SCM_NULLP(vals); vals = SCM_CDR(vals)) {
- SCM_SETCAR(vals, ScmOp_eval(SCM_CAR(vals), env));
+ for (; !NULLP(vals); vals = CDR(vals)) {
+ SCM_SETCAR(vals, ScmOp_eval(CAR(vals), env));
}
/* evaluate body */
@@ -1443,17 +1442,17 @@
(*tail_flag) = 1;
/* sanity check */
- if (SCM_NULLP(arg))
+ if (NULLP(arg))
return SCM_UNDEF;
- if (SCM_FALSEP(ScmOp_listp(arg)))
+ if (FALSEP(ScmOp_listp(arg)))
SigScm_ErrorObj("begin : list required but got ", arg);
/* eval recursively */
- for (; !SCM_NULLP(arg); arg = SCM_CDR(arg)) {
- exp = SCM_CAR(arg);
+ for (; !NULLP(arg); arg = CDR(arg)) {
+ exp = CAR(arg);
/* return last expression's result */
- if (EQ(SCM_CDR(arg), SCM_NIL)) {
+ if (EQ(CDR(arg), SCM_NIL)) {
/* doesn't evaluate exp now for tail-recursion. */
return exp;
}
@@ -1484,7 +1483,7 @@
* <command> ...)
*/
ScmObj env = *envp;
- ScmObj bindings = SCM_CAR(arg);
+ ScmObj bindings = CAR(arg);
ScmObj vars = SCM_NIL;
ScmObj vals = SCM_NIL;
ScmObj steps = SCM_NIL;
@@ -1503,32 +1502,32 @@
SigScm_Error("do : syntax error\n");
/* construct Environment and steps */
- for (; !SCM_NULLP(bindings); bindings = SCM_CDR(bindings)) {
- binding = SCM_CAR(bindings);
- vars = Scm_NewCons(SCM_CAR(binding), vars);
- vals = Scm_NewCons(ScmOp_eval(SCM_CAR(SCM_CDR(binding)), env), vals);
+ for (; !NULLP(bindings); bindings = CDR(bindings)) {
+ binding = CAR(bindings);
+ vars = Scm_NewCons(CAR(binding), vars);
+ vals = Scm_NewCons(ScmOp_eval(CAR(CDR(binding)), env), vals);
/* append <step> to steps */
- step = SCM_CDR(SCM_CDR(binding));
- if (SCM_NULLP(step))
- steps = Scm_NewCons(SCM_CAR(binding), steps);
+ step = CDR(CDR(binding));
+ if (NULLP(step))
+ steps = Scm_NewCons(CAR(binding), steps);
else
- steps = Scm_NewCons(SCM_CAR(step), steps);
+ steps = Scm_NewCons(CAR(step), steps);
}
/* now extend environment */
env = extend_environment(vars, vals, env);
/* construct test */
- testframe = SCM_CAR(SCM_CDR(arg));
- test = SCM_CAR(testframe);
- expression = SCM_CDR(testframe);
+ testframe = CAR(CDR(arg));
+ test = CAR(testframe);
+ expression = CDR(testframe);
/* construct commands */
- commands = SCM_CDR(SCM_CDR(arg));
+ commands = CDR(CDR(arg));
/* now excution phase! */
- while (SCM_FALSEP(ScmOp_eval(test, env))) {
+ while (FALSEP(ScmOp_eval(test, env))) {
/* execute commands */
ScmOp_eval(ScmExp_begin(commands, &env, tail_flag), env);
@@ -1540,16 +1539,16 @@
* results to the "vals" variable and set it in hand.
*/
vals = SCM_NIL;
- for (tmp_steps = steps; !SCM_NULLP(tmp_steps); tmp_steps = SCM_CDR(tmp_steps)) {
- vals = Scm_NewCons(ScmOp_eval(SCM_CAR(tmp_steps), env), vals);
+ for (tmp_steps = steps; !NULLP(tmp_steps); tmp_steps = CDR(tmp_steps)) {
+ vals = Scm_NewCons(ScmOp_eval(CAR(tmp_steps), env), vals);
}
vals = ScmOp_reverse(vals);
/* set it */
- for (tmp_vars = vars; !SCM_NULLP(tmp_vars) && !SCM_NULLP(vals); tmp_vars = SCM_CDR(tmp_vars), vals = SCM_CDR(vals)) {
- obj = lookup_environment(SCM_CAR(tmp_vars), env);
- if (!SCM_NULLP(obj)) {
- SCM_SETCAR(obj, SCM_CAR(vals));
+ for (tmp_vars = vars; !NULLP(tmp_vars) && !NULLP(vals); tmp_vars = CDR(tmp_vars), vals = CDR(vals)) {
+ obj = lookup_environment(CAR(tmp_vars), env);
+ if (!NULLP(obj)) {
+ SCM_SETCAR(obj, CAR(vals));
} else {
SigScm_Error("do : broken env\n");
}
@@ -1575,8 +1574,8 @@
if (SCM_INT_VALUE(ScmOp_length(arg)) != 1)
SigScm_Error("delay : Wrong number of arguments\n");
- /* closure exp = ( () SCM_CAR(arg) ) */
- return Scm_NewClosure(Scm_NewCons(SCM_NIL, Scm_NewCons(SCM_CAR(arg), SCM_NIL)), env);
+ /* closure exp = ( () CAR(arg) ) */
+ return Scm_NewClosure(Scm_NewCons(SCM_NIL, Scm_NewCons(CAR(arg), SCM_NIL)), env);
}
/*===========================================================================
@@ -1587,7 +1586,7 @@
ScmObj ret;
if (!IS_LIST_LEN_1(obj))
SigScm_ErrorObj("quasiquote: bad argument list: ", obj);
- obj = SCM_CAR(obj);
+ obj = CAR(obj);
ret = qquote_internal(obj, *envp, 1);
*tail_flag = 0;
@@ -1598,7 +1597,7 @@
ScmObj ScmOp_unquote(ScmObj obj, ScmObj *envp, int *tail_flag)
{
- if (!SCM_CONSP(obj) || !SCM_NULLP(SCM_CDR(obj)))
+ if (!CONSP(obj) || !NULLP(CDR(obj)))
SigScm_ErrorObj("unquote: bad argument list: ", obj);
SigScm_Error("unquote outside quasiquote");
return SCM_NIL;
@@ -1606,7 +1605,7 @@
ScmObj ScmOp_unquote_splicing(ScmObj obj, ScmObj *envp, int *tail_flag)
{
- if (!SCM_CONSP(obj) || !SCM_NULLP(SCM_CDR(obj)))
+ if (!CONSP(obj) || !NULLP(CDR(obj)))
SigScm_ErrorObj("unquote-splicing: bad argument list: ", obj);
SigScm_Error("unquote-splicing outside quasiquote");
return SCM_NIL;
@@ -1619,8 +1618,8 @@
ScmObj ScmExp_define(ScmObj arg, ScmObj *envp, int *tail_flag)
{
ScmObj env = *envp;
- ScmObj var = SCM_CAR(arg);
- ScmObj body = SCM_CAR(SCM_CDR(arg));
+ ScmObj var = CAR(arg);
+ ScmObj body = CAR(CDR(arg));
ScmObj val = SCM_NIL;
ScmObj formals = SCM_NIL;
@@ -1628,14 +1627,14 @@
(*tail_flag) = 0;
/* sanity check */
- if (SCM_NULLP(var))
+ if (NULLP(var))
SigScm_ErrorObj("define : syntax error ", arg);
/*========================================================================
(define <variable> <expression>)
========================================================================*/
- if (SCM_SYMBOLP(var)) {
- if (SCM_NULLP(env)) {
+ if (SYMBOLP(var)) {
+ if (NULLP(env)) {
/* given NIL environment */
SCM_SETSYMBOL_VCELL(var, ScmOp_eval(body, env));
} else {
@@ -1661,10 +1660,10 @@
=> (define <variable>
(lambda <formals> <body>))
========================================================================*/
- if (SCM_CONSP(var)) {
- val = SCM_CAR(var);
- formals = SCM_CDR(var);
- body = SCM_CDR(arg);
+ if (CONSP(var)) {
+ val = CAR(var);
+ formals = CDR(var);
+ body = CDR(arg);
/* (val (lambda formals body)) */
arg = Scm_NewCons(val, Scm_NewCons(ScmExp_lambda(Scm_NewCons(formals, body), &env, tail_flag),
@@ -1698,8 +1697,8 @@
=======================================*/
ScmObj ScmOp_symbol_boundp(ScmObj obj)
{
- if (SCM_SYMBOLP(obj)
- && !SCM_EQ(SCM_SYMBOL_VCELL(obj), SCM_UNBOUND))
+ if (SYMBOLP(obj)
+ && !EQ(SCM_SYMBOL_VCELL(obj), SCM_UNBOUND))
{
return SCM_TRUE;
}
@@ -1709,7 +1708,7 @@
ScmObj ScmOp_symbol_value(ScmObj var)
{
- if (!SCM_SYMBOLP(var))
+ if (!SYMBOLP(var))
SigScm_ErrorObj("symbol-value : require symbol but got ", var);
return symbol_value(var, SCM_NIL);
@@ -1718,7 +1717,7 @@
ScmObj ScmOp_set_symbol_value(ScmObj var, ScmObj val)
{
/* sanity check */
- if (!SCM_SYMBOLP(var))
+ if (!SYMBOLP(var))
SigScm_ErrorObj("set-symbol-value! : require symbol but got ", var);
return SCM_SYMBOL_VCELL(var);
@@ -1726,9 +1725,9 @@
ScmObj ScmOp_bit_and(ScmObj obj1, ScmObj obj2)
{
- if (!SCM_INTP(obj1))
+ if (!INTP(obj1))
SigScm_ErrorObj("bit-and : number required but got ", obj1);
- if (!SCM_INTP(obj2))
+ if (!INTP(obj2))
SigScm_ErrorObj("bit-and : number required but got ", obj2);
return Scm_NewInt(SCM_INT_VALUE(obj1) & SCM_INT_VALUE(obj2));
@@ -1736,9 +1735,9 @@
ScmObj ScmOp_bit_or(ScmObj obj1, ScmObj obj2)
{
- if (!SCM_INTP(obj1))
+ if (!INTP(obj1))
SigScm_ErrorObj("bit-or : number required but got ", obj1);
- if (!SCM_INTP(obj2))
+ if (!INTP(obj2))
SigScm_ErrorObj("bit-or : number required but got ", obj2);
return Scm_NewInt(SCM_INT_VALUE(obj1) | SCM_INT_VALUE(obj2));
@@ -1746,9 +1745,9 @@
ScmObj ScmOp_bit_xor(ScmObj obj1, ScmObj obj2)
{
- if (!SCM_INTP(obj1))
+ if (!INTP(obj1))
SigScm_ErrorObj("bit-xor : number required but got ", obj1);
- if (!SCM_INTP(obj2))
+ if (!INTP(obj2))
SigScm_ErrorObj("bit-xor : number required but got ", obj2);
return Scm_NewInt(SCM_INT_VALUE(obj1) ^ SCM_INT_VALUE(obj2));
@@ -1756,7 +1755,7 @@
ScmObj ScmOp_bit_not(ScmObj obj)
{
- if (!SCM_INTP(obj))
+ if (!INTP(obj))
SigScm_ErrorObj("bit-not : number required but got ", obj);
return Scm_NewInt(~SCM_INT_VALUE(obj));
@@ -1769,7 +1768,7 @@
ScmObj ScmOp_closure_code(ScmObj closure)
{
- if (!SCM_CLOSUREP(closure))
+ if (!CLOSUREP(closure))
SigScm_ErrorObj("%%closure-code : closure required but got ", closure);
return SCM_CLOSURE_EXP(closure);
Modified: branches/r5rs/sigscheme/io.c
===================================================================
--- branches/r5rs/sigscheme/io.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/io.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -40,6 +40,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
@@ -87,9 +88,9 @@
ScmObj port = SCM_NIL;
ScmObj ret = SCM_NIL;
- if (!SCM_STRINGP(filepath))
+ if (!STRINGP(filepath))
SigScm_ErrorObj("call-with-input-file : string required but got", filepath);
- if (!SCM_FUNCP(proc) && !SCM_CLOSUREP(proc))
+ if (!FUNCP(proc) && !CLOSUREP(proc))
SigScm_ErrorObj("call-with-input-file : proc required but got ", proc);
/* open port */
@@ -112,9 +113,9 @@
ScmObj port = SCM_NIL;
ScmObj ret = SCM_NIL;
- if (!SCM_STRINGP(filepath))
+ if (!STRINGP(filepath))
SigScm_ErrorObj("call-with-output-file : string required but got ", filepath);
- if (!SCM_FUNCP(proc) && !SCM_CLOSUREP(proc))
+ if (!FUNCP(proc) && !CLOSUREP(proc))
SigScm_ErrorObj("call-with-output-file : proc required but got ", proc);
/* open port */
@@ -134,7 +135,7 @@
ScmObj ScmOp_input_portp(ScmObj obj)
{
- if (SCM_PORTP(obj) && SCM_PORT_PORTDIRECTION(obj) == PORT_INPUT)
+ if (PORTP(obj) && SCM_PORT_PORTDIRECTION(obj) == PORT_INPUT)
return SCM_TRUE;
return SCM_FALSE;
@@ -142,7 +143,7 @@
ScmObj ScmOp_output_portp(ScmObj obj)
{
- if (SCM_PORTP(obj) && SCM_PORT_PORTDIRECTION(obj) == PORT_OUTPUT)
+ if (PORTP(obj) && SCM_PORT_PORTDIRECTION(obj) == PORT_OUTPUT)
return SCM_TRUE;
return SCM_FALSE;
@@ -163,9 +164,9 @@
ScmObj tmp_port = SCM_NIL;
ScmObj ret = SCM_NIL;
- if (!SCM_STRINGP(filepath))
+ if (!STRINGP(filepath))
SigScm_ErrorObj("with-input-from-file : string required but got ", filepath);
- if (!SCM_FUNCP(thunk) && !SCM_CLOSUREP(thunk))
+ if (!FUNCP(thunk) && !CLOSUREP(thunk))
SigScm_ErrorObj("with-input-from-file : proc required but got ", thunk);
/* set current_input_port */
@@ -192,9 +193,9 @@
ScmObj tmp_port = SCM_NIL;
ScmObj ret = SCM_NIL;
- if (!SCM_STRINGP(filepath))
+ if (!STRINGP(filepath))
SigScm_ErrorObj("with-output-to-file : string required but got ", filepath);
- if (!SCM_FUNCP(thunk) && !SCM_CLOSUREP(thunk))
+ if (!FUNCP(thunk) && !CLOSUREP(thunk))
SigScm_ErrorObj("with-output-to-file : proc required but got ", thunk);
/* set current_output_port */
@@ -220,7 +221,7 @@
{
FILE *f = NULL;
- if (!SCM_STRINGP(filepath))
+ if (!STRINGP(filepath))
SigScm_ErrorObj("open-input-file : string requred but got ", filepath);
/* Open File */
@@ -236,7 +237,7 @@
{
FILE *f = NULL;
- if (!SCM_STRINGP(filepath))
+ if (!STRINGP(filepath))
SigScm_ErrorObj("open-output-file : string requred but got ", filepath);
/* Open File */
@@ -250,7 +251,7 @@
ScmObj ScmOp_close_input_port(ScmObj port)
{
- if (!SCM_PORTP(port))
+ if (!PORTP(port))
SigScm_ErrorObj("close-input-port : port requred but got ", port);
if (SCM_PORTINFO_FILE(port))
@@ -261,7 +262,7 @@
ScmObj ScmOp_close_output_port(ScmObj port)
{
- if (!SCM_PORTP(port))
+ if (!PORTP(port))
SigScm_ErrorObj("close-output-port : port requred but got ", port);
if (SCM_PORTINFO_FILE(port))
@@ -276,12 +277,12 @@
ScmObj ScmOp_read(ScmObj arg, ScmObj env)
{
ScmObj port = SCM_NIL;
- if (SCM_NULLP(arg)) {
+ if (NULLP(arg)) {
/* (read) */
port = current_input_port;
- } else if (SCM_PORTP(SCM_CAR(arg))) {
+ } else if (PORTP(CAR(arg))) {
/* (read port) */
- port = SCM_CAR(arg);
+ port = CAR(arg);
} else {
SigScm_ErrorObj("read : invalid parameter", arg);
}
@@ -293,12 +294,12 @@
{
ScmObj port = SCM_NIL;
char *buf = NULL;
- if (SCM_NULLP(arg)) {
+ if (NULLP(arg)) {
/* (read-char) */
port = current_input_port;
- } else if (!SCM_NULLP(SCM_CDR(arg)) && SCM_PORTP(SCM_CAR(SCM_CDR(arg)))) {
+ } else if (!NULLP(CDR(arg)) && PORTP(CAR(CDR(arg)))) {
/* (read-char port) */
- port = SCM_CAR(SCM_CDR(arg));
+ port = CAR(CDR(arg));
} else {
SigScm_ErrorObj("read-char : invalid parameter", arg);
}
@@ -317,10 +318,7 @@
ScmObj ScmOp_eof_objectp(ScmObj obj)
{
- if(EQ(obj, SCM_EOF))
- return SCM_TRUE;
-
- return SCM_FALSE;
+ return (EOFP(obj)) ? SCM_TRUE : SCM_FALSE;
}
ScmObj ScmOp_char_readyp(ScmObj arg, ScmObj env)
@@ -340,13 +338,13 @@
SigScm_Error("write : invalid parameter\n");
/* get obj */
- obj = SCM_CAR(arg);
- arg = SCM_CDR(arg);
+ obj = CAR(arg);
+ arg = CDR(arg);
/* get port */
port = current_output_port;
- if (!SCM_NULLP(arg) && !SCM_NULLP(SCM_CAR(arg)) && SCM_PORTP(SCM_CAR(arg)))
- port = SCM_CAR(arg);
+ if (!NULLP(arg) && !NULLP(CAR(arg)) && PORTP(CAR(arg)))
+ port = CAR(arg);
SigScm_WriteToPort(port, obj);
return SCM_UNDEF;
@@ -361,15 +359,15 @@
SigScm_Error("display : invalid parameter\n");
/* get obj */
- obj = SCM_CAR(arg);
- arg = SCM_CDR(arg);
+ obj = CAR(arg);
+ arg = CDR(arg);
/* get port */
port = current_output_port;
/* (display obj port) */
- if (!SCM_NULLP(arg) && SCM_PORTP(SCM_CAR(arg)))
- port = SCM_CAR(arg);
+ if (!NULLP(arg) && PORTP(CAR(arg)))
+ port = CAR(arg);
SigScm_DisplayToPort(port, obj);
return SCM_UNDEF;
@@ -385,15 +383,15 @@
SigScm_Error("print : invalid parameter\n");
/* get obj */
- obj = SCM_CAR(arg);
- arg = SCM_CDR(arg);
+ obj = CAR(arg);
+ arg = CDR(arg);
/* get port */
port = current_output_port;
/* (display obj port) */
- if (!SCM_NULLP(arg) && SCM_PORTP(SCM_CAR(arg)))
- port = SCM_CAR(arg);
+ if (!NULLP(arg) && PORTP(CAR(arg)))
+ port = CAR(arg);
SigScm_DisplayToPort(port, obj);
SigScm_DisplayToPort(port, Scm_NewStringCopying("\n"));
@@ -408,8 +406,8 @@
ScmObj port = current_output_port;
/* (newline port) */
- if (!SCM_NULLP(arg) && !SCM_NULLP(SCM_CAR(arg)) && SCM_PORTP(SCM_CAR(arg))) {
- port = SCM_CAR(arg);
+ if (!NULLP(arg) && !NULLP(CAR(arg)) && PORTP(CAR(arg))) {
+ port = CAR(arg);
}
SigScm_DisplayToPort(port, Scm_NewStringCopying("\n"));
@@ -425,17 +423,17 @@
SigScm_Error("write-char : invalid parameter\n");
/* get obj */
- obj = SCM_CAR(arg);
- arg = SCM_CDR(arg);
- if (!SCM_CHARP(obj))
+ obj = CAR(arg);
+ arg = CDR(arg);
+ if (!CHARP(obj))
SigScm_ErrorObj("write-char : char required but got ", obj);
/* get port */
port = current_output_port;
/* (write-char obj port) */
- if (!SCM_NULLP(arg) && SCM_PORTP(SCM_CAR(arg)))
- port = SCM_CAR(arg);
+ if (!NULLP(arg) && PORTP(CAR(arg)))
+ port = CAR(arg);
SigScm_DisplayToPort(port, obj);
return SCM_UNDEF;
@@ -469,7 +467,7 @@
/* read & eval cycle */
for (s_expression = SigScm_Read(port);
- !EQ(s_expression, SCM_EOF);
+ !EOFP(s_expression);
s_expression = SigScm_Read(port))
{
ScmOp_eval(s_expression, SCM_NIL);
@@ -541,7 +539,7 @@
ScmObj stack_start;
ScmObj loaded_str = SCM_NIL;
- if (!SCM_STRINGP(filename))
+ if (!STRINGP(filename))
SigScm_ErrorObj("require : string required but got ", filename);
/* start protecting stack */
@@ -550,7 +548,7 @@
/* construct loaded_str */
loaded_str = create_loaded_str(filename);
- if (SCM_FALSEP(ScmOp_member(loaded_str, SCM_SYMBOL_VCELL(SigScm_features)))) {
+ if (FALSEP(ScmOp_member(loaded_str, SCM_SYMBOL_VCELL(SigScm_features)))) {
/* not provided, so load it! */
ScmOp_load(filename);
@@ -579,7 +577,7 @@
ScmObj ScmOp_provide(ScmObj feature)
{
- if (!SCM_STRINGP(feature))
+ if (!STRINGP(feature))
SigScm_ErrorObj("provide : string required but got ", feature);
/* record to SigScm_features */
@@ -590,15 +588,15 @@
ScmObj ScmOp_providedp(ScmObj feature)
{
- if (!SCM_STRINGP(feature))
+ if (!STRINGP(feature))
SigScm_ErrorObj("provide : string required but got ", feature);
- return (SCM_FALSEP(ScmOp_member(feature, SigScm_features))) ? SCM_FALSE : SCM_TRUE;
+ return (FALSEP(ScmOp_member(feature, SigScm_features))) ? SCM_FALSE : SCM_TRUE;
}
ScmObj ScmOp_file_existsp(ScmObj filepath)
{
- if (!SCM_STRINGP(filepath))
+ if (!STRINGP(filepath))
SigScm_ErrorObj("file-exists? : string requred but got ", filepath);
return (file_existsp(SCM_STRING_STR(filepath))) ? SCM_TRUE : SCM_FALSE;
@@ -606,7 +604,7 @@
ScmObj ScmOp_delete_file(ScmObj filepath)
{
- if (!SCM_STRINGP(filepath))
+ if (!STRINGP(filepath))
SigScm_ErrorObj("delete-file : string requred but got ", filepath);
if (remove(SCM_STRING_STR(filepath)) == -1)
Modified: branches/r5rs/sigscheme/main.c
===================================================================
--- branches/r5rs/sigscheme/main.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/main.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -40,6 +40,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
@@ -72,7 +73,7 @@
printf("sscm> ");
for( s_exp = SigScm_Read(stdin_port);
- !EQ(s_exp, SCM_EOF);
+ !EOFP(s_exp);
s_exp = SigScm_Read(stdin_port))
{
result = ScmOp_eval(s_exp, SCM_NIL);
Modified: branches/r5rs/sigscheme/operations-srfi1.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi1.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/operations-srfi1.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -57,13 +57,13 @@
=======================================*/
static ScmObj list_gettailcons(ScmObj head)
{
- if (SCM_NULLP(head))
+ if (NULLP(head))
return SCM_NIL;
- if (SCM_NULLP(SCM_CDR(head)))
+ if (NULLP(CDR(head)))
return head;
- for (; !SCM_NULLP(head); head = SCM_CDR(head)) {
- if (SCM_NULLP(SCM_CDR(head)))
+ for (; !NULLP(head); head = CDR(head)) {
+ if (NULLP(CDR(head)))
return head;
}
@@ -87,13 +87,13 @@
ScmObj tail_cons = SCM_NIL;
ScmObj prev_tail = obj;
- if (SCM_NULLP(SCM_CDR(obj)))
- return SCM_CAR(obj);
+ if (NULLP(CDR(obj)))
+ return CAR(obj);
- for (tail_cons = SCM_CDR(obj); !SCM_NULLP(tail_cons); tail_cons = SCM_CDR(tail_cons)) {
+ for (tail_cons = CDR(obj); !NULLP(tail_cons); tail_cons = CDR(tail_cons)) {
/* check tail cons cell */
- if (SCM_NULLP(SCM_CDR(tail_cons))) {
- SCM_SETCDR(prev_tail, SCM_CAR(tail_cons));
+ if (NULLP(CDR(tail_cons))) {
+ SCM_SETCDR(prev_tail, CAR(tail_cons));
}
prev_tail = tail_cons;
@@ -112,19 +112,19 @@
/* sanity check */
if CHECK_1_ARG(args)
SigScm_Error("make-llist : require at least 1 arg\n");
- if (SCM_FALSEP(ScmOp_numberp(SCM_CAR(args))))
- SigScm_ErrorObj("make-list : number required but got ", SCM_CAR(args));
+ if (FALSEP(ScmOp_numberp(CAR(args))))
+ SigScm_ErrorObj("make-list : number required but got ", CAR(args));
/* get n */
- n = SCM_INT_VALUE(SCM_CAR(args));
+ n = SCM_INT_VALUE(CAR(args));
/* get filler if available */
- if (!SCM_NULLP(SCM_CDR(args)))
- fill = SCM_CAR(SCM_CDR(args));
+ if (!NULLP(CDR(args)))
+ fill = CAR(CDR(args));
/* then create list */
for (i = n; 0 < i; i--) {
- if (!SCM_NULLP(fill))
+ if (!NULLP(fill))
head = Scm_NewCons(fill, head);
else
head = Scm_NewCons(Scm_NewInt(i), head);
@@ -135,7 +135,7 @@
ScmObj ScmOp_SRFI1_list_tabulate(ScmObj args, ScmObj env)
{
- ScmObj scm_n = SCM_CAR(args);
+ ScmObj scm_n = CAR(args);
ScmObj proc = SCM_NIL;
ScmObj head = SCM_NIL;
ScmObj num = SCM_NIL;
@@ -143,21 +143,21 @@
int i = 0;
/* sanity check */
- if (SCM_FALSEP(ScmOp_numberp(scm_n)))
+ if (FALSEP(ScmOp_numberp(scm_n)))
SigScm_ErrorObj("list-tabulate : number required but got ", scm_n);
/* get n */
n = SCM_INT_VALUE(scm_n);
/* get init_proc if available */
- if (!SCM_NULLP(SCM_CDR(args)))
- proc = SCM_CAR(SCM_CDR(args));
+ if (!NULLP(CDR(args)))
+ proc = CAR(CDR(args));
/* then create list */
for (i = n; 0 < i; i--) {
num = Scm_NewInt(i - 1);
- if (!SCM_NULLP(proc)) {
+ if (!NULLP(proc)) {
/* evaluate (proc num) */
num = ScmOp_eval(Scm_NewCons(proc,
Scm_NewCons(num, SCM_NIL)),
@@ -176,19 +176,19 @@
ScmObj tail = SCM_NIL;
ScmObj obj = SCM_NIL;
- if (SCM_FALSEP(ScmOp_listp(list)))
+ if (FALSEP(ScmOp_listp(list)))
SigScm_ErrorObj("list-copy : list required but got ", list);
- for (; !SCM_NULLP(list); list = SCM_CDR(list)) {
- obj = SCM_CAR(list);
+ for (; !NULLP(list); list = CDR(list)) {
+ obj = CAR(list);
/* further copy */
- if (SCM_CONSP(obj))
+ if (CONSP(obj))
obj = ScmOp_SRFI1_list_copy(obj);
/* then create new cons */
obj = Scm_NewCons(obj, SCM_NIL);
- if (!SCM_NULLP(tail)) {
+ if (!NULLP(tail)) {
SCM_SETCDR(tail, obj);
tail = obj;
} else {
@@ -204,7 +204,7 @@
{
ScmObj tailcons = SCM_NIL;
- if (SCM_FALSEP(ScmOp_listp(list)))
+ if (FALSEP(ScmOp_listp(list)))
SigScm_ErrorObj("circular-list : list required but got ", list);
tailcons = list_gettailcons(list);
@@ -229,28 +229,28 @@
SigScm_Error("iota : required at least 1 arg\n");
/* get params */
- scm_count = SCM_CAR(args);
+ scm_count = CAR(args);
- if (!SCM_NULLP(SCM_CDR(args)))
- scm_start = SCM_CAR(SCM_CDR(args));
+ if (!NULLP(CDR(args)))
+ scm_start = CAR(CDR(args));
- if (!SCM_NULLP(scm_start) && !SCM_NULLP(SCM_CDR(SCM_CDR(args))))
- scm_step = SCM_CAR(SCM_CDR(SCM_CDR(args)));
+ if (!NULLP(scm_start) && !NULLP(CDR(CDR(args))))
+ scm_step = CAR(CDR(CDR(args)));
/* param type check */
- if (SCM_FALSEP(ScmOp_numberp(scm_count)))
+ if (FALSEP(ScmOp_numberp(scm_count)))
SigScm_ErrorObj("iota : number required but got ", scm_count);
- if (!SCM_NULLP(scm_start) && SCM_FALSEP(ScmOp_numberp(scm_start)))
+ if (!NULLP(scm_start) && FALSEP(ScmOp_numberp(scm_start)))
SigScm_ErrorObj("iota : number required but got ", scm_start);
- if (!SCM_NULLP(scm_step) && SCM_FALSEP(ScmOp_numberp(scm_step)))
+ if (!NULLP(scm_step) && FALSEP(ScmOp_numberp(scm_step)))
SigScm_ErrorObj("iota : number required but got ", scm_step);
/* now create list */
count = SCM_INT_VALUE(scm_count);
- start = SCM_NULLP(scm_start) ? 0 : SCM_INT_VALUE(scm_start);
- step = SCM_NULLP(scm_step) ? 1 : SCM_INT_VALUE(scm_step);
+ start = NULLP(scm_start) ? 0 : SCM_INT_VALUE(scm_start);
+ step = NULLP(scm_step) ? 1 : SCM_INT_VALUE(scm_step);
for (i = count - 1; 0 <= i; i--) {
head = Scm_NewCons(Scm_NewInt(start + i*step), head);
}
Modified: branches/r5rs/sigscheme/operations-srfi8.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi8.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/operations-srfi8.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -90,7 +90,7 @@
* document contradicts itself on this part. */
actuals = ScmOp_eval(expr, env);
- if (SCM_VALUEPACKETP(actuals))
+ if (VALUEPACKETP(actuals))
actuals = SCM_VALUEPACKET_VALUES(actuals);
else
actuals = Scm_NewCons(actuals, SCM_NIL);
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/operations.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -42,6 +42,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
@@ -73,7 +74,7 @@
{
enum ScmObjType type;
- if (SCM_EQ(obj1, obj2))
+ if (EQ(obj1, obj2))
return SCM_TRUE;
type = (enum ScmObjType)SCM_TYPE(obj1);
@@ -91,7 +92,7 @@
case ScmChar:
/* chars and are the same character according to the char=? */
- if (SCM_NFALSEP(ScmOp_char_equal(obj1, obj2))) return SCM_TRUE;
+ if (NFALSEP(ScmOp_char_equal(obj1, obj2))) return SCM_TRUE;
break;
case ScmSymbol: /* equivalent symbols must already be true on eq? */
@@ -120,7 +121,7 @@
ScmObj ScmOp_eqp(ScmObj obj1, ScmObj obj2)
{
- return (SCM_EQ(obj1, obj2)) ? SCM_TRUE : SCM_FALSE;
+ return (EQ(obj1, obj2)) ? SCM_TRUE : SCM_FALSE;
}
ScmObj ScmOp_equalp(ScmObj obj1, ScmObj obj2)
@@ -128,7 +129,7 @@
int i = 0;
enum ScmObjType type;
- if (SCM_EQ(obj1, obj2))
+ if (EQ(obj1, obj2))
return SCM_TRUE;
type = (enum ScmObjType)SCM_TYPE(obj1);
@@ -146,22 +147,22 @@
case ScmChar:
/* chars and are the same character according to the char=? */
- if (SCM_NFALSEP(ScmOp_char_equal(obj1, obj2))) return SCM_TRUE;
+ if (NFALSEP(ScmOp_char_equal(obj1, obj2))) return SCM_TRUE;
break;
case ScmCons:
- for (; !SCM_NULLP(obj1); obj1 = SCM_CDR(obj1), obj2 = SCM_CDR(obj2)) {
+ for (; !NULLP(obj1); obj1 = CDR(obj1), obj2 = CDR(obj2)) {
/* check contents */
- if (SCM_FALSEP(ScmOp_equalp(SCM_CAR(obj1), SCM_CAR(obj2))))
+ if (FALSEP(ScmOp_equalp(CAR(obj1), CAR(obj2))))
return SCM_FALSE;
/* check next cdr's type */
- if (SCM_TYPE(SCM_CDR(obj1)) != SCM_TYPE(SCM_CDR(obj2)))
+ if (SCM_TYPE(CDR(obj1)) != SCM_TYPE(CDR(obj2)))
return SCM_FALSE;
/* check dot pair */
- if (!SCM_CONSP(SCM_CDR(obj1))) {
- if (SCM_FALSEP(ScmOp_equalp(SCM_CDR(obj1), SCM_CDR(obj2))))
+ if (!CONSP(CDR(obj1))) {
+ if (FALSEP(ScmOp_equalp(CDR(obj1), CDR(obj2))))
return SCM_FALSE;
else
return SCM_TRUE;
@@ -176,7 +177,7 @@
/* check contents */
for (i = 0; i < SCM_VECTOR_LEN(obj1); i++) {
- if (SCM_FALSEP(ScmOp_equalp(SCM_VECTOR_CREF(obj1, i), SCM_VECTOR_CREF(obj2, i))))
+ if (FALSEP(ScmOp_equalp(SCM_VECTOR_CREF(obj1, i), SCM_VECTOR_CREF(obj2, i))))
return SCM_FALSE;
}
return SCM_TRUE;
@@ -244,9 +245,9 @@
ScmObj ls;
ScmObj operand;
- for (ls = args; !SCM_NULLP(ls); ls = SCM_CDR(ls)) {
- operand = SCM_CAR(ls);
- if (!SCM_INTP(operand))
+ for (ls = args; !NULLP(ls); ls = CDR(ls)) {
+ operand = CAR(ls);
+ if (!INTP(operand))
SigScm_ErrorObj("+ : integer required but got ", operand);
result += SCM_INT_VALUE(operand);
}
@@ -260,9 +261,9 @@
ScmObj operand;
ScmObj ls;
- for (ls=args; !SCM_NULLP(ls); ls = SCM_CDR(ls)) {
- operand = SCM_CAR(ls);
- if (!SCM_INTP(operand))
+ for (ls=args; !NULLP(ls); ls = CDR(ls)) {
+ operand = CAR(ls);
+ if (!INTP(operand))
SigScm_ErrorObj("* : integer required but got ", operand);
result *= SCM_INT_VALUE(operand);
}
@@ -277,19 +278,19 @@
ScmObj ls;
ls = args;
- if (SCM_NULLP(ls))
+ if (NULLP(ls))
SigScm_Error("- : at least 1 argument required");
- result = SCM_INT_VALUE(SCM_CAR(ls));
- ls = SCM_CDR(ls);
+ result = SCM_INT_VALUE(CAR(ls));
+ ls = CDR(ls);
/* single arg */
- if (SCM_NULLP(ls))
+ if (NULLP(ls))
return Scm_NewInt(-result);
- for (; !SCM_NULLP(ls); ls = SCM_CDR(ls)) {
- operand = SCM_CAR(ls);
- if (!SCM_INTP(operand))
+ for (; !NULLP(ls); ls = CDR(ls)) {
+ operand = CAR(ls);
+ if (!INTP(operand))
SigScm_ErrorObj("- : integer required but got ", operand);
result -= SCM_INT_VALUE(operand);
}
@@ -303,19 +304,19 @@
ScmObj operand;
ScmObj ls;
- if (SCM_NULLP(args))
+ if (NULLP(args))
SigScm_Error("/ : at least 1 argument required");
- result = SCM_INT_VALUE(SCM_CAR(args));
- ls = SCM_CDR(args);
+ result = SCM_INT_VALUE(CAR(args));
+ ls = CDR(args);
/* single arg */
- if (SCM_NULLP(ls))
+ if (NULLP(ls))
return Scm_NewInt(1 / result);
- for (; !SCM_NULLP(ls); ls = SCM_CDR(ls)) {
- operand = SCM_CAR(ls);
- if (!SCM_INTP(operand))
+ for (; !NULLP(ls); ls = CDR(ls)) {
+ operand = CAR(ls);
+ if (!INTP(operand))
SigScm_ErrorObj("/ : integer required but got ", operand);
if (SCM_INT_VALUE(operand) == 0)
@@ -328,7 +329,7 @@
ScmObj ScmOp_numberp(ScmObj obj)
{
- if (SCM_INTP(obj))
+ if (INTP(obj))
return SCM_TRUE;
return SCM_FALSE;
@@ -344,16 +345,16 @@
SigScm_Error("= : Wrong number of arguments\n");
/* type check */
- if (SCM_FALSEP(ScmOp_numberp(SCM_CAR(args))))
- SigScm_ErrorObj("= : number required but got ", SCM_CAR(args));
+ if (FALSEP(ScmOp_numberp(CAR(args))))
+ SigScm_ErrorObj("= : number required but got ", CAR(args));
/* Get first value */
- val = SCM_INT_VALUE(SCM_CAR(args));
+ val = SCM_INT_VALUE(CAR(args));
/* compare following value */
- for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
- obj = SCM_CAR(args);
- if (SCM_FALSEP(ScmOp_numberp(obj)))
+ for (args = CDR(args); !NULLP(args); args = CDR(args)) {
+ obj = CAR(args);
+ if (FALSEP(ScmOp_numberp(obj)))
SigScm_ErrorObj("= : number required but got ", obj);
if (SCM_INT_VALUE(obj) != val)
@@ -371,20 +372,20 @@
int car_val = 0;
ScmObj obj = SCM_NIL;
- if (SCM_NULLP(args) || SCM_NULLP(SCM_CDR(args)))
+ if (NULLP(args) || NULLP(CDR(args)))
SigScm_Error("< : Wrong number of arguments\n");
/* type check */
- if (SCM_FALSEP(ScmOp_numberp(SCM_CAR(args))))
- SigScm_ErrorObj("< : number required but got ", SCM_CAR(args));
+ if (FALSEP(ScmOp_numberp(CAR(args))))
+ SigScm_ErrorObj("< : number required but got ", CAR(args));
/* Get first value */
- val = SCM_INT_VALUE(SCM_CAR(args));
+ val = SCM_INT_VALUE(CAR(args));
/* compare following value */
- for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
- obj = SCM_CAR(args);
- if (SCM_FALSEP(ScmOp_numberp(obj)))
+ for (args = CDR(args); !NULLP(args); args = CDR(args)) {
+ obj = CAR(args);
+ if (FALSEP(ScmOp_numberp(obj)))
SigScm_ErrorObj("< : number required but got ", obj);
car_val = SCM_INT_VALUE(obj);
@@ -404,20 +405,20 @@
ScmObj obj = SCM_NIL;
/* type check */
- if (SCM_FALSEP(ScmOp_numberp(SCM_CAR(args))))
- SigScm_ErrorObj("> : number required but got ", SCM_CAR(args));
+ if (FALSEP(ScmOp_numberp(CAR(args))))
+ SigScm_ErrorObj("> : number required but got ", CAR(args));
/* arglen check */
if CHECK_2_ARGS(args)
SigScm_Error("> : Wrong number of arguments\n");
/* Get first value */
- val = SCM_INT_VALUE(SCM_CAR(args));
+ val = SCM_INT_VALUE(CAR(args));
/* compare following value */
- for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
- obj = SCM_CAR(args);
- if (SCM_FALSEP(ScmOp_numberp(obj)))
+ for (args = CDR(args); !NULLP(args); args = CDR(args)) {
+ obj = CAR(args);
+ if (FALSEP(ScmOp_numberp(obj)))
SigScm_ErrorObj("> : number required but got ", obj);
car_val = SCM_INT_VALUE(obj);
@@ -437,21 +438,21 @@
ScmObj obj = SCM_NIL;
/* type check */
- if (SCM_FALSEP(ScmOp_numberp(SCM_CAR(args))))
- SigScm_ErrorObj("<= : number required but got ", SCM_CAR(args));
+ if (FALSEP(ScmOp_numberp(CAR(args))))
+ SigScm_ErrorObj("<= : number required but got ", CAR(args));
/* arglen check */
if CHECK_2_ARGS(args)
SigScm_Error("<= : Wrong number of arguments\n");
/* Get first value */
- val = SCM_INT_VALUE(SCM_CAR(args));
+ val = SCM_INT_VALUE(CAR(args));
/* compare following value */
obj = SCM_NIL;
- for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
- obj = SCM_CAR(args);
- if (SCM_FALSEP(ScmOp_numberp(obj)))
+ for (args = CDR(args); !NULLP(args); args = CDR(args)) {
+ obj = CAR(args);
+ if (FALSEP(ScmOp_numberp(obj)))
SigScm_ErrorObj("<= : number required but got ", obj);
car_val = SCM_INT_VALUE(obj);
@@ -471,21 +472,21 @@
ScmObj obj = SCM_NIL;
/* type check */
- if (SCM_FALSEP(ScmOp_numberp(SCM_CAR(args))))
- SigScm_ErrorObj(">= : number required but got ", SCM_CAR(args));
+ if (FALSEP(ScmOp_numberp(CAR(args))))
+ SigScm_ErrorObj(">= : number required but got ", CAR(args));
/* arglen check */
if CHECK_2_ARGS(args)
SigScm_Error(">= : Wrong number of arguments\n");
/* Get first value */
- val = SCM_INT_VALUE(SCM_CAR(args));
+ val = SCM_INT_VALUE(CAR(args));
/* compare following value */
obj = SCM_NIL;
- for (args = SCM_CDR(args); !SCM_NULLP(args); args = SCM_CDR(args)) {
- obj = SCM_CAR(args);
- if (SCM_FALSEP(ScmOp_numberp(obj)))
+ for (args = CDR(args); !NULLP(args); args = CDR(args)) {
+ obj = CAR(args);
+ if (FALSEP(ScmOp_numberp(obj)))
SigScm_ErrorObj(">= : number required but got ", obj);
car_val = SCM_INT_VALUE(obj);
@@ -500,7 +501,7 @@
ScmObj ScmOp_zerop(ScmObj scm_num)
{
- if (SCM_FALSEP(ScmOp_numberp(scm_num)))
+ if (FALSEP(ScmOp_numberp(scm_num)))
SigScm_ErrorObj("zero? : number required but got ", scm_num);
return (SCM_INT_VALUE(scm_num) == 0) ? SCM_TRUE : SCM_FALSE;
@@ -508,7 +509,7 @@
ScmObj ScmOp_positivep(ScmObj scm_num)
{
- if (SCM_FALSEP(ScmOp_numberp(scm_num)))
+ if (FALSEP(ScmOp_numberp(scm_num)))
SigScm_ErrorObj("positive? : number required but got", scm_num);
return (SCM_INT_VALUE(scm_num) > 0) ? SCM_TRUE : SCM_FALSE;
@@ -516,7 +517,7 @@
ScmObj ScmOp_negativep(ScmObj scm_num)
{
- if (SCM_FALSEP(ScmOp_numberp(scm_num)))
+ if (FALSEP(ScmOp_numberp(scm_num)))
SigScm_ErrorObj("negative? : number required but got ", scm_num);
return (SCM_INT_VALUE(scm_num) < 0) ? SCM_TRUE : SCM_FALSE;
@@ -524,7 +525,7 @@
ScmObj ScmOp_oddp(ScmObj scm_num)
{
- if (SCM_FALSEP(ScmOp_numberp(scm_num)))
+ if (FALSEP(ScmOp_numberp(scm_num)))
SigScm_ErrorObj("odd? : number required but got ", scm_num);
return (SCM_INT_VALUE(scm_num) & 0x1) ? SCM_TRUE : SCM_FALSE;
@@ -532,7 +533,7 @@
ScmObj ScmOp_evenp(ScmObj scm_num)
{
- if (SCM_FALSEP(ScmOp_numberp(scm_num)))
+ if (FALSEP(ScmOp_numberp(scm_num)))
SigScm_ErrorObj("even? : number required but got ", scm_num);
return (SCM_INT_VALUE(scm_num) & 0x1) ? SCM_FALSE : SCM_TRUE;
@@ -545,12 +546,12 @@
ScmObj car = SCM_NIL;
ScmObj maxobj = SCM_NIL;
- if (SCM_NULLP(args))
+ if (NULLP(args))
SigScm_Error("max : at least 1 number required\n");
- for (; !SCM_NULLP(args); args = SCM_CDR(args)) {
- car = SCM_CAR(args);
- if (SCM_FALSEP(ScmOp_numberp(car)))
+ for (; !NULLP(args); args = CDR(args)) {
+ car = CAR(args);
+ if (FALSEP(ScmOp_numberp(car)))
SigScm_ErrorObj("max : number required but got ", car);
car_val = SCM_INT_VALUE(car);
@@ -570,12 +571,12 @@
ScmObj car = SCM_NIL;
ScmObj minobj = SCM_NIL;
- if (SCM_NULLP(args))
+ if (NULLP(args))
SigScm_Error("min : at least 1 number required\n");
- for (; !SCM_NULLP(args); args = SCM_CDR(args)) {
- car = SCM_CAR(args);
- if (SCM_FALSEP(ScmOp_numberp(car)))
+ for (; !NULLP(args); args = CDR(args)) {
+ car = CAR(args);
+ if (FALSEP(ScmOp_numberp(car)))
SigScm_ErrorObj("min : number required but got ", car);
car_val = SCM_INT_VALUE(car);
@@ -593,7 +594,7 @@
{
int num = 0;
- if (SCM_FALSEP(ScmOp_numberp(scm_num)))
+ if (FALSEP(ScmOp_numberp(scm_num)))
SigScm_ErrorObj("abs : number required but got ", scm_num);
num = SCM_INT_VALUE(scm_num);
@@ -606,11 +607,11 @@
int n1 = 0;
int n2 = 0;
- if (SCM_FALSEP(ScmOp_numberp(scm_n1)))
+ if (FALSEP(ScmOp_numberp(scm_n1)))
SigScm_ErrorObj("quotient : number required but got ", scm_n1);
- if (SCM_FALSEP(ScmOp_numberp(scm_n2)))
+ if (FALSEP(ScmOp_numberp(scm_n2)))
SigScm_ErrorObj("quotient : number required but got ", scm_n2);
- if (SCM_NFALSEP(ScmOp_zerop(scm_n2)))
+ if (NFALSEP(ScmOp_zerop(scm_n2)))
SigScm_Error("quotient : divide by zero\n");
n1 = SCM_INT_VALUE(scm_n1);
@@ -625,11 +626,11 @@
int n2 = 0;
int rem = 0;
- if (SCM_FALSEP(ScmOp_numberp(scm_n1)))
+ if (FALSEP(ScmOp_numberp(scm_n1)))
SigScm_ErrorObj("modulo : number required but got ", scm_n1);
- if (SCM_FALSEP(ScmOp_numberp(scm_n2)))
+ if (FALSEP(ScmOp_numberp(scm_n2)))
SigScm_ErrorObj("modulo : number required but got ", scm_n2);
- if (SCM_NFALSEP(ScmOp_zerop(scm_n2)))
+ if (NFALSEP(ScmOp_zerop(scm_n2)))
SigScm_Error("modulo : divide by zero\n");
n1 = SCM_INT_VALUE(scm_n1);
@@ -650,11 +651,11 @@
int n1 = 0;
int n2 = 0;
- if (SCM_FALSEP(ScmOp_numberp(scm_n1)))
+ if (FALSEP(ScmOp_numberp(scm_n1)))
SigScm_ErrorObj("remainder : number required but got ", scm_n1);
- if (SCM_FALSEP(ScmOp_numberp(scm_n2)))
+ if (FALSEP(ScmOp_numberp(scm_n2)))
SigScm_ErrorObj("remainder : number required but got ", scm_n2);
- if (SCM_NFALSEP(ScmOp_zerop(scm_n2)))
+ if (NFALSEP(ScmOp_zerop(scm_n2)))
SigScm_Error("remainder : divide by zero\n");
n1 = SCM_INT_VALUE(scm_n1);
@@ -676,22 +677,22 @@
if (CHECK_1_ARG(args))
SigScm_ErrorObj("number->string: requires 1 or 2 arguments: ", args);
- number = SCM_CAR(args);
- if (!SCM_INTP(number))
+ number = CAR(args);
+ if (!INTP(number))
SigScm_ErrorObj("number->string: integer required but got ", number);
n = SCM_INT_VALUE(number);
/* r = radix */
- if (SCM_NULLP(SCM_CDR(args)))
+ if (NULLP(CDR(args)))
r = 10;
else {
#ifdef SCM_STRICT_ARGCHECK
- if (!SCM_NULLP(SCM_CDDR(args)))
+ if (!NULLP(SCM_CDDR(args)))
SigScm_ErrorObj("number->string: too many arguments: ", args);
#endif
radix = SCM_CADR(args);
- if (!SCM_INTP(radix))
+ if (!INTP(radix))
SigScm_ErrorObj("number->string: integer required but got ", radix);
r = SCM_INT_VALUE(radix);
@@ -729,7 +730,7 @@
char *p = NULL;
size_t len = 0;
- if (!SCM_STRINGP(string))
+ if (!STRINGP(string))
SigScm_ErrorObj("string->number : string required but got ", string);
str = SCM_STRING_STR(string);
@@ -750,7 +751,7 @@
==============================================================================*/
ScmObj ScmOp_not(ScmObj obj)
{
- return (SCM_FALSEP(obj)) ? SCM_TRUE : SCM_FALSE;
+ return (FALSEP(obj)) ? SCM_TRUE : SCM_FALSE;
}
ScmObj ScmOp_booleanp(ScmObj obj)
@@ -771,16 +772,16 @@
*
*/
#if !SCM_COMPAT_SIOD_BUGS
- if (SCM_NULLP(obj))
+ if (NULLP(obj))
SigScm_Error("car : empty list\n");
#endif
- if (SCM_NULLP(obj))
+ if (NULLP(obj))
return SCM_NIL;
- if (!SCM_CONSP(obj))
+ if (!CONSP(obj))
SigScm_ErrorObj("car : list required but got ", obj);
- return SCM_CAR(obj);
+ return CAR(obj);
}
ScmObj ScmOp_cdr(ScmObj obj)
@@ -793,21 +794,21 @@
*
*/
#if !SCM_COMPAT_SIOD_BUGS
- if (SCM_NULLP(obj))
+ if (NULLP(obj))
SigScm_Error("cdr : empty list\n");
#endif
- if (SCM_NULLP(obj))
+ if (NULLP(obj))
return SCM_NIL;
- if (!SCM_CONSP(obj))
+ if (!CONSP(obj))
SigScm_ErrorObj("cdr : list required but got ", obj);
- return SCM_CDR(obj);
+ return CDR(obj);
}
ScmObj ScmOp_pairp(ScmObj obj)
{
- return (SCM_CONSP(obj)) ? SCM_TRUE : SCM_FALSE;
+ return (CONSP(obj)) ? SCM_TRUE : SCM_FALSE;
}
ScmObj ScmOp_cons(ScmObj car, ScmObj cdr)
@@ -817,7 +818,7 @@
ScmObj ScmOp_setcar(ScmObj pair, ScmObj car)
{
- if (SCM_CONSP(pair))
+ if (CONSP(pair))
SCM_SETCAR(pair, car);
else
SigScm_ErrorObj("set-car! : pair required but got ", pair);
@@ -827,7 +828,7 @@
ScmObj ScmOp_setcdr(ScmObj pair, ScmObj cdr)
{
- if (SCM_CONSP(pair))
+ if (CONSP(pair))
SCM_SETCDR(pair, cdr);
else
SigScm_ErrorObj("set-cdr! : pair required but got ", pair);
@@ -955,16 +956,16 @@
ScmObj ScmOp_nullp(ScmObj obj)
{
- return (SCM_NULLP(obj)) ? SCM_TRUE : SCM_FALSE;
+ return (NULLP(obj)) ? SCM_TRUE : SCM_FALSE;
}
ScmObj ScmOp_listp(ScmObj obj)
{
int len = 0;
- if (SCM_NULLP(obj))
+ if (NULLP(obj))
return SCM_TRUE;
- if (!SCM_CONSP(obj))
+ if (!CONSP(obj))
return SCM_FALSE;
len = ScmOp_c_length(obj);
@@ -983,18 +984,18 @@
int len = 0;
for (;;) {
- if (SCM_NULLP(obj)) break;
- if (!SCM_CONSP(obj)) return -1;
+ if (NULLP(obj)) break;
+ if (!CONSP(obj)) return -1;
if (len != 0 && obj == slow) return -1; /* circular */
- obj = SCM_CDR(obj);
+ obj = CDR(obj);
len++;
- if (SCM_NULLP(obj)) break;
- if (!SCM_CONSP(obj)) return -1;
+ if (NULLP(obj)) break;
+ if (!CONSP(obj)) return -1;
if (obj == slow) return -1; /* circular */
- obj = SCM_CDR(obj);
- slow = SCM_CDR(slow);
+ obj = CDR(obj);
+ slow = CDR(slow);
len++;
}
@@ -1014,23 +1015,23 @@
ScmObj ls;
ScmObj obj = SCM_NIL;
- if (SCM_NULLP(args))
+ if (NULLP(args))
return SCM_NIL;
/* duplicate and merge all but the last argument */
- for (; !SCM_NULLP(SCM_CDR(args)); args = SCM_CDR(args)) {
- for (ls = SCM_CAR(args); SCM_CONSP(ls); ls = SCM_CDR(ls)) {
- obj = SCM_CAR(ls);
+ for (; !NULLP(CDR(args)); args = CDR(args)) {
+ for (ls = CAR(args); CONSP(ls); ls = CDR(ls)) {
+ obj = CAR(ls);
*ret_tail = Scm_NewCons(obj, SCM_NIL);
- ret_tail = &SCM_CDR(*ret_tail);
+ ret_tail = &CDR(*ret_tail);
}
- if (!SCM_NULLP(ls))
+ if (!NULLP(ls))
SigScm_ErrorObj("append: proper list required but got: ",
- SCM_CAR(args));
+ CAR(args));
}
/* append the last argument */
- *ret_tail = SCM_CAR(args);
+ *ret_tail = CAR(args);
return ret_list;
}
@@ -1039,10 +1040,10 @@
{
ScmObj ret_list = SCM_NIL;
- for (; SCM_CONSP(list); list = SCM_CDR(list))
- ret_list = Scm_NewCons(SCM_CAR(list), ret_list);
+ for (; CONSP(list); list = CDR(list))
+ ret_list = Scm_NewCons(CAR(list), ret_list);
- if (!SCM_NULLP(list))
+ if (!NULLP(list))
SigScm_ErrorObj("reverse: got improper list: ", list);
return ret_list;
@@ -1051,9 +1052,9 @@
static ScmObj ScmOp_listtail_internal(ScmObj list, int k)
{
while (k--) {
- if (!SCM_CONSP(list))
+ if (!CONSP(list))
return SCM_INVALID;
- list = SCM_CDR(list);
+ list = CDR(list);
}
return list;
@@ -1063,7 +1064,7 @@
{
ScmObj ret;
- if (SCM_FALSEP(ScmOp_numberp(scm_k)))
+ if (FALSEP(ScmOp_numberp(scm_k)))
SigScm_ErrorObj("list-tail: number required but got ", scm_k);
ret = ScmOp_listtail_internal(list, SCM_INT_VALUE(scm_k));
@@ -1078,7 +1079,7 @@
{
ScmObj list_tail = SCM_NIL;
- if (SCM_FALSEP(ScmOp_numberp(scm_k)))
+ if (FALSEP(ScmOp_numberp(scm_k)))
SigScm_ErrorObj("list-ref : int required but got ", scm_k);
list_tail = ScmOp_listtail_internal(list, SCM_INT_VALUE(scm_k));
@@ -1086,14 +1087,14 @@
SigScm_ErrorObj("list-ref : out of range or bad list, arglist is: ",
Scm_NewCons(list, scm_k));
- return SCM_CAR(list_tail);
+ return CAR(list_tail);
}
ScmObj ScmOp_memq(ScmObj obj, ScmObj list)
{
ScmObj tmplist = SCM_NIL;
- for (tmplist = list; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
- if (EQ(obj, SCM_CAR(tmplist))) {
+ for (tmplist = list; CONSP(tmplist); tmplist = CDR(tmplist)) {
+ if (EQ(obj, CAR(tmplist))) {
return tmplist;
}
}
@@ -1105,9 +1106,9 @@
{
ScmObj tmplist = SCM_NIL;
ScmObj tmpobj = SCM_NIL;
- for (tmplist = list; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
- tmpobj = SCM_CAR(tmplist);
- if (SCM_NFALSEP(ScmOp_eqvp(obj, tmpobj))) {
+ for (tmplist = list; CONSP(tmplist); tmplist = CDR(tmplist)) {
+ tmpobj = CAR(tmplist);
+ if (NFALSEP(ScmOp_eqvp(obj, tmpobj))) {
return tmplist;
}
}
@@ -1119,9 +1120,9 @@
{
ScmObj tmplist = SCM_NIL;
ScmObj tmpobj = SCM_NIL;
- for (tmplist = list; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
- tmpobj = SCM_CAR(tmplist);
- if (SCM_NFALSEP(ScmOp_equalp(obj, tmpobj))) {
+ for (tmplist = list; CONSP(tmplist); tmplist = CDR(tmplist)) {
+ tmpobj = CAR(tmplist);
+ if (NFALSEP(ScmOp_equalp(obj, tmpobj))) {
return tmplist;
}
}
@@ -1135,16 +1136,16 @@
ScmObj tmpobj = SCM_NIL;
ScmObj car;
- for (tmplist = alist; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
- tmpobj = SCM_CAR(tmplist);
- car = SCM_CAR(tmpobj);
+ for (tmplist = alist; CONSP(tmplist); tmplist = CDR(tmplist)) {
+ tmpobj = CAR(tmplist);
+ car = CAR(tmpobj);
#if SCM_STRICT_R5RS
- if (!SCM_CONSP(tmpobj))
+ if (!CONSP(tmpobj))
SigScm_ErrorObj("assq: invalid alist: ", alist);
- if (EQ(SCM_CAR(tmpobj), obj))
+ if (EQ(CAR(tmpobj), obj))
return tmpobj;
#else
- if (SCM_CONSP(tmpobj) && EQ(SCM_CAR(tmpobj), obj))
+ if (CONSP(tmpobj) && EQ(CAR(tmpobj), obj))
return tmpobj;
#endif
}
@@ -1158,16 +1159,16 @@
ScmObj tmpobj = SCM_NIL;
ScmObj car;
- for (tmplist = alist; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
- tmpobj = SCM_CAR(tmplist);
- car = SCM_CAR(tmpobj);
+ for (tmplist = alist; CONSP(tmplist); tmplist = CDR(tmplist)) {
+ tmpobj = CAR(tmplist);
+ car = CAR(tmpobj);
#if SCM_STRICT_R5RS
- if (!SCM_CONSP(tmpobj))
+ if (!CONSP(tmpobj))
SigScm_ErrorObj("assv: invalid alist: ", alist);
- if (SCM_NFALSEP(ScmOp_eqvp(car, obj)))
+ if (NFALSEP(ScmOp_eqvp(car, obj)))
return tmpobj;
#else
- if (SCM_CONSP(tmpobj) && SCM_NFALSEP(ScmOp_eqvp(car, obj)))
+ if (CONSP(tmpobj) && NFALSEP(ScmOp_eqvp(car, obj)))
return tmpobj;
#endif
}
@@ -1181,16 +1182,16 @@
ScmObj tmpobj = SCM_NIL;
ScmObj car;
- for (tmplist = alist; SCM_CONSP(tmplist); tmplist = SCM_CDR(tmplist)) {
- tmpobj = SCM_CAR(tmplist);
- car = SCM_CAR(tmpobj);
+ for (tmplist = alist; CONSP(tmplist); tmplist = CDR(tmplist)) {
+ tmpobj = CAR(tmplist);
+ car = CAR(tmpobj);
#if SCM_STRICT_R5RS
- if (!SCM_CONSP(tmpobj))
+ if (!CONSP(tmpobj))
SigScm_ErrorObj("assoc: invalid alist: ", alist);
- if (SCM_NFALSEP(ScmOp_equalp(car, obj)))
+ if (NFALSEP(ScmOp_equalp(car, obj)))
return tmpobj;
#else
- if (SCM_CONSP(tmpobj) && SCM_NFALSEP(ScmOp_equalp(car, obj)))
+ if (CONSP(tmpobj) && NFALSEP(ScmOp_equalp(car, obj)))
return tmpobj;
#endif
}
@@ -1204,12 +1205,12 @@
==============================================================================*/
ScmObj ScmOp_symbolp(ScmObj obj)
{
- return (SCM_SYMBOLP(obj)) ? SCM_TRUE : SCM_FALSE;
+ return (SYMBOLP(obj)) ? SCM_TRUE : SCM_FALSE;
}
ScmObj ScmOp_symbol2string(ScmObj obj)
{
- if (!SCM_SYMBOLP(obj))
+ if (!SYMBOLP(obj))
SigScm_ErrorObj("symbol->string: symbol required, but got ", obj);
return Scm_NewStringCopying(SCM_SYMBOL_NAME(obj));
@@ -1217,7 +1218,7 @@
ScmObj ScmOp_string2symbol(ScmObj str)
{
- if(!SCM_STRINGP(str))
+ if(!STRINGP(str))
SigScm_ErrorObj("string->symbol: string required, but got ", str);
return Scm_Intern(SCM_STRING_STR(str));
@@ -1228,14 +1229,14 @@
==============================================================================*/
ScmObj ScmOp_charp(ScmObj obj)
{
- return (SCM_CHARP(obj)) ? SCM_TRUE : SCM_FALSE;
+ return (CHARP(obj)) ? SCM_TRUE : SCM_FALSE;
}
ScmObj ScmOp_char_equal(ScmObj ch1, ScmObj ch2)
{
- if (!SCM_CHARP(ch1))
+ if (!CHARP(ch1))
SigScm_ErrorObj("char=? : char required but got ", ch1);
- if (!SCM_CHARP(ch2))
+ if (!CHARP(ch2))
SigScm_ErrorObj("char=? : char required but got ", ch2);
if (strcmp(SCM_CHAR_CH(ch1), SCM_CHAR_CH(ch2)) == 0)
@@ -1246,7 +1247,7 @@
ScmObj ScmOp_char_alphabeticp(ScmObj obj)
{
- if (!SCM_CHARP(obj))
+ if (!CHARP(obj))
SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
@@ -1262,7 +1263,7 @@
ScmObj ScmOp_char_numericp(ScmObj obj)
{
- if (!SCM_CHARP(obj))
+ if (!CHARP(obj))
SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
@@ -1278,7 +1279,7 @@
ScmObj ScmOp_char_whitespacep(ScmObj obj)
{
- if (!SCM_CHARP(obj))
+ if (!CHARP(obj))
SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
@@ -1294,7 +1295,7 @@
ScmObj ScmOp_char_upper_casep(ScmObj obj)
{
- if (!SCM_CHARP(obj))
+ if (!CHARP(obj))
SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
@@ -1310,7 +1311,7 @@
ScmObj ScmOp_char_lower_casep(ScmObj obj)
{
- if (!SCM_CHARP(obj))
+ if (!CHARP(obj))
SigScm_ErrorObj("char-alphabetic? : char required but got ", obj);
/* check multibyte */
@@ -1326,7 +1327,7 @@
ScmObj ScmOp_char_upcase(ScmObj obj)
{
- if (!SCM_CHARP(obj))
+ if (!CHARP(obj))
SigScm_ErrorObj("char-upcase : char required but got ", obj);
/* check multibyte */
@@ -1341,7 +1342,7 @@
ScmObj ScmOp_char_downcase(ScmObj obj)
{
- if (!SCM_CHARP(obj))
+ if (!CHARP(obj))
SigScm_ErrorObj("char-upcase : char required but got ", obj);
/* check multibyte */
@@ -1359,7 +1360,7 @@
==============================================================================*/
ScmObj ScmOp_stringp(ScmObj obj)
{
- return (SCM_STRINGP(obj)) ? SCM_TRUE : SCM_FALSE;
+ return (STRINGP(obj)) ? SCM_TRUE : SCM_FALSE;
}
ScmObj ScmOp_make_string(ScmObj arg, ScmObj env)
@@ -1373,13 +1374,13 @@
/* sanity check */
if (argc != 1 && argc != 2)
SigScm_Error("make-string : invalid use\n");
- if (!SCM_INTP(SCM_CAR(arg)))
- SigScm_ErrorObj("make-string : integer required but got ", SCM_CAR(arg));
- if (argc == 2 && !SCM_CHARP(SCM_CAR(SCM_CDR(arg))))
- SigScm_ErrorObj("make-string : character required but got ", SCM_CAR(SCM_CDR(arg)));
+ if (!INTP(CAR(arg)))
+ SigScm_ErrorObj("make-string : integer required but got ", CAR(arg));
+ if (argc == 2 && !CHARP(CAR(CDR(arg))))
+ SigScm_ErrorObj("make-string : character required but got ", CAR(CDR(arg)));
/* get length */
- len = SCM_INT_VALUE(SCM_CAR(arg));
+ len = SCM_INT_VALUE(CAR(arg));
if (len == 0)
return Scm_NewStringCopying("");
@@ -1392,7 +1393,7 @@
ch = Scm_NewChar(tmp);
} else {
/* also specify filler char */
- ch = SCM_CAR(SCM_CDR(arg));
+ ch = CAR(CDR(arg));
}
/* make string */
@@ -1411,7 +1412,7 @@
ScmObj ScmOp_string_length(ScmObj str)
{
- if (!SCM_STRINGP(str))
+ if (!STRINGP(str))
SigScm_ErrorObj("string-length : string required but got ", str);
return Scm_NewInt(SigScm_default_encoding_strlen(SCM_STRING_STR(str)));
@@ -1425,9 +1426,9 @@
const char *ch_start_ptr = NULL;
const char *ch_end_ptr = NULL;
- if (!SCM_STRINGP(str))
+ if (!STRINGP(str))
SigScm_ErrorObj("string-ref : string required but got ", str);
- if (!SCM_INTP(k))
+ if (!INTP(k))
SigScm_ErrorObj("string-ref : number required but got ", k);
/* get start_ptr and end_ptr */
@@ -1456,11 +1457,11 @@
const char *ch_start_ptr = NULL;
const char *ch_end_ptr = NULL;
- if (!SCM_STRINGP(str))
+ if (!STRINGP(str))
SigScm_ErrorObj("string-set! : string required but got ", str);
- if (!SCM_INTP(k))
+ if (!INTP(k))
SigScm_ErrorObj("string-set! : number required but got ", k);
- if (!SCM_CHARP(ch))
+ if (!CHARP(ch))
SigScm_ErrorObj("string-set! : character required but got ", ch);
/* get indexes */
@@ -1508,11 +1509,11 @@
const char *ch_start_ptr = NULL;
const char *ch_end_ptr = NULL;
- if (!SCM_STRINGP(str))
+ if (!STRINGP(str))
SigScm_ErrorObj("string-ref : string required but got ", str);
- if (!SCM_INTP(start))
+ if (!INTP(start))
SigScm_ErrorObj("string-ref : number required but got ", start);
- if (!SCM_INTP(end))
+ if (!INTP(end))
SigScm_ErrorObj("string-ref : number required but got ", end);
/* get start_ptr and end_ptr */
@@ -1546,13 +1547,13 @@
char *p = NULL;
/* sanity check */
- if (SCM_NULLP(arg))
+ if (NULLP(arg))
return Scm_NewStringCopying("");
/* count total size of the new string */
- for (strings = arg; !SCM_NULLP(strings); strings = SCM_CDR(strings)) {
- obj = SCM_CAR(strings);
- if (!SCM_STRINGP(obj))
+ for (strings = arg; !NULLP(strings); strings = CDR(strings)) {
+ obj = CAR(strings);
+ if (!STRINGP(obj))
SigScm_ErrorObj("string-append : list required but got ", obj);
total_size += strlen(SCM_STRING_STR(obj));
@@ -1564,8 +1565,8 @@
/* copy string by string */
p = new_str;
- for (strings = arg; !SCM_NULLP(strings); strings = SCM_CDR(strings)) {
- obj = SCM_CAR(strings);
+ for (strings = arg; !NULLP(strings); strings = CDR(strings)) {
+ obj = CAR(strings);
strcpy(p, SCM_STRING_STR(obj));
p += strlen(SCM_STRING_STR(obj));
@@ -1586,7 +1587,7 @@
const char *ch_end_ptr = NULL;
char *new_ch = NULL;
- if (!SCM_STRINGP(string))
+ if (!STRINGP(string))
SigScm_ErrorObj("string->list : string required but got ", string);
string_str = SCM_STRING_STR(string);
@@ -1622,16 +1623,16 @@
char *new_str = NULL;
char *p = NULL;
- if (SCM_FALSEP(ScmOp_listp(list)))
+ if (FALSEP(ScmOp_listp(list)))
SigScm_ErrorObj("list->string : list required but got ", list);
- if (SCM_NULLP(list))
+ if (NULLP(list))
return Scm_NewStringCopying("");
/* count total size of the string */
- for (chars = list; !SCM_NULLP(chars); chars = SCM_CDR(chars)) {
- obj = SCM_CAR(chars);
- if (!SCM_CHARP(obj))
+ for (chars = list; !NULLP(chars); chars = CDR(chars)) {
+ obj = CAR(chars);
+ if (!CHARP(obj))
SigScm_ErrorObj("list->string : char required but got ", obj);
total_size += strlen(SCM_CHAR_CH(obj));
@@ -1642,8 +1643,8 @@
/* copy char by char */
p = new_str;
- for (chars = list; !SCM_NULLP(chars); chars = SCM_CDR(chars)) {
- obj = SCM_CAR(chars);
+ for (chars = list; !NULLP(chars); chars = CDR(chars)) {
+ obj = CAR(chars);
strcpy(p, SCM_CHAR_CH(obj));
p += strlen(SCM_CHAR_CH(obj));
@@ -1654,7 +1655,7 @@
ScmObj ScmOp_string_copy(ScmObj string)
{
- if (!SCM_STRINGP(string))
+ if (!STRINGP(string))
SigScm_ErrorObj("string-copy : string required but got ", string);
return Scm_NewStringCopying(SCM_STRING_STR(string));
@@ -1668,9 +1669,9 @@
char *p = NULL;
int i = 0;
- if (!SCM_STRINGP(string))
+ if (!STRINGP(string))
SigScm_ErrorObj("string-fill! : string required but got ", string);
- if (!SCM_CHARP(ch))
+ if (!CHARP(ch))
SigScm_ErrorObj("string-fill! : character required but got ", ch);
/* create new str */
@@ -1694,18 +1695,18 @@
==============================================================================*/
ScmObj ScmOp_vectorp(ScmObj obj)
{
- return (SCM_VECTORP(obj)) ? SCM_TRUE : SCM_FALSE;
+ return (VECTORP(obj)) ? SCM_TRUE : SCM_FALSE;
}
ScmObj ScmOp_make_vector(ScmObj arg, ScmObj env )
{
ScmObj *vec = NULL;
- ScmObj scm_k = SCM_CAR(arg);
+ ScmObj scm_k = CAR(arg);
ScmObj fill = SCM_NIL;
int c_k = 0;
int i = 0;
- if (!SCM_INTP(scm_k))
+ if (!INTP(scm_k))
SigScm_ErrorObj("make-vector : integer required but got ", scm_k);
/* allocate vector */
@@ -1714,8 +1715,8 @@
/* fill vector */
fill = SCM_UNDEF;
- if (!SCM_NULLP(SCM_CDR(arg)) && !SCM_NULLP(SCM_CAR(SCM_CDR(arg))))
- fill = SCM_CAR(SCM_CDR(arg));
+ if (!NULLP(CDR(arg)) && !NULLP(CAR(CDR(arg))))
+ fill = CAR(CDR(arg));
for (i = 0; i < c_k; i++) {
vec[i] = fill;
@@ -1733,8 +1734,8 @@
/* set item */
int i = 0;
for (i = 0; i < c_len; i++) {
- vec[i] = SCM_CAR(arg);
- arg = SCM_CDR(arg);
+ vec[i] = CAR(arg);
+ arg = CDR(arg);
}
return Scm_NewVector(vec, c_len);
@@ -1742,7 +1743,7 @@
ScmObj ScmOp_vector_length(ScmObj vec)
{
- if (!SCM_VECTORP(vec))
+ if (!VECTORP(vec))
SigScm_ErrorObj("vector-length : vector required but got ", vec);
return Scm_NewInt(SCM_VECTOR_LEN(vec));
@@ -1750,9 +1751,9 @@
ScmObj ScmOp_vector_ref(ScmObj vec, ScmObj scm_k)
{
- if (!SCM_VECTORP(vec))
+ if (!VECTORP(vec))
SigScm_ErrorObj("vector-ref : vector required but got ", vec);
- if (!SCM_INTP(scm_k))
+ if (!INTP(scm_k))
SigScm_ErrorObj("vector-ref : number required but got ", scm_k);
return SCM_VECTOR_REF(vec, scm_k);
@@ -1760,9 +1761,9 @@
ScmObj ScmOp_vector_set(ScmObj vec, ScmObj scm_k, ScmObj obj)
{
- if (!SCM_VECTORP(vec))
+ if (!VECTORP(vec))
SigScm_ErrorObj("vector-set! : vector required but got ", vec);
- if (!SCM_INTP(scm_k))
+ if (!INTP(scm_k))
SigScm_ErrorObj("vector-set! : number required but got ", scm_k);
SCM_SETVECTOR_REF(vec, scm_k, obj);
@@ -1779,7 +1780,7 @@
int c_len = 0;
int i = 0;
- if (!SCM_VECTORP(vec))
+ if (!VECTORP(vec))
SigScm_ErrorObj("vector->list : vector required but got ", vec);
v = SCM_VECTOR_VEC(vec);
@@ -1810,15 +1811,15 @@
int i = 0;
/* TOOD : canbe optimized. scanning list many times */
- if (SCM_FALSEP(ScmOp_listp(list)))
+ if (FALSEP(ScmOp_listp(list)))
SigScm_ErrorObj("list->vector : list required but got ", list);
scm_len = ScmOp_length(list);
c_len = SCM_INT_VALUE(scm_len);
v = (ScmObj*)malloc(sizeof(ScmObj) * c_len);
for (i = 0; i < c_len; i++) {
- v[i] = SCM_CAR(list);
- list = SCM_CDR(list);
+ v[i] = CAR(list);
+ list = CDR(list);
}
return Scm_NewVector(v, c_len);
@@ -1829,7 +1830,7 @@
int c_len = 0;
int i = 0;
- if (!SCM_VECTORP(vec))
+ if (!VECTORP(vec))
SigScm_ErrorObj("vector->list : vector required but got ", vec);
c_len = SCM_VECTOR_LEN(vec);
@@ -1845,7 +1846,7 @@
=======================================*/
ScmObj ScmOp_procedurep(ScmObj obj)
{
- if (SCM_FUNCP(obj) || SCM_CLOSUREP(obj))
+ if (FUNCP(obj) || CLOSUREP(obj))
return SCM_TRUE;
return SCM_FALSE;
@@ -1854,7 +1855,7 @@
ScmObj ScmOp_map(ScmObj map_arg, ScmObj env)
{
int arg_len = SCM_INT_VALUE(ScmOp_length(map_arg));
- ScmObj proc = SCM_CAR(map_arg);
+ ScmObj proc = CAR(map_arg);
ScmObj args = SCM_NIL;
ScmObj ret = SCM_NIL;
ScmObj tmp = SCM_NIL;
@@ -1871,9 +1872,9 @@
/* 1proc and 1arg case */
if (arg_len == 2) {
/* apply func to each item */
- for (args = SCM_CAR(SCM_CDR(map_arg)); !SCM_NULLP(args); args = SCM_CDR(args)) {
+ for (args = CAR(CDR(map_arg)); !NULLP(args); args = CDR(args)) {
/* create proc's arg */
- tmp = SCM_CAR(args);
+ tmp = CAR(args);
/* create list for "apply" op */
tmp = Scm_NewCons(proc,
@@ -1886,7 +1887,7 @@
}
/* 1proc and many args case */
- arg_vector = ScmOp_list2vector(SCM_CDR(map_arg));
+ arg_vector = ScmOp_list2vector(CDR(map_arg));
vector_len = SCM_VECTOR_LEN(arg_vector);
while (1) {
/* create arg */
@@ -1894,13 +1895,13 @@
for (i = 0; i < vector_len; i++) {
tmp = SCM_VECTOR_CREF(arg_vector, i);
/* check if we can continue next loop */
- if (SCM_NULLP(tmp)) {
+ if (NULLP(tmp)) {
/* if next item is SCM_NIL, let's return! */
return ScmOp_reverse(ret);
}
- arg1 = Scm_NewCons(SCM_CAR(tmp), arg1);
- SCM_SETVECTOR_CREF(arg_vector, i, SCM_CDR(tmp));
+ arg1 = Scm_NewCons(CAR(tmp), arg1);
+ SCM_SETVECTOR_CREF(arg_vector, i, CDR(tmp));
}
/* reverse arg */
@@ -1930,20 +1931,20 @@
{
if (SCM_INT_VALUE(ScmOp_length(arg)) != 1)
SigScm_Error("force : Wrong number of arguments\n");
- if (!SCM_CLOSUREP(SCM_CAR(arg)))
+ if (!CLOSUREP(CAR(arg)))
SigScm_Error("force : not proper delayed object\n");
- /* evaluated exp = ( SCM_CAR(arg) ) */
- return ScmOp_eval(Scm_NewCons(SCM_CAR(arg), SCM_NIL), env);
+ /* evaluated exp = ( CAR(arg) ) */
+ return ScmOp_eval(Scm_NewCons(CAR(arg), SCM_NIL), env);
}
ScmObj ScmOp_call_with_current_continuation(ScmObj arg, ScmObj env)
{
int jmpret = 0;
- ScmObj proc = SCM_CAR(arg);
+ ScmObj proc = CAR(arg);
ScmObj cont = SCM_NIL;
- if (!SCM_CLOSUREP(proc))
+ if (!CLOSUREP(proc))
SigScm_ErrorObj("call-with-current-continuation : closure required but got ", proc);
cont = Scm_NewContinuation();
@@ -1965,8 +1966,8 @@
{
/* Values with one arg must return something that fits an ordinary
* continuation. */
- if (SCM_CONSP(argl) && SCM_NULLP(SCM_CDR(argl)))
- return SCM_CAR(argl);
+ if (CONSP(argl) && NULLP(CDR(argl)))
+ return CAR(argl);
/* Otherwise, we'll return the values in a packet. */
return Scm_NewValuePacket(argl);
@@ -1982,10 +1983,10 @@
SigScm_ErrorObj("call-with-values: too few arguments: ", argl);
/* make the list (producer) and evaluate it */
- cons_wrapper = Scm_NewCons(SCM_CAR(argl), SCM_NIL);
+ cons_wrapper = Scm_NewCons(CAR(argl), SCM_NIL);
vals = ScmOp_eval(cons_wrapper, *envp);
- if (!SCM_VALUEPACKETP(vals)) {
+ if (!VALUEPACKETP(vals)) {
/* got back a single value */
vals = Scm_NewCons(vals, SCM_NIL);
} else {
@@ -1993,7 +1994,7 @@
vals = SCM_VALUEPACKET_VALUES(vals);
}
- *tail_flag = 1;
+ (*tail_flag) = 1;
/* cons_wrapper would have no chance of being referenced from
* anywhere else, so we'll reuse that object. */
@@ -2002,9 +2003,9 @@
return cons_wrapper;
}
-#if USE_SRFI1
+#if SCM_USE_SRFI1
#include "operations-srfi1.c"
#endif
-#if USE_SRFI8
+#if SCM_USE_SRFI8
#include "operations-srfi8.c"
#endif
Modified: branches/r5rs/sigscheme/read.c
===================================================================
--- branches/r5rs/sigscheme/read.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/read.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -43,6 +43,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
@@ -100,7 +101,7 @@
===========================================================================*/
ScmObj SigScm_Read(ScmObj port)
{
- if (!SCM_PORTP(port))
+ if (!PORTP(port))
SigScm_ErrorObj("SigScm_Read : port required but got ", port);
return read_sexpression(port);
@@ -108,7 +109,7 @@
ScmObj SigScm_Read_Char(ScmObj port)
{
- if (!SCM_PORTP(port))
+ if (!PORTP(port))
SigScm_ErrorObj("SigScm_Read_Char : port required but got ", port);
return read_char(port);
@@ -259,7 +260,7 @@
#endif
if (isspace(c2) || c2 == '(' || c2 == '"' || c2 == ';') {
cdr = read_sexpression(port);
- if (SCM_NULLP(list_tail))
+ if (NULLP(list_tail))
SigScm_Error(".(dot) at the start of the list.\n");
c = skip_comment_and_space(port);
@@ -289,14 +290,14 @@
}
/* Append item to the list_tail. */
- if (SCM_NULLP(list_tail)) {
+ if (NULLP(list_tail)) {
/* create new list */
list_head = Scm_NewCons(item, SCM_NIL);
list_tail = list_head;
} else {
/* update list_tail */
SCM_SETCDR(list_tail, Scm_NewCons(item, SCM_NIL));
- list_tail = SCM_CDR(list_tail);
+ list_tail = CDR(list_tail);
}
}
}
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-08-22 10:09:39 UTC (rev 1278)
@@ -39,6 +39,7 @@
Local Include
=======================================*/
#include "sigscheme.h"
+#include "sigschemeinternal.h"
/*=======================================
File Local Struct Declarations
@@ -299,19 +300,19 @@
current_error_port = Scm_NewFilePort(stderr, "stderr", PORT_OUTPUT);
SigScm_gc_protect(current_error_port);
-#if USE_SRFI1
+#if SCM_USE_SRFI1
/*=======================================================================
SRFI-1 Procedures
=======================================================================*/
- Scm_RegisterFunc2("xcons" , ScmOp_SRFI_1_xcons);
- Scm_RegisterFuncL("cons*" , ScmOp_SRFI_1_cons_star);
- Scm_RegisterFuncL("make-list" , ScmOp_SRFI_1_make_list);
- Scm_RegisterFuncL("list-tabulate" , ScmOp_SRFI_1_list_tabulate);
- Scm_RegisterFunc1("list-copy" , ScmOp_SRFI_1_list_copy);
- Scm_RegisterFuncL("circular-list" , ScmOp_SRFI_1_circular_list);
- Scm_RegisterFuncL("iota" , ScmOp_SRFI_1_iota);
+ Scm_RegisterFunc2("xcons" , ScmOp_SRFI1_xcons);
+ Scm_RegisterFuncL("cons*" , ScmOp_SRFI1_cons_star);
+ Scm_RegisterFuncL("make-list" , ScmOp_SRFI1_make_list);
+ Scm_RegisterFuncL("list-tabulate" , ScmOp_SRFI1_list_tabulate);
+ Scm_RegisterFunc1("list-copy" , ScmOp_SRFI1_list_copy);
+ Scm_RegisterFuncL("circular-list" , ScmOp_SRFI1_circular_list);
+ Scm_RegisterFuncL("iota" , ScmOp_SRFI1_iota);
#endif
-#if USE_SRFI8
+#if SCM_USE_SRFI8
/*=======================================================================
SRFI-8 Procedure
=======================================================================*/
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-08-22 10:09:39 UTC (rev 1278)
@@ -58,59 +58,21 @@
/* type declaration */
#include "sigschemetype.h"
-/* for debugging */
-struct trace_frame {
- struct trace_frame *prev;
- ScmObj obj;
-};
-
/*=======================================
Variable Declarations
=======================================*/
-/* datas.c */
-extern ScmObj *stack_start_pointer;
-/* error.c*/
-extern ScmObj current_error_port;
-
-/* eval.c */
-extern struct trace_frame *trace_root;
-
-/* io.c */
-extern ScmObj current_input_port;
-extern ScmObj current_output_port;
-extern ScmObj SigScm_features;
-
/*=======================================
Macro Declarations
=======================================*/
-#define DEBUG_PARSER 0
-#define DEBUG_GC 0
-#define USE_EUCJP 1
-#define USE_SRFI1 0
-#define USE_SRFI8 1
-#define SCM_USE_NONSTD_FEATURES 1
-#define SCM_COMPAT_SIOD 1
-#define SCM_COMPAT_SIOD_BUGS 1
-#define SCM_STRICT_R5RS 0
+#define SCM_USE_EUCJP 1 /* use EUC-JP as internal encoding */
+#define SCM_USE_SRFI1 0 /* use SRFI-1 procedures writtein in C */
+#define SCM_USE_SRFI8 1 /* use SRFI-8 receive procedure writtein in C */
+#define SCM_USE_NONSTD_FEATURES 1 /* use Non-R5RS standard features */
+#define SCM_COMPAT_SIOD 1 /* use SIOD compatible features */
+#define SCM_COMPAT_SIOD_BUGS 1 /* enable SIOD buggy features */
+#define SCM_STRICT_R5RS 0 /* use strict R5RS check */
-#define CHECK_1_ARG(arg) \
- (SCM_NULLP(arg))
-
-#define CHECK_2_ARGS(arg) \
- (SCM_NULLP(arg) || SCM_NULLP(SCM_CDR(arg)))
-
-#define CHECK_3_ARGS(arg) \
- (SCM_NULLP(arg) || SCM_NULLP(SCM_CDR(arg)) || SCM_NULLP(SCM_CDR(SCM_CDR(arg))))
-
-#define CHECK_4_ARGS(arg) \
- (SCM_NULLP(arg) || SCM_NULLP(SCM_CDR(arg)) || SCM_NULLP(SCM_CDR(SCM_CDR(arg))) \
- || SCM_NULLP(SCM_CDR(SCM_CDR(SCM_CDR(arg)))))
-
-#define CHECK_5_ARGS(arg) \
- (SCM_NULLP(arg) || SCM_NULLP(SCM_CDR(arg)) || SCM_NULLP(SCM_CDR(SCM_CDR(arg))) \
- || SCM_NULLP(SCM_CDR(SCM_CDR(SCM_CDR(arg)))) || SCM_NULLP(SCM_CDR(SCM_CDR(SCM_CDR(SCM_CDR(arg))))))
-
int SigScm_Die(const char *msg, const char *filename, int line); /* error.c */
#define sigassert(cond) \
(cond ? 0 : SigScm_Die("assertion failed.", __FILE__, __LINE__))
@@ -385,7 +347,7 @@
void SigScm_WriteToPort(ScmObj port, ScmObj obj);
void SigScm_DisplayToPort(ScmObj port, ScmObj obj);
-#if USE_SRFI1
+#if SCM_USE_SRFI1
ScmObj ScmOp_SRFI1_xcons(ScmObj a, ScmObj b);
ScmObj ScmOp_SRFI1_cons_star(ScmObj obj, ScmObj env);
ScmObj ScmOp_SRFI1_make_list(ScmObj obj, ScmObj env);
@@ -394,7 +356,7 @@
ScmObj ScmOp_SRFI1_circular_list(ScmObj list, ScmObj env);
ScmObj ScmOp_SRFI1_iota(ScmObj args, ScmObj env);
#endif
-#if USE_SRFI8
+#if SCM_USE_SRFI8
ScmObj ScmOp_SRFI_8_receive(ScmObj args, ScmObj *envp, int *tail_flag);
#endif
Added: branches/r5rs/sigscheme/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/sigschemeinternal.h 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/sigschemeinternal.h 2005-08-22 10:09:39 UTC (rev 1278)
@@ -0,0 +1,150 @@
+/*===========================================================================
+ * FileName : sigschemeinternal.h
+ * About : variable and function definitions for internal use
+ *
+ * Copyright (C) 2005 by Kazuki Ohta (mover at hct.zaq.ne.jp)
+ *
+ * All rights reserved.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions
+ * are met:
+ *
+ * 1. Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ * 2. Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ * 3. Neither the name of authors nor the names of its contributors
+ * may be used to endorse or promote products derived from this software
+ * without specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS ``AS IS''
+ * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+ * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+ * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE
+ * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
+ * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+ * GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+ * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+ * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+ * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+===========================================================================*/
+#ifndef __SIGSCHEMEINTERNAL_H
+#define __SIGSCHEMEINTERNAL_H
+
+/*=======================================
+ System Include
+=======================================*/
+#include "sigscheme.h"
+
+/*=======================================
+ Local Include
+=======================================*/
+
+/*=======================================
+ Struct Declarations
+=======================================*/
+/* for debugging */
+struct trace_frame {
+ struct trace_frame *prev;
+ ScmObj obj;
+};
+
+/*=======================================
+ Variable Declarations
+=======================================*/
+/* datas.c */
+extern ScmObj *stack_start_pointer;
+
+/* error.c*/
+extern ScmObj current_error_port;
+
+/* eval.c */
+extern struct trace_frame *trace_root;
+
+/* io.c */
+extern ScmObj current_input_port;
+extern ScmObj current_output_port;
+extern ScmObj current_error_port;
+extern ScmObj SigScm_features;
+
+/*=======================================
+ Macro Declarations
+=======================================*/
+/* Debugging Flags */
+#define DEBUG_PARSER 0
+#define DEBUG_GC 0
+
+/* FreeCell Handling Macros */
+#define SCM_FREECELLP(a) (SCM_TYPE(a) == ScmFreeCell)
+#define SCM_FREECELL(a) (sigassert(SCM_FREECELLP(a)), (a))
+#define SCM_FREECELL_CAR(a) (SCM_FREECELL(a)->obj.cons.car)
+#define SCM_FREECELL_CDR(a) (SCM_FREECELL(a)->obj.cons.cdr)
+#define SCM_SETFREECELL(a) (SCM_SETTYPE((a), ScmFreeCell))
+#define SCM_SETFREECELL_CAR(a,car) (SCM_FREECELL_CAR(a) = car)
+#define SCM_SETFREECELL_CDR(a,cdr) (SCM_FREECELL_CDR(a) = cdr)
+
+/* Internal Macros with no prefix */
+#define EQ SCM_EQ
+#define NEQ SCM_NEQ
+#define NULLP SCM_NULLP
+#define NNULLP SCM_NNULLP
+#define FALSEP SCM_FALSEP
+#define NFALSEP SCM_NFALSEP
+#define EOFP SCM_EOFP
+
+#define CAR SCM_CAR
+#define CDR SCM_CDR
+
+#define INTP SCM_INTP
+#define CONSP SCM_CONSP
+#define SYMBOLP SCM_SYMBOLP
+#define CHARP SCM_CHARP
+#define STRINGP SCM_STRINGP
+#define FUNCP SCM_FUNCP
+#define CLOSUREP SCM_CLOSUREP
+#define VECTORP SCM_VECTORP
+#define PORTP SCM_PORTP
+#define CONTINUATIONP SCM_CONTINUATIONP
+#define VALUEPACKETP SCM_VALUEPACKETP
+#define FREECELLP SCM_FREECELLP
+#define C_POINTERP SCM_C_POINTERP
+#define C_FUNCPOINTERP SCM_C_FUNCPOINTERP
+
+/*
+ * Abbrev name for these constants are not provided since it involves some
+ * consistency problems and confusions. Use the canonical names always.
+ *
+ * SCM_NULL
+ * SCM_TRUE
+ * SCM_FALSE
+ * SCM_EOF
+ * SCM_QUOTE
+ * SCM_QUASIQUOTE
+ * SCM_UNQUOTE
+ * SCM_UNQUOTE_SPLICING
+ * SCM_UNBOUND
+ * SCM_UNDEF
+ */
+
+/* Macros For Argnument Number Checking */
+#define CHECK_1_ARG(arg) \
+ (SCM_NULLP(arg))
+#define CHECK_2_ARGS(arg) \
+ (SCM_NULLP(arg) || SCM_NULLP(SCM_CDR(arg)))
+#define CHECK_3_ARGS(arg) \
+ (SCM_NULLP(arg) || SCM_NULLP(SCM_CDR(arg)) || SCM_NULLP(SCM_CDR(SCM_CDR(arg))))
+#define CHECK_4_ARGS(arg) \
+ (SCM_NULLP(arg) || SCM_NULLP(SCM_CDR(arg)) || SCM_NULLP(SCM_CDR(SCM_CDR(arg))) \
+ || SCM_NULLP(SCM_CDR(SCM_CDR(SCM_CDR(arg)))))
+#define CHECK_5_ARGS(arg) \
+ (SCM_NULLP(arg) || SCM_NULLP(SCM_CDR(arg)) || SCM_NULLP(SCM_CDR(SCM_CDR(arg))) \
+ || SCM_NULLP(SCM_CDR(SCM_CDR(SCM_CDR(arg)))) || SCM_NULLP(SCM_CDR(SCM_CDR(SCM_CDR(SCM_CDR(arg))))))
+
+/*=======================================
+ Function Declarations
+=======================================*/
+
+#endif /* __SIGSCHEMEINTERNAL_H */
Modified: branches/r5rs/sigscheme/sigschemetype.h
===================================================================
--- branches/r5rs/sigscheme/sigschemetype.h 2005-08-22 09:00:08 UTC (rev 1277)
+++ branches/r5rs/sigscheme/sigschemetype.h 2005-08-22 10:09:39 UTC (rev 1278)
@@ -244,14 +244,6 @@
#define SCM_SETCAR(a,car) (SCM_CAR(a) = car)
#define SCM_SETCDR(a,cdr) (SCM_CDR(a) = cdr)
-#define SCM_FREECELLP(a) (SCM_TYPE(a) == ScmFreeCell)
-#define SCM_FREECELL(a) (sigassert(SCM_FREECELLP(a)), (a))
-#define SCM_FREECELL_CAR(a) (SCM_FREECELL(a)->obj.cons.car)
-#define SCM_FREECELL_CDR(a) (SCM_FREECELL(a)->obj.cons.cdr)
-#define SCM_SETFREECELL(a) (SCM_SETTYPE((a), ScmFreeCell))
-#define SCM_SETFREECELL_CAR(a,car) (SCM_FREECELL_CAR(a) = car)
-#define SCM_SETFREECELL_CDR(a,cdr) (SCM_FREECELL_CDR(a) = cdr)
-
#define SCM_SYMBOLP(a) (SCM_TYPE(a) == ScmSymbol)
#define SCM_SYMBOL(a) (sigassert(SCM_SYMBOLP(a)), (a))
#define SCM_SYMBOL_NAME(a) (SCM_SYMBOL(a)->obj.symbol.sym_name)
@@ -386,14 +378,12 @@
#define SCM_UNBOUND SigScm_unbound
#define SCM_UNDEF SigScm_undef
-#define EQ(a, b) ((a) == (b))
-#define NEQ(a, b) !(EQ((a), (b)))
+#define SCM_EQ(a, b) ((a) == (b))
+#define SCM_NEQ(a, b) ((a) != (b))
+#define SCM_NULLP(a) (SCM_EQ((a), SCM_NIL))
+#define SCM_NNULLP(a) (SCM_NEQ((a), SCM_NIL))
+#define SCM_FALSEP(a) (SCM_EQ((a), SCM_FALSE))
+#define SCM_NFALSEP(a) (SCM_NEQ((a), SCM_FALSE))
+#define SCM_EOFP(a) (SCM_EQ((a), SCM_EOF))
-#define SCM_EQ(a, b) (EQ((a), (b)))
-#define SCM_NEQ(a, b) (NEQ((a), (b)))
-#define SCM_NULLP(a) (EQ((a), SCM_NIL))
-#define SCM_FALSEP(a) (EQ((a), SCM_FALSE))
-#define SCM_NFALSEP(a) (!EQ((a), SCM_FALSE))
-#define SCM_EOFP(a) (EQ((a), SCM_EOF))
-
#endif /* __SIGSCMTYPE_H */
More information about the uim-commit
mailing list