[uim-commit] r1672 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Wed Sep 28 09:49:50 PDT 2005
Author: kzk
Date: 2005-09-28 09:49:48 -0700 (Wed, 28 Sep 2005)
New Revision: 1672
Modified:
branches/r5rs/sigscheme/operations-srfi1.c
branches/r5rs/sigscheme/operations-srfi38.c
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
Log:
* simplify "append, "string-append", "circular-list", "iota", "cons*",
"make-list", "list-tabulate", "list=", "concatenate" and
"write-with-shared-structure" with new FUNCTYPE scheme
* sigscheme/sigscheme.h
- (ScmOp_append,
ScmOp_string_append,
ScmOp_SRFI1_cons_star,
ScmOp_SRFI1_make_list,
ScmOp_SRFI1_circular_list,
ScmOp_SRFI1_iota,
ScmOp_SRFI1_concatenate,
ScmOp_SRFI38_write_with_shared_structure): change args
* sigscheme/operations.c
- (ScmOp_append,
ScmOp_string_append): change args
* sigscheme/operations-srfi38.c
- (ScmOp_SRFI1_cons_star,
ScmOp_SRFI1_make_list,
ScmOp_SRFI1_circular_list,
ScmOp_SRFI1_iota,
ScmOp_SRFI1_concatenate): change args
* sigscheme/operations-srfi1.c
- (ScmOp_SRFI38_write_with_shared_structure): change args
* sigscheme/sigscheme.c
- "append": export by Scm_RegisterProcedureVariadic0
- "string-append": export by Scm_RegisterProcedureVariadic0
- "circular-list": export by Scm_RegisterProcedureVariadic0
- "iota": export by Scm_RegisterProcedureVariadic1
- "cons*": export by Scm_RegisterProcedureVariadic0
- "make-list": export by Scm_RegisterProcedureVariadic1
- "list-tabulate": export by Scm_RegisterProcedureVariadic1
- "concatenate": export by Scm_RegisterProcedureVariadic0
- "write-with-shared-structure": expor by
Scm_RegisterProcedureVariadic1
Modified: branches/r5rs/sigscheme/operations-srfi1.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi1.c 2005-09-28 16:14:27 UTC (rev 1671)
+++ branches/r5rs/sigscheme/operations-srfi1.c 2005-09-28 16:49:48 UTC (rev 1672)
@@ -55,7 +55,7 @@
/*=======================================
File Local Function Declarations
=======================================*/
-static ScmObj compare_list(ScmObj eqproc, ScmObj lst1, ScmObj lst2, ScmObj env);
+static ScmObj compare_list(ScmObj eqproc, ScmObj lst1, ScmObj lst2);
/*=======================================
Function Implementations
@@ -68,62 +68,58 @@
return CONS(b, a);
}
-ScmObj ScmOp_SRFI1_cons_star(ScmObj obj, ScmObj env)
+ScmObj ScmOp_SRFI1_cons_star(ScmObj args)
{
ScmObj tail_cons = SCM_NULL;
- ScmObj prev_tail = obj;
+ ScmObj prev_last = args;
- if (NULLP(CDR(obj)))
- return CAR(obj);
+ if (NULLP(CDR(args)))
+ return CAR(args);
- for (tail_cons = CDR(obj); !NULLP(tail_cons); tail_cons = CDR(tail_cons)) {
+ for (tail_cons = CDR(args); !NULLP(tail_cons); tail_cons = CDR(tail_cons)) {
/* check tail cons cell */
if (NULLP(CDR(tail_cons))) {
- SET_CDR(prev_tail, CAR(tail_cons));
+ SET_CDR(prev_last, CAR(tail_cons));
}
- prev_tail = tail_cons;
+ prev_last = tail_cons;
}
- return obj;
+ return args;
}
-ScmObj ScmOp_SRFI1_make_list(ScmObj args, ScmObj env)
+ScmObj ScmOp_SRFI1_make_list(ScmObj length, ScmObj args)
{
- ScmObj fill = SCM_NULL;
- ScmObj head = SCM_NULL;
- int n = 0;
- int i = 0;
+ ScmObj filler = SCM_FALSE;
+ ScmObj head = SCM_FALSE;
+ int len = 0;
+ int i = 0;
/* sanity check */
- if CHECK_1_ARG(args)
- SigScm_Error("make-llist : require at least 1 arg");
- if (FALSEP(ScmOp_numberp(CAR(args))))
- SigScm_ErrorObj("make-list : number required but got ", CAR(args));
+ if (FALSEP(ScmOp_numberp(length)))
+ SigScm_ErrorObj("make-list : number required but got ", CAR(length));
- /* get n */
- n = SCM_INT_VALUE(CAR(args));
+ len = SCM_INT_VALUE(length);
/* get filler if available */
- if (!NULLP(CDR(args)))
- fill = CADR(args);
+ if (!NULLP(args))
+ filler = CAR(args);
else
- fill = SCM_FALSE;
+ filler = SCM_FALSE;
/* then create list */
- for (i = n; 0 < i; i--) {
- head = CONS(fill, head);
+ for (i = len; 0 < i; i--) {
+ head = CONS(filler, head);
}
return head;
}
-ScmObj ScmOp_SRFI1_list_tabulate(ScmObj args, ScmObj env)
+ScmObj ScmOp_SRFI1_list_tabulate(ScmObj scm_n, ScmObj args)
{
- ScmObj scm_n = CAR(args);
- ScmObj proc = SCM_NULL;
+ ScmObj proc = SCM_FALSE;
ScmObj head = SCM_NULL;
- ScmObj num = SCM_NULL;
+ ScmObj num = SCM_FALSE;
int n = 0;
int i = 0;
@@ -135,19 +131,15 @@
n = SCM_INT_VALUE(scm_n);
/* get init_proc if available */
- if (!NULLP(CDR(args)))
- proc = CADR(args);
+ if (!NULLP(args))
+ proc = CAR(args);
/* then create list */
for (i = n; 0 < i; i--) {
num = Scm_NewInt(i - 1);
- if (!NULLP(proc)) {
- /* evaluate (proc num) */
- num = EVAL(CONS(proc,
- CONS(num, SCM_NULL)),
- env);
- }
+ if (!NULLP(proc))
+ num = Scm_call(proc, LIST_1(num));
head = CONS(num, head);
}
@@ -185,22 +177,21 @@
return head;
}
-ScmObj ScmOp_SRFI1_circular_list(ScmObj lst, ScmObj env)
+ScmObj ScmOp_SRFI1_circular_list(ScmObj args)
{
- ScmObj tailcons = SCM_NULL;
+ ScmObj lastcons = SCM_NULL;
- if (FALSEP(ScmOp_listp(lst)))
- SigScm_ErrorObj("circular-list : list required but got ", lst);
+ if (FALSEP(ScmOp_listp(args)))
+ SigScm_ErrorObj("circular-list : list required but got ", args);
- tailcons = ScmOp_SRFI1_last_pair(lst);
- SET_CDR(tailcons, lst);
+ lastcons = ScmOp_SRFI1_last_pair(args);
+ SET_CDR(lastcons, args);
- return lst;
+ return args;
}
-ScmObj ScmOp_SRFI1_iota(ScmObj args, ScmObj env)
+ScmObj ScmOp_SRFI1_iota(ScmObj scm_count, ScmObj args)
{
- ScmObj scm_count = SCM_NULL;
ScmObj scm_start = SCM_NULL;
ScmObj scm_step = SCM_NULL;
ScmObj head = SCM_NULL;
@@ -209,19 +200,13 @@
int step = 0;
int i = 0;
- /* sanity check */
- if CHECK_1_ARG(args)
- SigScm_Error("iota : required at least 1 arg");
-
/* get params */
- scm_count = CAR(args);
+ if (!NULLP(args))
+ scm_start = CAR(args);
- if (!NULLP(CDR(args)))
- scm_start = CADR(args);
+ if (!NULLP(scm_start) && !NULLP(CDR(args)))
+ scm_step = CAR(CDR(args));
- if (!NULLP(scm_start) && !NULLP(CDDR(args)))
- scm_step = CAR(CDDR(args));
-
/* param type check */
if (FALSEP(ScmOp_numberp(scm_count)))
SigScm_ErrorObj("iota : number required but got ", scm_count);
@@ -310,38 +295,30 @@
return NULLP(lst) ? SCM_TRUE : SCM_FALSE;
}
-ScmObj ScmOp_SRFI1_listequal(ScmObj args, ScmObj env)
+ScmObj ScmOp_SRFI1_listequal(ScmObj eqproc, ScmObj args)
{
- ScmObj eqproc = SCM_NULL;
- ScmObj lsts = SCM_NULL;
- ScmObj first_lst = SCM_NULL;
+ ScmObj first_lst = SCM_FALSE;
- if CHECK_1_ARG(args)
- SigScm_Error("list= : required at least 1 arg");
-
- eqproc = CAR(args);
- lsts = CDR(args);
-
- if (NULLP(lsts))
+ if (NULLP(args))
return SCM_TRUE;
- first_lst = CAR(lsts);
- lsts = CDR(lsts);
+ first_lst = CAR(args);
+ args = CDR(args);
- if (NULLP(lsts))
+ if (NULLP(args))
return SCM_TRUE;
- for (; !NULLP(lsts); lsts = CDR(lsts)) {
- if (FALSEP(compare_list(eqproc, first_lst, CAR(lsts), env)))
+ for (; !NULLP(args); args = CDR(args)) {
+ if (FALSEP(compare_list(eqproc, first_lst, CAR(args))))
return SCM_FALSE;
}
return SCM_TRUE;
}
-static ScmObj compare_list(ScmObj eqproc, ScmObj lst1, ScmObj lst2, ScmObj env)
+static ScmObj compare_list(ScmObj eqproc, ScmObj lst1, ScmObj lst2)
{
-#define CHECK_LIST_EQUALITY_WITH_EQPROC(eqproc, obj1, obj2, env) \
+#define CHECK_LIST_EQUALITY_WITH_EQPROC(eqproc, obj1, obj2) \
(Scm_call(eqproc, \
LIST_2(obj1, obj2)))
@@ -349,7 +326,7 @@
for (; !NULLP(lst1); lst1 = CDR(lst1), lst2 = CDR(lst2)) {
/* check contents */
- ret_cmp = CHECK_LIST_EQUALITY_WITH_EQPROC(eqproc, CAR(lst1), CAR(lst2), env);
+ ret_cmp = CHECK_LIST_EQUALITY_WITH_EQPROC(eqproc, CAR(lst1), CAR(lst2));
if (FALSEP(ret_cmp))
return SCM_FALSE;
@@ -359,7 +336,7 @@
/* check dot pair */
if (!CONSP(CDR(lst1))) {
- return CHECK_LIST_EQUALITY_WITH_EQPROC(eqproc, CDR(lst1), CDR(lst2), env);
+ return CHECK_LIST_EQUALITY_WITH_EQPROC(eqproc, CDR(lst1), CDR(lst2));
}
}
return SCM_TRUE;
@@ -599,10 +576,14 @@
return ScmOp_length(lst);
}
-ScmObj ScmOp_SRFI1_concatenate(ScmObj args, ScmObj env)
+ScmObj ScmOp_SRFI1_concatenate(ScmObj args)
{
ScmObj lsts_of_lst = CAR(args);
- return Scm_call(ScmOp_eval(Scm_Intern("append"), env),
- lsts_of_lst);
+#if SCM_STRICT_ARGCHECK
+ if (!NULLP(CDR(args)))
+ SigScm_ErrorObj("concatenate : superfluous arguments: ", args);
+#endif
+
+ return ScmOp_append(lsts_of_lst);
}
Modified: branches/r5rs/sigscheme/operations-srfi38.c
===================================================================
--- branches/r5rs/sigscheme/operations-srfi38.c 2005-09-28 16:14:27 UTC (rev 1671)
+++ branches/r5rs/sigscheme/operations-srfi38.c 2005-09-28 16:49:48 UTC (rev 1672)
@@ -63,23 +63,14 @@
/*=============================================================================
SRFI38 : External Representation for Data With Shared Structure
=============================================================================*/
-
-ScmObj ScmOp_SRFI38_write_with_shared_structure(ScmObj arg, ScmObj env)
+ScmObj ScmOp_SRFI38_write_with_shared_structure(ScmObj obj, ScmObj args)
{
- ScmObj obj = SCM_NULL;
- ScmObj port = SCM_NULL;
+ ScmObj port = scm_current_output_port;
- if CHECK_1_ARG(arg)
- SigScm_Error("write : invalid parameter");
-
- /* get obj */
- obj = CAR(arg);
- arg = CDR(arg);
-
/* get port */
port = scm_current_output_port;
- if (!NULLP(arg) && !NULLP(CAR(arg)) && PORTP(CAR(arg)))
- port = CAR(arg);
+ if (!NULLP(args) && PORTP(CAR(args)))
+ port = CAR(args);
SigScm_WriteToPortWithSharedStructure(port, obj);
return SCM_UNDEF;
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-09-28 16:14:27 UTC (rev 1671)
+++ branches/r5rs/sigscheme/operations.c 2005-09-28 16:49:48 UTC (rev 1672)
@@ -879,7 +879,7 @@
* base pointer + offset representation will not work under the lvalue
* assumption. Use SET_CDR properly. -- YamaKen 2005-09-23
*/
-ScmObj ScmOp_append(ScmObj args, ScmObj env)
+ScmObj ScmOp_append(ScmObj args)
{
ScmObj ret_lst = SCM_NULL;
ScmObj *ret_tail = &ret_lst;
@@ -1387,7 +1387,7 @@
return Scm_NewString(new_str);
}
-ScmObj ScmOp_string_append(ScmObj arg, ScmObj env)
+ScmObj ScmOp_string_append(ScmObj args)
{
int total_size = 0;
int total_len = 0;
@@ -1397,11 +1397,11 @@
char *p = NULL;
/* sanity check */
- if (NULLP(arg))
+ if (NULLP(args))
return Scm_NewStringCopying("");
/* count total size of the new string */
- for (strings = arg; !NULLP(strings); strings = CDR(strings)) {
+ for (strings = args; !NULLP(strings); strings = CDR(strings)) {
obj = CAR(strings);
if (!STRINGP(obj))
SigScm_ErrorObj("string-append : string required but got ", obj);
@@ -1415,7 +1415,7 @@
/* copy string by string */
p = new_str;
- for (strings = arg; !NULLP(strings); strings = CDR(strings)) {
+ for (strings = args; !NULLP(strings); strings = CDR(strings)) {
obj = CAR(strings);
strcpy(p, SCM_STRING_STR(obj));
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-09-28 16:14:27 UTC (rev 1671)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-09-28 16:49:48 UTC (rev 1672)
@@ -246,7 +246,7 @@
Scm_RegisterFunc1("list?" , ScmOp_listp);
Scm_RegisterFunc1("length" , ScmOp_length);
Scm_RegisterProcedureVariadic0("list" , ScmOp_list);
- Scm_RegisterFuncEvaledList("append" , ScmOp_append);
+ Scm_RegisterProcedureVariadic0("append" , ScmOp_append);
Scm_RegisterFunc1("reverse" , ScmOp_reverse);
Scm_RegisterFunc2("list-tail" , ScmOp_list_tail);
Scm_RegisterFunc2("list-ref" , ScmOp_list_ref);
@@ -276,7 +276,7 @@
Scm_RegisterFunc1("string-length" , ScmOp_string_length);
Scm_RegisterFunc2("string=?" , ScmOp_string_equal);
Scm_RegisterFunc3("substring" , ScmOp_string_substring);
- Scm_RegisterFuncEvaledList("string-append" , ScmOp_string_append);
+ Scm_RegisterProcedureVariadic0("string-append" , ScmOp_string_append);
Scm_RegisterFunc1("string->list" , ScmOp_string2list);
Scm_RegisterFunc1("list->string" , ScmOp_list2string);
Scm_RegisterFunc1("string-copy" , ScmOp_string_copy);
@@ -348,17 +348,17 @@
=======================================================================*/
Scm_RegisterFunc1("list-copy" , ScmOp_SRFI1_list_copy);
Scm_RegisterFunc2("xcons" , ScmOp_SRFI1_xcons);
- Scm_RegisterFuncEvaledList("circular-list" , ScmOp_SRFI1_circular_list);
- Scm_RegisterFuncEvaledList("iota" , ScmOp_SRFI1_iota);
- Scm_RegisterFuncEvaledList("cons*" , ScmOp_SRFI1_cons_star);
- Scm_RegisterFuncEvaledList("make-list" , ScmOp_SRFI1_make_list);
- Scm_RegisterFuncEvaledList("list-tabulate" , ScmOp_SRFI1_list_tabulate);
+ Scm_RegisterProcedureVariadic0("circular-list" , ScmOp_SRFI1_circular_list);
+ Scm_RegisterProcedureVariadic1("iota" , ScmOp_SRFI1_iota);
+ Scm_RegisterProcedureVariadic0("cons*" , ScmOp_SRFI1_cons_star);
+ Scm_RegisterProcedureVariadic1("make-list" , ScmOp_SRFI1_make_list);
+ Scm_RegisterProcedureVariadic1("list-tabulate" , ScmOp_SRFI1_list_tabulate);
Scm_RegisterFunc1("proper-list?" , ScmOp_SRFI1_proper_listp);
Scm_RegisterFunc1("circular-list?" , ScmOp_SRFI1_circular_listp);
Scm_RegisterFunc1("dotted-list?" , ScmOp_SRFI1_dotted_listp);
Scm_RegisterFunc1("not-pair?" , ScmOp_SRFI1_not_pairp);
Scm_RegisterFunc1("null-list?" , ScmOp_SRFI1_null_listp);
- Scm_RegisterFuncEvaledList("list=" , ScmOp_SRFI1_listequal);
+ Scm_RegisterProcedureVariadic1("list=" , ScmOp_SRFI1_listequal);
Scm_RegisterFunc1("first" , ScmOp_SRFI1_first);
Scm_RegisterFunc1("second" , ScmOp_SRFI1_second);
Scm_RegisterFunc1("third" , ScmOp_SRFI1_third);
@@ -380,7 +380,7 @@
Scm_RegisterFunc1("last" , ScmOp_SRFI1_last);
Scm_RegisterFunc1("last-pair" , ScmOp_SRFI1_last_pair);
Scm_RegisterFunc1("length+" , ScmOp_SRFI1_lengthplus);
- Scm_RegisterFuncEvaledList("concatenate" , ScmOp_SRFI1_concatenate);
+ Scm_RegisterProcedureVariadic0("concatenate" , ScmOp_SRFI1_concatenate);
#endif
#if SCM_USE_SRFI2
/*=======================================================================
@@ -404,7 +404,7 @@
/*=======================================================================
SRFI-8 Procedure
=======================================================================*/
- Scm_RegisterFuncEvaledList("write-with-shared-structure", ScmOp_SRFI38_write_with_shared_structure);
+ Scm_RegisterProcedureVariadic1("write-with-shared-structure", ScmOp_SRFI38_write_with_shared_structure);
#endif
#if SCM_USE_SRFI60
/*=======================================================================
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-09-28 16:14:27 UTC (rev 1671)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-09-28 16:49:48 UTC (rev 1672)
@@ -466,7 +466,7 @@
ScmObj ScmOp_nullp(ScmObj obj);
ScmObj ScmOp_listp(ScmObj obj);
ScmObj ScmOp_length(ScmObj obj);
-ScmObj ScmOp_append(ScmObj args, ScmObj env);
+ScmObj ScmOp_append(ScmObj args);
ScmObj ScmOp_reverse(ScmObj lst);
ScmObj ScmOp_list_tail(ScmObj lst, ScmObj scm_k);
ScmObj ScmOp_list_ref(ScmObj lst, ScmObj scm_k);
@@ -500,7 +500,7 @@
ScmObj ScmOp_string_equal(ScmObj str1, ScmObj str2);
/* TODO : many comparing functions around string is unimplemented */
ScmObj ScmOp_string_substring(ScmObj str, ScmObj start, ScmObj end);
-ScmObj ScmOp_string_append(ScmObj arg, ScmObj env);
+ScmObj ScmOp_string_append(ScmObj args);
ScmObj ScmOp_string2list(ScmObj string);
ScmObj ScmOp_list2string(ScmObj lst);
ScmObj ScmOp_string_copy(ScmObj string);
@@ -594,12 +594,12 @@
#if SCM_USE_SRFI1
/* operations-srfi1.c */
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);
-ScmObj ScmOp_SRFI1_list_tabulate(ScmObj arg, ScmObj env);
+ScmObj ScmOp_SRFI1_cons_star(ScmObj args);
+ScmObj ScmOp_SRFI1_make_list(ScmObj length, ScmObj args);
+ScmObj ScmOp_SRFI1_list_tabulate(ScmObj scm_n, ScmObj args);
ScmObj ScmOp_SRFI1_list_copy(ScmObj lst);
-ScmObj ScmOp_SRFI1_circular_list(ScmObj lst, ScmObj env);
-ScmObj ScmOp_SRFI1_iota(ScmObj args, ScmObj env);
+ScmObj ScmOp_SRFI1_circular_list(ScmObj args);
+ScmObj ScmOp_SRFI1_iota(ScmObj scm_count, ScmObj args);
ScmObj ScmOp_SRFI1_proper_listp(ScmObj lst);
ScmObj ScmOp_SRFI1_circular_listp(ScmObj lst);
ScmObj ScmOp_SRFI1_dotted_listp(ScmObj lst);
@@ -628,7 +628,7 @@
ScmObj ScmOp_SRFI1_last(ScmObj lst);
ScmObj ScmOp_SRFI1_last_pair(ScmObj lst);
ScmObj ScmOp_SRFI1_lengthplus(ScmObj lst);
-ScmObj ScmOp_SRFI1_concatenate(ScmObj args, ScmObj env);
+ScmObj ScmOp_SRFI1_concatenate(ScmObj args);
#endif
#if SCM_USE_SRFI2
ScmObj ScmOp_SRFI2_and_let_star(ScmObj claws, ScmObj body, ScmEvalState *eval_state);
@@ -643,7 +643,7 @@
#endif
#if SCM_USE_SRFI38
/* operations-srfi38.c */
-ScmObj ScmOp_SRFI38_write_with_shared_structure(ScmObj arg, ScmObj env);
+ScmObj ScmOp_SRFI38_write_with_shared_structure(ScmObj obj, ScmObj args);
#endif
#if SCM_USE_SRFI60
/* operations-srfi60.c */
More information about the uim-commit
mailing list