[uim-commit] r1670 - branches/r5rs/sigscheme
kzk at freedesktop.org
kzk at freedesktop.org
Wed Sep 28 09:10:00 PDT 2005
Author: kzk
Date: 2005-09-28 09:09:43 -0700 (Wed, 28 Sep 2005)
New Revision: 1670
Modified:
branches/r5rs/sigscheme/operations.c
branches/r5rs/sigscheme/sigscheme.c
branches/r5rs/sigscheme/sigscheme.h
Log:
* simplify "number->string", "list", "make-string", "string",
"make-vector", "vector", "force", "call-with-current-continuation"
and "values" with new FUNCTYPE scheme
* sigscheme/operations.c
* sigscheme/sigscheme.h
- (ScmOp_number2string,
ScmOp_list,
ScmOp_make_string,
ScmOp_string,
ScmOp_make_vector,
ScmOp_vector,
ScmOp_force,
ScmOp_call_with_current_continuation,
ScmOp_values): change args
* sigscheme/sigscheme.c
- (SigScm_Initialize_internal)
- "number->string": export by Scm_RegisterProcedureVariadic1
- "list": export by Scm_RegisterProcedureVariadic0
- "make-string": export by Scm_RegisterProcedureVariadic1
- "string": export by Scm_RegisterProcedureVariadic0
- "make-vector": export by Scm_RegisterProcedureVariadic1
- "vector": export by Scm_RegisterProcedureVariadic0
- "force": export by Scm_RegisterProcedureFixed1
- "values": export by Scm_RegisterProcedureVariadic0
- "call-with-current-continuation": export by
Scm_RegisterProcedureFixed1
Modified: branches/r5rs/sigscheme/operations.c
===================================================================
--- branches/r5rs/sigscheme/operations.c 2005-09-28 15:48:25 UTC (rev 1669)
+++ branches/r5rs/sigscheme/operations.c 2005-09-28 16:09:43 UTC (rev 1670)
@@ -545,31 +545,27 @@
/*==============================================================================
R5RS : 6.2 Numbers : 6.2.6 Numerical input and output
==============================================================================*/
-ScmObj ScmOp_number2string (ScmObj args, ScmObj env)
+ScmObj ScmOp_number2string (ScmObj num, ScmObj args)
{
char buf[sizeof(int)*CHAR_BIT + 1];
char *p;
unsigned int n, r;
- ScmObj number, radix;
+ ScmObj radix;
- if (CHECK_1_ARG(args))
- SigScm_ErrorObj("number->string: requires 1 or 2 arguments: ", args);
+ if (!INTP(num))
+ SigScm_ErrorObj("number->string: integer required but got ", num);
- number = CAR(args);
- if (!INTP(number))
- SigScm_ErrorObj("number->string: integer required but got ", number);
+ n = SCM_INT_VALUE(num);
- n = SCM_INT_VALUE(number);
-
/* r = radix */
- if (NULLP(CDR(args)))
+ if (NULLP(args))
r = 10;
else {
#ifdef SCM_STRICT_ARGCHECK
- if (!NULLP(CDDR(args)))
+ if (!NULLP(CDR(args)))
SigScm_ErrorObj("number->string: too many arguments: ", args);
#endif
- radix = CADR(args);
+ radix = CAR(args);
if (!INTP(radix))
SigScm_ErrorObj("number->string: integer required but got ", radix);
r = SCM_INT_VALUE(radix);
@@ -587,15 +583,13 @@
p = &buf[sizeof(buf)-1];
*p = 0;
- do
- {
+ do {
if (n % r > 9)
*--p = 'A' + n % r - 10;
else
*--p = '0' + n % r;
- }
- while (n /= r);
- if (r == 10 && SCM_INT_VALUE (number) < 0)
+ } while (n /= r);
+ if (r == 10 && SCM_INT_VALUE (num) < 0)
*--p = '-';
return Scm_NewStringCopying(p);
@@ -817,9 +811,9 @@
return ScmOp_cdr( ScmOp_cdr( ScmOp_cdr( ScmOp_cdr(lst) )));
}
-ScmObj ScmOp_list(ScmObj obj, ScmObj env)
+ScmObj ScmOp_list(ScmObj args)
{
- return obj;
+ return args;
}
ScmObj ScmOp_nullp(ScmObj obj)
@@ -1228,51 +1222,42 @@
return (STRINGP(obj)) ? SCM_TRUE : SCM_FALSE;
}
-ScmObj ScmOp_make_string(ScmObj arg, ScmObj env)
+ScmObj ScmOp_make_string(ScmObj length, ScmObj args)
{
- int argc = SCM_INT_VALUE(ScmOp_length(arg));
- int len = 0;
- char *tmp = NULL;
- ScmObj str = SCM_NULL;
- ScmObj ch = SCM_NULL;
+ int len = 0;
+ ScmObj str = SCM_FALSE;
+ ScmObj filler = SCM_FALSE;
/* sanity check */
- if (argc != 1 && argc != 2)
- SigScm_Error("make-string : invalid use");
- if (!INTP(CAR(arg)))
- SigScm_ErrorObj("make-string : integer required but got ", CAR(arg));
- if (argc == 2 && !CHARP(CADR(arg)))
- SigScm_ErrorObj("make-string : character required but got ", CADR(arg));
+ if (!INTP(length))
+ SigScm_ErrorObj("make-string : integer required but got ", length);
/* get length */
- len = SCM_INT_VALUE(CAR(arg));
+ len = SCM_INT_VALUE(length);
if (len == 0)
return Scm_NewStringCopying("");
/* specify filler */
- if (argc == 1) {
- /* specify length only, so fill string with space(' ') */
- tmp = (char*)malloc(sizeof(char) * (1 + 1));
- tmp[0] = ' ';
- tmp[1] = '\0';
- ch = Scm_NewChar(tmp);
+ if (NULLP(args)) {
+ filler = Scm_NewChar(strdup(" "));
} else {
- /* also specify filler char */
- ch = CADR(arg);
+ filler = CAR(args);
+ if (!CHARP(filler))
+ SigScm_ErrorObj("make-string : character required but got ", filler);
}
/* make string */
str = Scm_NewStringWithLen(NULL, len);
/* and fill! */
- ScmOp_string_fill(str, ch);
+ ScmOp_string_fill(str, filler);
return str;
}
-ScmObj ScmOp_string(ScmObj arg, ScmObj env)
+ScmObj ScmOp_string(ScmObj args)
{
- return ScmOp_list2string(arg);
+ return ScmOp_list2string(args);
}
ScmObj ScmOp_string_length(ScmObj str)
@@ -1568,47 +1553,42 @@
return (VECTORP(obj)) ? SCM_TRUE : SCM_FALSE;
}
-ScmObj ScmOp_make_vector(ScmObj arg, ScmObj env )
+ScmObj ScmOp_make_vector(ScmObj vector_len, ScmObj args)
{
- ScmObj *vec = NULL;
- ScmObj scm_k = CAR(arg);
- ScmObj fill = SCM_NULL;
- int c_k = 0;
+ ScmObj *vec = NULL;
+ ScmObj filler = SCM_FALSE;
+ int len = 0;
int i = 0;
- if (!INTP(scm_k))
- SigScm_ErrorObj("make-vector : integer required but got ", scm_k);
+ if (!INTP(vector_len))
+ SigScm_ErrorObj("make-vector : integer required but got ", vector_len);
/* allocate vector */
- c_k = SCM_INT_VALUE(scm_k);
- vec = (ScmObj*)malloc(sizeof(ScmObj) * c_k);
+ len = SCM_INT_VALUE(vector_len);
+ vec = (ScmObj*)malloc(sizeof(ScmObj) * len);
/* fill vector */
- fill = SCM_UNDEF;
- if (!NULLP(CDR(arg)))
- fill = CADR(arg);
+ filler = SCM_UNDEF;
+ if (!NULLP(args))
+ filler = CAR(args);
- for (i = 0; i < c_k; i++) {
- vec[i] = fill;
- }
+ for (i = 0; i < len; i++)
+ vec[i] = filler;
- return Scm_NewVector(vec, c_k);
+ return Scm_NewVector(vec, len);
}
-ScmObj ScmOp_vector(ScmObj arg, ScmObj env )
+ScmObj ScmOp_vector(ScmObj args)
{
- ScmObj scm_len = ScmOp_length(arg);
- int c_len = SCM_INT_VALUE(scm_len);
- ScmObj *vec = (ScmObj*)malloc(sizeof(ScmObj) * c_len); /* allocate vector */
+ int len = SCM_INT_VALUE(ScmOp_length(args));
+ int i = 0;
+ ScmObj *vec = (ScmObj*)malloc(sizeof(ScmObj) * len); /* allocate vector */
/* set item */
- int i = 0;
- for (i = 0; i < c_len; i++) {
- vec[i] = CAR(arg);
- arg = CDR(arg);
- }
+ for (i = 0; i < len; i++)
+ SCM_SHIFT_RAW_1(vec[i], args);
- return Scm_NewVector(vec, c_len);
+ return Scm_NewVector(vec, len);
}
ScmObj ScmOp_vector_length(ScmObj vec)
@@ -1817,22 +1797,18 @@
return SCM_UNDEF;
}
-ScmObj ScmOp_force(ScmObj arg, ScmObj env)
+ScmObj ScmOp_force(ScmObj closure)
{
- if (SCM_INT_VALUE(ScmOp_length(arg)) != 1)
- SigScm_Error("force : Wrong number of arguments");
- if (!CLOSUREP(CAR(arg)))
- SigScm_Error("force : not proper delayed object");
+ if (!CLOSUREP(closure))
+ SigScm_ErrorObj("force : not proper delayed object ", closure);
- /* the caller's already wrapped arg in a list for us */
- return EVAL(arg, env);
+ return Scm_call(closure, SCM_NULL);
}
-ScmObj ScmOp_call_with_current_continuation(ScmObj arg, ScmObj env)
+ScmObj ScmOp_call_with_current_continuation(ScmObj proc)
{
int jmpret = 0;
- ScmObj proc = CAR(arg);
- ScmObj cont = SCM_NULL;
+ ScmObj cont = SCM_FALSE;
if (!CLOSUREP(proc))
SigScm_ErrorObj("call-with-current-continuation : closure required but got ", proc);
@@ -1847,28 +1823,26 @@
}
/* execute (proc cont) */
- SET_CDR(arg, CONS(cont, SCM_NULL));
-
- return EVAL(arg, env);
+ return Scm_call(proc, LIST_1(cont));
}
-ScmObj ScmOp_values(ScmObj argl, ScmObj env)
+ScmObj ScmOp_values(ScmObj args)
{
/* Values with one arg must return something that fits an ordinary
* continuation. */
- if (CONSP(argl) && NULLP(CDR(argl)))
- return CAR(argl);
+ if (CONSP(args) && NULLP(CDR(args)))
+ return CAR(args);
#if SCM_USE_VALUECONS
- if (NULLP(argl)) {
+ if (NULLP(args)) {
return SigScm_null_values;
} else {
- SCM_ENTYPE_VALUEPACKET(argl);
- return argl;
+ SCM_ENTYPE_VALUEPACKET(args);
+ return args;
}
#else
/* Otherwise, we'll return the values in a packet. */
- return Scm_NewValuePacket(argl);
+ return Scm_NewValuePacket(args);
#endif
}
Modified: branches/r5rs/sigscheme/sigscheme.c
===================================================================
--- branches/r5rs/sigscheme/sigscheme.c 2005-09-28 15:48:25 UTC (rev 1669)
+++ branches/r5rs/sigscheme/sigscheme.c 2005-09-28 16:09:43 UTC (rev 1670)
@@ -204,7 +204,7 @@
Scm_RegisterFunc2("quotient" , ScmOp_quotient);
Scm_RegisterFunc2("modulo" , ScmOp_modulo);
Scm_RegisterFunc2("remainder" , ScmOp_remainder);
- Scm_RegisterFuncEvaledList("number->string" , ScmOp_number2string);
+ Scm_RegisterProcedureVariadic1("number->string" , ScmOp_number2string);
Scm_RegisterFunc1("string->number" , ScmOp_string2number);
Scm_RegisterFunc1("not" , ScmOp_not);
Scm_RegisterFunc1("boolean?" , ScmOp_booleanp);
@@ -245,7 +245,7 @@
Scm_RegisterFunc1("null?" , ScmOp_nullp);
Scm_RegisterFunc1("list?" , ScmOp_listp);
Scm_RegisterFunc1("length" , ScmOp_length);
- Scm_RegisterFuncEvaledList("list" , ScmOp_list);
+ Scm_RegisterProcedureVariadic0("list" , ScmOp_list);
Scm_RegisterFuncEvaledList("append" , ScmOp_append);
Scm_RegisterFunc1("reverse" , ScmOp_reverse);
Scm_RegisterFunc2("list-tail" , ScmOp_list_tail);
@@ -269,8 +269,8 @@
Scm_RegisterFunc1("char-upcase" , ScmOp_char_upcase);
Scm_RegisterFunc1("char-downcase" , ScmOp_char_downcase);
Scm_RegisterFunc1("string?" , ScmOp_stringp);
- Scm_RegisterFuncEvaledList("make-string" , ScmOp_make_string);
- Scm_RegisterFuncEvaledList("string" , ScmOp_string);
+ Scm_RegisterProcedureVariadic1("make-string" , ScmOp_make_string);
+ Scm_RegisterProcedureVariadic0("string" , ScmOp_string);
Scm_RegisterFunc2("string-ref" , ScmOp_string_ref);
Scm_RegisterFunc3("string-set!" , ScmOp_string_set);
Scm_RegisterFunc1("string-length" , ScmOp_string_length);
@@ -282,8 +282,8 @@
Scm_RegisterFunc1("string-copy" , ScmOp_string_copy);
Scm_RegisterFunc2("string-fill!" , ScmOp_string_fill);
Scm_RegisterFunc1("vector?" , ScmOp_vectorp);
- Scm_RegisterFuncEvaledList("make-vector" , ScmOp_make_vector);
- Scm_RegisterFuncEvaledList("vector" , ScmOp_vector);
+ Scm_RegisterProcedureVariadic1("make-vector" , ScmOp_make_vector);
+ Scm_RegisterProcedureVariadic0("vector" , ScmOp_vector);
Scm_RegisterFunc1("vector-length" , ScmOp_vector_length);
Scm_RegisterFunc2("vector-ref" , ScmOp_vector_ref);
Scm_RegisterFunc3("vector-set!" , ScmOp_vector_set);
@@ -293,9 +293,9 @@
Scm_RegisterFunc1("procedure?" , ScmOp_procedurep);
Scm_RegisterProcedureVariadic1("map" , ScmOp_map);
Scm_RegisterProcedureVariadic1("for-each" , ScmOp_for_each);
- Scm_RegisterFuncEvaledList("force" , ScmOp_force);
- Scm_RegisterFuncEvaledList("values" , ScmOp_values);
- Scm_RegisterFuncEvaledList("call-with-current-continuation", ScmOp_call_with_current_continuation);
+ Scm_RegisterProcedureFixed1("force" , ScmOp_force);
+ Scm_RegisterProcedureVariadic0("values" , ScmOp_values);
+ Scm_RegisterProcedureFixed1("call-with-current-continuation", ScmOp_call_with_current_continuation);
Scm_RegisterProcedureFixed2("call-with-values" , ScmOp_call_with_values);
/* io.c */
Scm_RegisterFunc2("call-with-input-file" , ScmOp_call_with_input_file);
Modified: branches/r5rs/sigscheme/sigscheme.h
===================================================================
--- branches/r5rs/sigscheme/sigscheme.h 2005-09-28 15:48:25 UTC (rev 1669)
+++ branches/r5rs/sigscheme/sigscheme.h 2005-09-28 16:09:43 UTC (rev 1670)
@@ -424,7 +424,7 @@
ScmObj ScmOp_quotient(ScmObj scm_n1, ScmObj scm_n2);
ScmObj ScmOp_modulo(ScmObj scm_n1, ScmObj scm_n2);
ScmObj ScmOp_remainder(ScmObj scm_n1, ScmObj scm_n2);
-ScmObj ScmOp_number2string (ScmObj args, ScmObj env);
+ScmObj ScmOp_number2string (ScmObj num, ScmObj args);
ScmObj ScmOp_string2number(ScmObj string);
ScmObj ScmOp_not(ScmObj obj);
ScmObj ScmOp_booleanp(ScmObj obj);
@@ -462,7 +462,7 @@
ScmObj ScmOp_cddadr(ScmObj lst);
ScmObj ScmOp_cdddar(ScmObj lst);
ScmObj ScmOp_cddddr(ScmObj lst);
-ScmObj ScmOp_list(ScmObj obj, ScmObj env);
+ScmObj ScmOp_list(ScmObj args);
ScmObj ScmOp_nullp(ScmObj obj);
ScmObj ScmOp_listp(ScmObj obj);
ScmObj ScmOp_length(ScmObj obj);
@@ -492,8 +492,8 @@
ScmObj ScmOp_char_downcase(ScmObj obj);
ScmObj ScmOp_stringp(ScmObj obj);
-ScmObj ScmOp_make_string(ScmObj arg, ScmObj env);
-ScmObj ScmOp_string(ScmObj arg, ScmObj env);
+ScmObj ScmOp_make_string(ScmObj length, ScmObj args);
+ScmObj ScmOp_string(ScmObj args);
ScmObj ScmOp_string_length(ScmObj str);
ScmObj ScmOp_string_ref(ScmObj str, ScmObj k);
ScmObj ScmOp_string_set(ScmObj str, ScmObj k, ScmObj ch);
@@ -506,8 +506,8 @@
ScmObj ScmOp_string_copy(ScmObj string);
ScmObj ScmOp_string_fill(ScmObj string, ScmObj ch);
ScmObj ScmOp_vectorp(ScmObj obj);
-ScmObj ScmOp_make_vector(ScmObj arg, ScmObj env );
-ScmObj ScmOp_vector(ScmObj arg, ScmObj env );
+ScmObj ScmOp_make_vector(ScmObj vector_len, ScmObj args);
+ScmObj ScmOp_vector(ScmObj args);
ScmObj ScmOp_vector_length(ScmObj vec);
ScmObj ScmOp_vector_ref(ScmObj vec, ScmObj scm_k);
ScmObj ScmOp_vector_set(ScmObj vec, ScmObj scm_k, ScmObj obj);
@@ -517,9 +517,9 @@
ScmObj ScmOp_procedurep(ScmObj obj);
ScmObj ScmOp_map(ScmObj proc, ScmObj args);
ScmObj ScmOp_for_each(ScmObj proc, ScmObj args);
-ScmObj ScmOp_force(ScmObj arg, ScmObj env);
-ScmObj ScmOp_call_with_current_continuation(ScmObj arg, ScmObj env);
-ScmObj ScmOp_values(ScmObj argl, ScmObj env);
+ScmObj ScmOp_force(ScmObj closure);
+ScmObj ScmOp_call_with_current_continuation(ScmObj proc);
+ScmObj ScmOp_values(ScmObj args);
ScmObj ScmOp_call_with_values(ScmObj producer, ScmObj consumer);
/* io.c */
More information about the uim-commit
mailing list