/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- extlib_macroexpand
- extlib_macroexpand_1
- getcmpmode
- extlib_compare
- extlib_ash
- extlib_lognot
- extlib_logand
- extlib_logior
- extlib_logxor
- extlib_fixnumP
- extlib_bignumP
- extlib_flonumP
- extlib_clamp
- extlib_decode_float
- extlib__25bignum_dump
- extlib_min_26max
- extlib_quotient_26remainder
- extlib_proper_listP
- extlib_dotted_listP
- extlib_circular_listP
- extlib_make_list
- extlib_acons
- extlib_last_pair
- extlib_list_copy
- extlib_list_2a
- extlib__25delete
- extlib__25deleteX
- extlib__25delete_duplicates
- extlib__25delete_duplicatesX
- extlib__25alist_delete
- extlib__25alist_deleteX
- extlib_appendX
- extlib_reverseX
- extlib__25sort
- extlib__25sortX
- extlib_monotonic_merge
- extlib_gensym
- extlib_keywordP
- extlib_make_keyword
- extlib_get_keyword
- extlib_delete_keyword
- extlib_delete_keywordX
- extlib_keyword_TOstring
- extlib_identifierP
- extlib_identifier_TOsymbol
- extlib_digit_TOinteger
- extlib_integer_TOdigit
- extlib_ucs_TOchar
- extlib_char_TOucs
- extlib_gauche_character_encoding
- extlib_supported_character_encodings
- extlib_supported_character_encodingP
- extlib_char_setP
- char_set_add
- extlib__25char_set_equalP
- extlib__25char_set_LT_3dP
- extlib_char_set
- extlib_char_set_copy
- extlib__25char_set_add_charsX
- extlib__25char_set_add_rangeX
- extlib__25char_set_addX
- extlib_char_set_containsP
- extlib__25char_set_complementX
- extlib__25char_set_ranges
- extlib__25char_set_predefined
- extlib__25char_set_dump
- extlib_string_incompleteP
- extlib_string_immutableP
- extlib_string_complete_TOincompleteX
- extlib_string_incomplete_TOcompleteX
- extlib_string_complete_TOincomplete
- extlib_string_incomplete_TOcomplete
- extlib_string_size
- extlib_make_byte_string
- extlib_string_byte_ref
- extlib_string_byte_setX
- extlib_string_substituteX
- extlib__25maybe_substring
- extlib_string_join
- extlib__25hash_string
- extlib__25string_split_by_char
- extlib_string_scan
- extlib_make_string_pointer
- extlib_string_pointerP
- extlib_string_pointer_ref
- extlib_string_pointer_nextX
- extlib_string_pointer_prevX
- extlib_string_pointer_setX
- extlib_string_pointer_substring
- extlib_string_pointer_index
- extlib_string_pointer_copy
- extlib_string_pointer_byte_index
- extlib__25string_pointer_dump
- extlib_regexpP
- extlib_regmatchP
- extlib_string_TOregexp
- extlib_regexp_TOstring
- extlib_regexp_case_foldP
- extlib_regexp_parse
- extlib_regexp_compile
- extlib_regexp_optimize
- extlib_rxmatch
- extlib_rxmatch_substring
- extlib_rxmatch_start
- extlib_rxmatch_end
- extlib_rxmatch_before
- extlib_rxmatch_after
- extlib_rxmatch_num_matches
- extlib__25regexp_dump
- extlib__25regmatch_dump
- extlib_vector_copy
- extlib_make_weak_vector
- extlib_weak_vector_length
- extlib_weak_vector_ref
- extlib_weak_vector_setX
- extlib_setter_SETTER
- extlib_setter
- extlib_has_setterP
- extlib_identity
- extlib_promiseP
- extlib_eager
- extlib_promise_kind_SETTER
- extlib_promise_kind
- extlib__25open_input_file
- extlib__25open_output_file
- extlib_open_input_string
- extlib_open_output_string
- extlib_get_output_string
- extlib_get_remaining_input_string
- extlib_open_coding_aware_port
- bufport_closer
- bufport_filler
- extlib_open_input_buffered_port
- bufport_flusher
- extlib_open_output_buffered_port
- extlib_flush
- extlib_flush_all_ports
- extlib_port_closedP
- extlib_current_error_port
- extlib_standard_input_port
- extlib_standard_output_port
- extlib_standard_error_port
- extlib_with_input_from_port
- extlib_with_output_to_port
- extlib_with_error_to_port
- extlib_port_name
- extlib_port_current_line
- extlib_port_file_number
- extlib_port_seek
- extlib_port_type
- extlib_port_buffering_SETTER
- extlib_port_buffering
- extlib_open_input_fd_port
- extlib_open_output_fd_port
- extlib_with_port_locking
- extlib_port_TObyte_string
- extlib_byte_readyP
- extlib_read_byte
- extlib_peek_byte
- extlib_read_line
- extlib_read_block
- extlib_read_list
- extlib_define_reader_ctor
- extlib_read_referenceP
- extlib_read_reference_has_valueP
- extlib_read_reference_value
- extlib_write_byte
- extlib_write_limited
- extlib_write_2a
- extlib__25add_load_path
- extlib_dynamic_load
- extlib__25require
- extlib_provide
- extlib_providedP
- extlib__25autoload
- extlib_undefined
- extlib_undefinedP
- extlib_warn
- extlib_eq_hash
- extlib_eqv_hash
- extlib_hash
- get_hash_proc
- extlib_make_hash_table
- extlib_hash_tableP
- extlib_hash_table_type
- extlib_hash_table_num_entries
- extlib_hash_table_get
- extlib_hash_table_putX
- extlib_hash_table_deleteX
- extlib_hash_table_existsP
- hash_table_update_cc
- extlib_hash_table_updateX
- extlib_hash_table_pushX
- extlib_hash_table_popX
- hash_table_iter
- extlib__25hash_table_iter
- extlib_hash_table_keys
- extlib_hash_table_values
- extlib_hash_table_stat
- extlib_moduleP
- extlib_module_name
- extlib_module_parents
- extlib_module_precedence_list
- extlib_module_imports
- extlib_module_exports
- extlib_module_table
- extlib_find_module
- extlib_all_modules
- extlib_make_module
- extlib_module_name_TOpath
- extlib_path_TOmodule_name
- extlib__25export_all
- extlib__25extend_module
- get_module_from_mod_or_name
- extlib_global_variable_boundP
- extlib_global_variable_ref
- extlib__25format
- extlib_exit
- Scm_VMClass_PRINT
- Scm_VMClass_name_GET
- Scm_VMClass_name_SET
- Scm_VMClass_specific_GET
- Scm_VMClass_specific_SET
- extlib_vm_dump
- extlib_vm_get_stack_trace
- extlib_vm_get_stack_trace_lite
- extlib_vm_set_default_exception_handler
- extlib_current_load_history
- extlib_current_load_next
- extlib_current_load_port
- extlib__25vm_make_parameter_slot
- extlib__25vm_parameter_ref
- extlib__25vm_parameter_setX
- extlib_gauche_version
- extlib_gauche_architecture
- extlib_gauche_library_directory
- extlib_gauche_architecture_directory
- extlib_gauche_site_library_directory
- extlib_gauche_site_architecture_directory
- extlib_gauche_dso_suffix
- extlib_current_thread
- extlib_unwrap_syntax
- extlib_foreign_pointer_attributes
- extlib_foreign_pointer_attribute_get
- extlib_foreign_pointer_attribute_set
- extlib_gc
- extlib_gc_stat
- extlib_profiler_start
- extlib_profiler_stop
- extlib_profiler_reset
- extlib_subrP
- extlib_closureP
- extlib_toplevel_closureP
- extlib_closure_code
- extlib_procedure_info
- Scm_Init_extlib
1 /* Generated by genstub. Do not edit. */
2 #define LIBGAUCHE_BODY
3 #include <gauche.h>
4 #if defined(__CYGWIN__) || defined(__MINGW32__)
5 #define SCM_CGEN_CONST /*empty*/
6 #else
7 #define SCM_CGEN_CONST const
8 #endif
9
10 #include <fcntl.h>
11 #include <gauche/arch.h>
12 #include <gauche/class.h>
13 #include <gauche/vminsn.h>
14
15 static ScmObj extlib_macroexpand(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
16 {
17 ScmObj form_scm;
18 ScmObj form;
19 SCM_ENTER_SUBR("macroexpand");
20 form_scm = SCM_ARGREF(0);
21 form = (form_scm);
22 {
23 {
24 ScmObj SCM_RESULT;
25 SCM_RESULT = (Scm_VMMacroExpand(form, SCM_NIL, FALSE));
26 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
27 }
28 }
29 }
30
31 static SCM_DEFINE_STRING_CONST(extlib_macroexpand__NAME, "macroexpand", 11, 11);
32 static SCM_DEFINE_SUBR(extlib_macroexpand__STUB, 1, 0, SCM_OBJ(&extlib_macroexpand__NAME), extlib_macroexpand, NULL, NULL);
33
34 static ScmObj extlib_macroexpand_1(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
35 {
36 ScmObj form_scm;
37 ScmObj form;
38 SCM_ENTER_SUBR("macroexpand-1");
39 form_scm = SCM_ARGREF(0);
40 form = (form_scm);
41 {
42 {
43 ScmObj SCM_RESULT;
44 SCM_RESULT = (Scm_VMMacroExpand(form, SCM_NIL, TRUE));
45 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
46 }
47 }
48 }
49
50 static SCM_DEFINE_STRING_CONST(extlib_macroexpand_1__NAME, "macroexpand-1", 13, 13);
51 static SCM_DEFINE_SUBR(extlib_macroexpand_1__STUB, 1, 0, SCM_OBJ(&extlib_macroexpand_1__NAME), extlib_macroexpand_1, NULL, NULL);
52
53 static SCM_DEFINE_STRING_CONST(sym_eq__NAME, "eq?", 3, 3);
54 static ScmObj sym_eq = SCM_UNBOUND;
55 static SCM_DEFINE_STRING_CONST(sym_eqv__NAME, "eqv?", 4, 4);
56 static ScmObj sym_eqv = SCM_UNBOUND;
57 static SCM_DEFINE_STRING_CONST(sym_equal__NAME, "equal?", 6, 6);
58 static ScmObj sym_equal = SCM_UNBOUND;
59 static SCM_DEFINE_STRING_CONST(sym_string_eq__NAME, "string=?", 8, 8);
60 static ScmObj sym_string_eq = SCM_UNBOUND;
61 static int getcmpmode(ScmObj opt)
62 { if (SCM_UNBOUNDP(opt) || opt == sym_equal) return SCM_CMP_EQUAL;
63 if (opt == sym_eq) return SCM_CMP_EQ;
64 if (opt == sym_eqv) return SCM_CMP_EQV;
65 Scm_Error("unrecognized compare mode: %S", opt);
66 return 0; /* dummy */ }
67 static ScmObj extlib_compare(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
68 {
69 ScmObj x_scm;
70 ScmObj x;
71 ScmObj y_scm;
72 ScmObj y;
73 SCM_ENTER_SUBR("compare");
74 x_scm = SCM_ARGREF(0);
75 x = (x_scm);
76 y_scm = SCM_ARGREF(1);
77 y = (y_scm);
78 {
79 {
80 int SCM_RESULT;
81 SCM_RESULT = Scm_Compare(x, y);
82 SCM_RETURN(SCM_MAKE_INT(SCM_RESULT));
83 }
84 }
85 }
86
87 static SCM_DEFINE_STRING_CONST(extlib_compare__NAME, "compare", 7, 7);
88 static SCM_DEFINE_SUBR(extlib_compare__STUB, 2, 0, SCM_OBJ(&extlib_compare__NAME), extlib_compare, NULL, NULL);
89
90 static ScmObj extlib_ash(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
91 {
92 ScmObj num_scm;
93 ScmObj num;
94 ScmObj cnt_scm;
95 int cnt;
96 SCM_ENTER_SUBR("ash");
97 num_scm = SCM_ARGREF(0);
98 num = (num_scm);
99 cnt_scm = SCM_ARGREF(1);
100 if (!SCM_INTP(cnt_scm)) Scm_Error("small integer required, but got %S", cnt_scm);
101 cnt = SCM_INT_VALUE(cnt_scm);
102 {
103 {
104 ScmObj SCM_RESULT;
105 SCM_RESULT = Scm_Ash(num, cnt);
106 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
107 }
108 }
109 }
110
111 static SCM_DEFINE_STRING_CONST(extlib_ash__NAME, "ash", 3, 3);
112 static SCM_DEFINE_SUBR(extlib_ash__STUB, 2, 0, SCM_OBJ(&extlib_ash__NAME), extlib_ash, NULL, NULL);
113
114 static ScmObj extlib_lognot(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
115 {
116 ScmObj x_scm;
117 ScmObj x;
118 SCM_ENTER_SUBR("lognot");
119 x_scm = SCM_ARGREF(0);
120 x = (x_scm);
121 {
122 {
123 ScmObj SCM_RESULT;
124 SCM_RESULT = Scm_LogNot(x);
125 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
126 }
127 }
128 }
129
130 static SCM_DEFINE_STRING_CONST(extlib_lognot__NAME, "lognot", 6, 6);
131 static SCM_DEFINE_SUBR(extlib_lognot__STUB, 1, 0, SCM_OBJ(&extlib_lognot__NAME), extlib_lognot, NULL, NULL);
132
133 static ScmObj extlib_logand(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
134 {
135 ScmObj x_scm;
136 ScmObj x;
137 ScmObj y_scm;
138 ScmObj y;
139 ScmObj args_scm;
140 ScmObj args;
141 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
142 SCM_ENTER_SUBR("logand");
143 x_scm = SCM_ARGREF(0);
144 x = (x_scm);
145 y_scm = SCM_ARGREF(1);
146 y = (y_scm);
147 args_scm = SCM_OPTARGS;
148 args = (args_scm);
149 {
150 ScmObj cp, r = Scm_LogAnd(x, y);
151 SCM_FOR_EACH(cp, args) {
152 r = Scm_LogAnd(r, SCM_CAR(cp));
153 }
154 SCM_RETURN(r);
155 }
156 }
157
158 static SCM_DEFINE_STRING_CONST(extlib_logand__NAME, "logand", 6, 6);
159 static SCM_DEFINE_SUBR(extlib_logand__STUB, 2, 1, SCM_OBJ(&extlib_logand__NAME), extlib_logand, NULL, NULL);
160
161 static ScmObj extlib_logior(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
162 {
163 ScmObj x_scm;
164 ScmObj x;
165 ScmObj y_scm;
166 ScmObj y;
167 ScmObj args_scm;
168 ScmObj args;
169 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
170 SCM_ENTER_SUBR("logior");
171 x_scm = SCM_ARGREF(0);
172 x = (x_scm);
173 y_scm = SCM_ARGREF(1);
174 y = (y_scm);
175 args_scm = SCM_OPTARGS;
176 args = (args_scm);
177 {
178 ScmObj cp, r = Scm_LogIor(x, y);
179 SCM_FOR_EACH(cp, args) {
180 r = Scm_LogIor(r, SCM_CAR(cp));
181 }
182 SCM_RETURN(r);
183 }
184 }
185
186 static SCM_DEFINE_STRING_CONST(extlib_logior__NAME, "logior", 6, 6);
187 static SCM_DEFINE_SUBR(extlib_logior__STUB, 2, 1, SCM_OBJ(&extlib_logior__NAME), extlib_logior, NULL, NULL);
188
189 static ScmObj extlib_logxor(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
190 {
191 ScmObj x_scm;
192 ScmObj x;
193 ScmObj y_scm;
194 ScmObj y;
195 ScmObj args_scm;
196 ScmObj args;
197 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
198 SCM_ENTER_SUBR("logxor");
199 x_scm = SCM_ARGREF(0);
200 x = (x_scm);
201 y_scm = SCM_ARGREF(1);
202 y = (y_scm);
203 args_scm = SCM_OPTARGS;
204 args = (args_scm);
205 {
206 ScmObj cp, r = Scm_LogXor(x, y);
207 SCM_FOR_EACH(cp, args) {
208 r = Scm_LogXor(r, SCM_CAR(cp));
209 }
210 SCM_RETURN(r);
211 }
212 }
213
214 static SCM_DEFINE_STRING_CONST(extlib_logxor__NAME, "logxor", 6, 6);
215 static SCM_DEFINE_SUBR(extlib_logxor__STUB, 2, 1, SCM_OBJ(&extlib_logxor__NAME), extlib_logxor, NULL, NULL);
216
217 static ScmObj extlib_fixnumP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
218 {
219 ScmObj x_scm;
220 ScmObj x;
221 SCM_ENTER_SUBR("fixnum?");
222 x_scm = SCM_ARGREF(0);
223 x = (x_scm);
224 {
225 {
226 int SCM_RESULT;
227 SCM_RESULT = SCM_INTP(x);
228 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
229 }
230 }
231 }
232
233 static SCM_DEFINE_STRING_CONST(extlib_fixnumP__NAME, "fixnum?", 7, 7);
234 static SCM_DEFINE_SUBR(extlib_fixnumP__STUB, 1, 0, SCM_OBJ(&extlib_fixnumP__NAME), extlib_fixnumP, NULL, NULL);
235
236 static ScmObj extlib_bignumP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
237 {
238 ScmObj x_scm;
239 ScmObj x;
240 SCM_ENTER_SUBR("bignum?");
241 x_scm = SCM_ARGREF(0);
242 x = (x_scm);
243 {
244 {
245 int SCM_RESULT;
246 SCM_RESULT = SCM_BIGNUMP(x);
247 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
248 }
249 }
250 }
251
252 static SCM_DEFINE_STRING_CONST(extlib_bignumP__NAME, "bignum?", 7, 7);
253 static SCM_DEFINE_SUBR(extlib_bignumP__STUB, 1, 0, SCM_OBJ(&extlib_bignumP__NAME), extlib_bignumP, NULL, NULL);
254
255 static ScmObj extlib_flonumP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
256 {
257 ScmObj x_scm;
258 ScmObj x;
259 SCM_ENTER_SUBR("flonum?");
260 x_scm = SCM_ARGREF(0);
261 x = (x_scm);
262 {
263 {
264 int SCM_RESULT;
265 SCM_RESULT = SCM_FLONUMP(x);
266 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
267 }
268 }
269 }
270
271 static SCM_DEFINE_STRING_CONST(extlib_flonumP__NAME, "flonum?", 7, 7);
272 static SCM_DEFINE_SUBR(extlib_flonumP__STUB, 1, 0, SCM_OBJ(&extlib_flonumP__NAME), extlib_flonumP, NULL, NULL);
273
274 static ScmObj extlib_clamp(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
275 {
276 ScmObj x_scm;
277 ScmObj x;
278 ScmObj min_scm;
279 ScmObj min;
280 ScmObj max_scm;
281 ScmObj max;
282 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
283 SCM_ENTER_SUBR("clamp");
284 if (Scm_Length(SCM_OPTARGS) > 2)
285 Scm_Error("too many arguments: up to 2 is expected, %d given.", Scm_Length(SCM_OPTARGS));
286 x_scm = SCM_ARGREF(0);
287 x = (x_scm);
288 if (SCM_NULLP(SCM_OPTARGS)) min_scm = SCM_FALSE;
289 else {
290 min_scm = SCM_CAR(SCM_OPTARGS);
291 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
292 }
293 min = (min_scm);
294 if (SCM_NULLP(SCM_OPTARGS)) max_scm = SCM_FALSE;
295 else {
296 max_scm = SCM_CAR(SCM_OPTARGS);
297 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
298 }
299 max = (max_scm);
300 {
301 ScmObj r = x; int maybe_exact = FALSE;
302 if (SCM_EXACTP(x)) maybe_exact = TRUE;
303 else if (!SCM_FLONUMP(x)) {
304 Scm_Error("real number required for x, but got %S", x);
305 }
306 if (SCM_EXACTP(min)) {
307 if (Scm_NumCmp(x, min) < 0) r = min;
308 } else if (SCM_FLONUMP(min)) {
309 maybe_exact = FALSE;
310 if (Scm_NumCmp(x, min) < 0) r = min;
311 } else if (!SCM_FALSEP(min)) {
312 Scm_Error("real number or #f required for min, but got %S", min);
313 }
314 if (SCM_EXACTP(max)) {
315 if (Scm_NumCmp(x, max) > 0) r = max;
316 } else if (SCM_FLONUMP(max)) {
317 maybe_exact = FALSE;
318 if (Scm_NumCmp(x, max) > 0) r = max;
319 } else if (!SCM_FALSEP(max)) {
320 Scm_Error("real number or #f required for max, but got %S", max);
321 }
322 if (!maybe_exact && SCM_EXACTP(r)) SCM_RETURN(Scm_ExactToInexact(r));
323 else SCM_RETURN(r);
324 }
325 }
326
327 static SCM_DEFINE_STRING_CONST(extlib_clamp__NAME, "clamp", 5, 5);
328 static SCM_DEFINE_SUBR(extlib_clamp__STUB, 1, 1, SCM_OBJ(&extlib_clamp__NAME), extlib_clamp, NULL, NULL);
329
330 static ScmObj extlib_decode_float(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
331 {
332 ScmObj num_scm;
333 ScmObj num;
334 SCM_ENTER_SUBR("decode-float");
335 num_scm = SCM_ARGREF(0);
336 num = (num_scm);
337 {
338 if (SCM_FLONUMP(num)) {
339 int exp, sign;
340 ScmObj f = Scm_DecodeFlonum(SCM_FLONUM_VALUE(num), &exp, &sign);
341 ScmObj v = Scm_MakeVector(3, SCM_FALSE);
342 SCM_VECTOR_ELEMENT(v, 0) = f;
343 SCM_VECTOR_ELEMENT(v, 1) = Scm_MakeInteger(exp);
344 SCM_VECTOR_ELEMENT(v, 2) = Scm_MakeInteger(sign);
345 SCM_RETURN(v);
346 } else if (SCM_INTP(num)) {
347 ScmObj v = Scm_MakeVector(3, SCM_FALSE);
348 SCM_VECTOR_ELEMENT(v, 0) = Scm_Abs(num);
349 SCM_VECTOR_ELEMENT(v, 1) = Scm_MakeInteger(0);
350 SCM_VECTOR_ELEMENT(v, 2) = Scm_MakeInteger(Scm_Sign(num));
351 SCM_RETURN(v);
352 } else {
353 Scm_Error("real number required, but got %S", num);
354 SCM_RETURN(SCM_UNDEFINED);
355 }
356 }
357 }
358
359 static SCM_DEFINE_STRING_CONST(extlib_decode_float__NAME, "decode-float", 12, 12);
360 static SCM_DEFINE_SUBR(extlib_decode_float__STUB, 1, 0, SCM_OBJ(&extlib_decode_float__NAME), extlib_decode_float, NULL, NULL);
361
362 #if SCM_DEBUG_HELPER
363 static ScmObj extlib__25bignum_dump(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
364 {
365 ScmObj obj_scm;
366 ScmObj obj;
367 SCM_ENTER_SUBR("%bignum-dump");
368 obj_scm = SCM_ARGREF(0);
369 obj = (obj_scm);
370 {
371 if (SCM_BIGNUMP(obj)) Scm_DumpBignum(SCM_BIGNUM(obj), SCM_CUROUT);
372 SCM_RETURN(SCM_UNDEFINED);
373 }
374 }
375
376 static SCM_DEFINE_STRING_CONST(extlib__25bignum_dump__NAME, "%bignum-dump", 12, 12);
377 static SCM_DEFINE_SUBR(extlib__25bignum_dump__STUB, 1, 0, SCM_OBJ(&extlib__25bignum_dump__NAME), extlib__25bignum_dump, NULL, NULL);
378
379 #endif /*SCM_DEBUG_HELPER*/
380 static ScmObj extlib_min_26max(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
381 {
382 ScmObj arg0_scm;
383 ScmObj arg0;
384 ScmObj args_scm;
385 ScmObj args;
386 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
387 SCM_ENTER_SUBR("min&max");
388 arg0_scm = SCM_ARGREF(0);
389 arg0 = (arg0_scm);
390 args_scm = SCM_OPTARGS;
391 args = (args_scm);
392 {
393 ScmObj min, max;
394 Scm_MinMax(arg0, args, &min, &max);
395 SCM_RETURN(Scm_Values2(min, max));
396 }
397 }
398
399 static SCM_DEFINE_STRING_CONST(extlib_min_26max__NAME, "min&max", 7, 7);
400 static SCM_DEFINE_SUBR(extlib_min_26max__STUB, 1, 1, SCM_OBJ(&extlib_min_26max__NAME), extlib_min_26max, NULL, NULL);
401
402 static ScmObj extlib_quotient_26remainder(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
403 {
404 ScmObj n1_scm;
405 ScmObj n1;
406 ScmObj n2_scm;
407 ScmObj n2;
408 SCM_ENTER_SUBR("quotient&remainder");
409 n1_scm = SCM_ARGREF(0);
410 n1 = (n1_scm);
411 n2_scm = SCM_ARGREF(1);
412 n2 = (n2_scm);
413 {
414 ScmObj q, r;
415 q = Scm_Quotient(n1, n2, &r);
416 SCM_RETURN(Scm_Values2(q, r));
417 }
418 }
419
420 static SCM_DEFINE_STRING_CONST(extlib_quotient_26remainder__NAME, "quotient&remainder", 18, 18);
421 static SCM_DEFINE_SUBR(extlib_quotient_26remainder__STUB, 2, 0, SCM_OBJ(&extlib_quotient_26remainder__NAME), extlib_quotient_26remainder, NULL, NULL);
422
423 static ScmObj extlib_proper_listP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
424 {
425 ScmObj obj_scm;
426 ScmObj obj;
427 SCM_ENTER_SUBR("proper-list?");
428 obj_scm = SCM_ARGREF(0);
429 obj = (obj_scm);
430 {
431 {
432 int SCM_RESULT;
433 SCM_RESULT = SCM_PROPER_LIST_P(obj);
434 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
435 }
436 }
437 }
438
439 static SCM_DEFINE_STRING_CONST(extlib_proper_listP__NAME, "proper-list?", 12, 12);
440 static SCM_DEFINE_SUBR(extlib_proper_listP__STUB, 1, 0, SCM_OBJ(&extlib_proper_listP__NAME), extlib_proper_listP, NULL, NULL);
441
442 static ScmObj extlib_dotted_listP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
443 {
444 ScmObj obj_scm;
445 ScmObj obj;
446 SCM_ENTER_SUBR("dotted-list?");
447 obj_scm = SCM_ARGREF(0);
448 obj = (obj_scm);
449 {
450 {
451 int SCM_RESULT;
452 SCM_RESULT = SCM_DOTTED_LIST_P(obj);
453 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
454 }
455 }
456 }
457
458 static SCM_DEFINE_STRING_CONST(extlib_dotted_listP__NAME, "dotted-list?", 12, 12);
459 static SCM_DEFINE_SUBR(extlib_dotted_listP__STUB, 1, 0, SCM_OBJ(&extlib_dotted_listP__NAME), extlib_dotted_listP, NULL, NULL);
460
461 static ScmObj extlib_circular_listP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
462 {
463 ScmObj obj_scm;
464 ScmObj obj;
465 SCM_ENTER_SUBR("circular-list?");
466 obj_scm = SCM_ARGREF(0);
467 obj = (obj_scm);
468 {
469 {
470 int SCM_RESULT;
471 SCM_RESULT = SCM_CIRCULAR_LIST_P(obj);
472 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
473 }
474 }
475 }
476
477 static SCM_DEFINE_STRING_CONST(extlib_circular_listP__NAME, "circular-list?", 14, 14);
478 static SCM_DEFINE_SUBR(extlib_circular_listP__STUB, 1, 0, SCM_OBJ(&extlib_circular_listP__NAME), extlib_circular_listP, NULL, NULL);
479
480 static ScmObj extlib_make_list(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
481 {
482 ScmObj len_scm;
483 int len;
484 ScmObj fill_scm;
485 ScmObj fill;
486 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
487 SCM_ENTER_SUBR("make-list");
488 if (Scm_Length(SCM_OPTARGS) > 1)
489 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
490 len_scm = SCM_ARGREF(0);
491 if (!SCM_INTP(len_scm)) Scm_Error("small integer required, but got %S", len_scm);
492 len = SCM_INT_VALUE(len_scm);
493 if (SCM_NULLP(SCM_OPTARGS)) fill_scm = SCM_FALSE;
494 else {
495 fill_scm = SCM_CAR(SCM_OPTARGS);
496 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
497 }
498 fill = (fill_scm);
499 {
500 {
501 ScmObj SCM_RESULT;
502 SCM_RESULT = Scm_MakeList(len, fill);
503 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
504 }
505 }
506 }
507
508 static SCM_DEFINE_STRING_CONST(extlib_make_list__NAME, "make-list", 9, 9);
509 static SCM_DEFINE_SUBR(extlib_make_list__STUB, 1, 1, SCM_OBJ(&extlib_make_list__NAME), extlib_make_list, NULL, NULL);
510
511 static ScmObj extlib_acons(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
512 {
513 ScmObj caa_scm;
514 ScmObj caa;
515 ScmObj cda_scm;
516 ScmObj cda;
517 ScmObj cd_scm;
518 ScmObj cd;
519 SCM_ENTER_SUBR("acons");
520 caa_scm = SCM_ARGREF(0);
521 caa = (caa_scm);
522 cda_scm = SCM_ARGREF(1);
523 cda = (cda_scm);
524 cd_scm = SCM_ARGREF(2);
525 cd = (cd_scm);
526 {
527 {
528 ScmObj SCM_RESULT;
529 SCM_RESULT = Scm_Acons(caa, cda, cd);
530 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
531 }
532 }
533 }
534
535 static SCM_DEFINE_STRING_CONST(extlib_acons__NAME, "acons", 5, 5);
536 static SCM_DEFINE_SUBR(extlib_acons__STUB, 3, 0, SCM_OBJ(&extlib_acons__NAME), extlib_acons, NULL, NULL);
537
538 static ScmObj extlib_last_pair(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
539 {
540 ScmObj list_scm;
541 ScmObj list;
542 SCM_ENTER_SUBR("last-pair");
543 list_scm = SCM_ARGREF(0);
544 list = (list_scm);
545 {
546 {
547 ScmObj SCM_RESULT;
548 SCM_RESULT = Scm_LastPair(list);
549 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
550 }
551 }
552 }
553
554 static SCM_DEFINE_STRING_CONST(extlib_last_pair__NAME, "last-pair", 9, 9);
555 static SCM_DEFINE_SUBR(extlib_last_pair__STUB, 1, 0, SCM_OBJ(&extlib_last_pair__NAME), extlib_last_pair, NULL, NULL);
556
557 static ScmObj extlib_list_copy(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
558 {
559 ScmObj list_scm;
560 ScmObj list;
561 SCM_ENTER_SUBR("list-copy");
562 list_scm = SCM_ARGREF(0);
563 list = (list_scm);
564 {
565 {
566 ScmObj SCM_RESULT;
567 SCM_RESULT = Scm_CopyList(list);
568 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
569 }
570 }
571 }
572
573 static SCM_DEFINE_STRING_CONST(extlib_list_copy__NAME, "list-copy", 9, 9);
574 static SCM_DEFINE_SUBR(extlib_list_copy__STUB, 1, 0, SCM_OBJ(&extlib_list_copy__NAME), extlib_list_copy, NULL, NULL);
575
576 static ScmObj extlib_list_2a(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
577 {
578 ScmObj args_scm;
579 ScmObj args;
580 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
581 SCM_ENTER_SUBR("list*");
582 args_scm = SCM_OPTARGS;
583 args = (args_scm);
584 {
585 ScmObj head = SCM_NIL, tail = SCM_NIL, cp;
586 if (SCM_PAIRP(args)) {
587 SCM_FOR_EACH(cp, args) {
588 if (!SCM_PAIRP(SCM_CDR(cp))) {
589 if (SCM_NULLP(head)) head = SCM_CAR(cp);
590 else SCM_SET_CDR(tail, SCM_CAR(cp));
591 break;
592 }
593 SCM_APPEND1(head, tail, SCM_CAR(cp));
594 }
595 }
596 SCM_RETURN(head);
597 }
598 }
599
600 static SCM_DEFINE_STRING_CONST(extlib_list_2a__NAME, "list*", 5, 5);
601 static SCM_DEFINE_SUBR(extlib_list_2a__STUB, 0, 1, SCM_OBJ(&extlib_list_2a__NAME), extlib_list_2a, SCM_MAKE_INT(SCM_VM_LIST_STAR), NULL);
602
603 static ScmObj extlib__25delete(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
604 {
605 ScmObj obj_scm;
606 ScmObj obj;
607 ScmObj list_scm;
608 ScmObj list;
609 ScmObj cmpmode_scm;
610 ScmObj cmpmode;
611 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
612 SCM_ENTER_SUBR("%delete");
613 if (Scm_Length(SCM_OPTARGS) > 1)
614 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
615 obj_scm = SCM_ARGREF(0);
616 obj = (obj_scm);
617 list_scm = SCM_ARGREF(1);
618 if (!SCM_LISTP(list_scm)) Scm_Error("list required, but got %S", list_scm);
619 list = (list_scm);
620 if (SCM_NULLP(SCM_OPTARGS)) cmpmode_scm = SCM_UNBOUND;
621 else {
622 cmpmode_scm = SCM_CAR(SCM_OPTARGS);
623 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
624 }
625 cmpmode = (cmpmode_scm);
626 {
627 {
628 ScmObj SCM_RESULT;
629 SCM_RESULT = (Scm_Delete(obj, list, getcmpmode(cmpmode)));
630 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
631 }
632 }
633 }
634
635 static SCM_DEFINE_STRING_CONST(extlib__25delete__NAME, "%delete", 7, 7);
636 static SCM_DEFINE_SUBR(extlib__25delete__STUB, 2, 1, SCM_OBJ(&extlib__25delete__NAME), extlib__25delete, NULL, NULL);
637
638 static ScmObj extlib__25deleteX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
639 {
640 ScmObj obj_scm;
641 ScmObj obj;
642 ScmObj list_scm;
643 ScmObj list;
644 ScmObj cmpmode_scm;
645 ScmObj cmpmode;
646 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
647 SCM_ENTER_SUBR("%delete!");
648 if (Scm_Length(SCM_OPTARGS) > 1)
649 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
650 obj_scm = SCM_ARGREF(0);
651 obj = (obj_scm);
652 list_scm = SCM_ARGREF(1);
653 if (!SCM_LISTP(list_scm)) Scm_Error("list required, but got %S", list_scm);
654 list = (list_scm);
655 if (SCM_NULLP(SCM_OPTARGS)) cmpmode_scm = SCM_UNBOUND;
656 else {
657 cmpmode_scm = SCM_CAR(SCM_OPTARGS);
658 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
659 }
660 cmpmode = (cmpmode_scm);
661 {
662 {
663 ScmObj SCM_RESULT;
664 SCM_RESULT = (Scm_DeleteX(obj, list, getcmpmode(cmpmode)));
665 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
666 }
667 }
668 }
669
670 static SCM_DEFINE_STRING_CONST(extlib__25deleteX__NAME, "%delete!", 8, 8);
671 static SCM_DEFINE_SUBR(extlib__25deleteX__STUB, 2, 1, SCM_OBJ(&extlib__25deleteX__NAME), extlib__25deleteX, NULL, NULL);
672
673 static ScmObj extlib__25delete_duplicates(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
674 {
675 ScmObj list_scm;
676 ScmObj list;
677 ScmObj cmpmode_scm;
678 ScmObj cmpmode;
679 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
680 SCM_ENTER_SUBR("%delete-duplicates");
681 if (Scm_Length(SCM_OPTARGS) > 1)
682 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
683 list_scm = SCM_ARGREF(0);
684 if (!SCM_LISTP(list_scm)) Scm_Error("list required, but got %S", list_scm);
685 list = (list_scm);
686 if (SCM_NULLP(SCM_OPTARGS)) cmpmode_scm = SCM_UNBOUND;
687 else {
688 cmpmode_scm = SCM_CAR(SCM_OPTARGS);
689 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
690 }
691 cmpmode = (cmpmode_scm);
692 {
693 {
694 ScmObj SCM_RESULT;
695 SCM_RESULT = (Scm_DeleteDuplicates(list, getcmpmode(cmpmode)));
696 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
697 }
698 }
699 }
700
701 static SCM_DEFINE_STRING_CONST(extlib__25delete_duplicates__NAME, "%delete-duplicates", 18, 18);
702 static SCM_DEFINE_SUBR(extlib__25delete_duplicates__STUB, 1, 1, SCM_OBJ(&extlib__25delete_duplicates__NAME), extlib__25delete_duplicates, NULL, NULL);
703
704 static ScmObj extlib__25delete_duplicatesX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
705 {
706 ScmObj list_scm;
707 ScmObj list;
708 ScmObj cmpmode_scm;
709 ScmObj cmpmode;
710 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
711 SCM_ENTER_SUBR("%delete-duplicates!");
712 if (Scm_Length(SCM_OPTARGS) > 1)
713 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
714 list_scm = SCM_ARGREF(0);
715 if (!SCM_LISTP(list_scm)) Scm_Error("list required, but got %S", list_scm);
716 list = (list_scm);
717 if (SCM_NULLP(SCM_OPTARGS)) cmpmode_scm = SCM_UNBOUND;
718 else {
719 cmpmode_scm = SCM_CAR(SCM_OPTARGS);
720 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
721 }
722 cmpmode = (cmpmode_scm);
723 {
724 {
725 ScmObj SCM_RESULT;
726 SCM_RESULT = (Scm_DeleteDuplicatesX(list, getcmpmode(cmpmode)));
727 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
728 }
729 }
730 }
731
732 static SCM_DEFINE_STRING_CONST(extlib__25delete_duplicatesX__NAME, "%delete-duplicates!", 19, 19);
733 static SCM_DEFINE_SUBR(extlib__25delete_duplicatesX__STUB, 1, 1, SCM_OBJ(&extlib__25delete_duplicatesX__NAME), extlib__25delete_duplicatesX, NULL, NULL);
734
735 static ScmObj extlib__25alist_delete(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
736 {
737 ScmObj elt_scm;
738 ScmObj elt;
739 ScmObj list_scm;
740 ScmObj list;
741 ScmObj cmpmode_scm;
742 ScmObj cmpmode;
743 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
744 SCM_ENTER_SUBR("%alist-delete");
745 if (Scm_Length(SCM_OPTARGS) > 1)
746 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
747 elt_scm = SCM_ARGREF(0);
748 elt = (elt_scm);
749 list_scm = SCM_ARGREF(1);
750 if (!SCM_LISTP(list_scm)) Scm_Error("list required, but got %S", list_scm);
751 list = (list_scm);
752 if (SCM_NULLP(SCM_OPTARGS)) cmpmode_scm = SCM_UNBOUND;
753 else {
754 cmpmode_scm = SCM_CAR(SCM_OPTARGS);
755 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
756 }
757 cmpmode = (cmpmode_scm);
758 {
759 {
760 ScmObj SCM_RESULT;
761 SCM_RESULT = (Scm_AssocDelete(elt, list, getcmpmode(cmpmode)));
762 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
763 }
764 }
765 }
766
767 static SCM_DEFINE_STRING_CONST(extlib__25alist_delete__NAME, "%alist-delete", 13, 13);
768 static SCM_DEFINE_SUBR(extlib__25alist_delete__STUB, 2, 1, SCM_OBJ(&extlib__25alist_delete__NAME), extlib__25alist_delete, NULL, NULL);
769
770 static ScmObj extlib__25alist_deleteX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
771 {
772 ScmObj elt_scm;
773 ScmObj elt;
774 ScmObj list_scm;
775 ScmObj list;
776 ScmObj cmpmode_scm;
777 ScmObj cmpmode;
778 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
779 SCM_ENTER_SUBR("%alist-delete!");
780 if (Scm_Length(SCM_OPTARGS) > 1)
781 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
782 elt_scm = SCM_ARGREF(0);
783 elt = (elt_scm);
784 list_scm = SCM_ARGREF(1);
785 if (!SCM_LISTP(list_scm)) Scm_Error("list required, but got %S", list_scm);
786 list = (list_scm);
787 if (SCM_NULLP(SCM_OPTARGS)) cmpmode_scm = SCM_UNBOUND;
788 else {
789 cmpmode_scm = SCM_CAR(SCM_OPTARGS);
790 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
791 }
792 cmpmode = (cmpmode_scm);
793 {
794 {
795 ScmObj SCM_RESULT;
796 SCM_RESULT = (Scm_AssocDeleteX(elt, list, getcmpmode(cmpmode)));
797 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
798 }
799 }
800 }
801
802 static SCM_DEFINE_STRING_CONST(extlib__25alist_deleteX__NAME, "%alist-delete!", 14, 14);
803 static SCM_DEFINE_SUBR(extlib__25alist_deleteX__STUB, 2, 1, SCM_OBJ(&extlib__25alist_deleteX__NAME), extlib__25alist_deleteX, NULL, NULL);
804
805 static ScmObj extlib_appendX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
806 {
807 ScmObj list_scm;
808 ScmObj list;
809 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
810 SCM_ENTER_SUBR("append!");
811 list_scm = SCM_OPTARGS;
812 list = (list_scm);
813 {
814 ScmObj cp, h = SCM_NIL, t = SCM_NIL;
815 SCM_FOR_EACH(cp, list) {
816 /* allow non-list argument at the last position */
817 if (!SCM_PAIRP(SCM_CAR(cp)) && SCM_NULLP(SCM_CDR(cp))) {
818 if (SCM_NULLP(h)) return SCM_CAR(cp);
819 else { SCM_SET_CDR(t, SCM_CAR(cp)); return h; }
820 }
821 SCM_APPEND(h, t, SCM_CAR(cp));
822 }
823 SCM_RETURN(h);
824 }
825 }
826
827 static SCM_DEFINE_STRING_CONST(extlib_appendX__NAME, "append!", 7, 7);
828 static SCM_DEFINE_SUBR(extlib_appendX__STUB, 0, 1, SCM_OBJ(&extlib_appendX__NAME), extlib_appendX, NULL, NULL);
829
830 static ScmObj extlib_reverseX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
831 {
832 ScmObj list_scm;
833 ScmObj list;
834 SCM_ENTER_SUBR("reverse!");
835 list_scm = SCM_ARGREF(0);
836 list = (list_scm);
837 {
838 {
839 ScmObj SCM_RESULT;
840 SCM_RESULT = Scm_ReverseX(list);
841 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
842 }
843 }
844 }
845
846 static SCM_DEFINE_STRING_CONST(extlib_reverseX__NAME, "reverse!", 8, 8);
847 static SCM_DEFINE_SUBR(extlib_reverseX__STUB, 1, 0, SCM_OBJ(&extlib_reverseX__NAME), extlib_reverseX, NULL, NULL);
848
849 static ScmObj extlib__25sort(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
850 {
851 ScmObj seq_scm;
852 ScmObj seq;
853 SCM_ENTER_SUBR("%sort");
854 seq_scm = SCM_ARGREF(0);
855 seq = (seq_scm);
856 {
857 if (SCM_VECTORP(seq)) {
858 ScmObj r = Scm_VectorCopy(SCM_VECTOR(seq), 0, -1, SCM_UNDEFINED);
859 Scm_SortArray(SCM_VECTOR_ELEMENTS(r), SCM_VECTOR_SIZE(r), SCM_FALSE);
860 SCM_RETURN(r);
861 } else if (Scm_Length(seq) >= 0) {
862 SCM_RETURN(Scm_SortList(seq, SCM_FALSE));
863 } else {
864 Scm_Error("proper list or vector required, but got %S", seq);
865 SCM_RETURN(SCM_UNDEFINED);
866 }
867 }
868 }
869
870 static SCM_DEFINE_STRING_CONST(extlib__25sort__NAME, "%sort", 5, 5);
871 static SCM_DEFINE_SUBR(extlib__25sort__STUB, 1, 0, SCM_OBJ(&extlib__25sort__NAME), extlib__25sort, NULL, NULL);
872
873 static ScmObj extlib__25sortX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
874 {
875 ScmObj seq_scm;
876 ScmObj seq;
877 SCM_ENTER_SUBR("%sort!");
878 seq_scm = SCM_ARGREF(0);
879 seq = (seq_scm);
880 {
881 if (SCM_VECTORP(seq)) {
882 Scm_SortArray(SCM_VECTOR_ELEMENTS(seq), SCM_VECTOR_SIZE(seq), SCM_FALSE);
883 SCM_RETURN(seq);
884 } else if (Scm_Length(seq) >= 0) {
885 SCM_RETURN(Scm_SortListX(seq, SCM_FALSE));
886 } else {
887 Scm_Error("proper list or vector required, but got %S", seq);
888 SCM_RETURN(SCM_UNDEFINED);
889 }
890 }
891 }
892
893 static SCM_DEFINE_STRING_CONST(extlib__25sortX__NAME, "%sort!", 6, 6);
894 static SCM_DEFINE_SUBR(extlib__25sortX__STUB, 1, 0, SCM_OBJ(&extlib__25sortX__NAME), extlib__25sortX, NULL, NULL);
895
896 static ScmObj extlib_monotonic_merge(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
897 {
898 ScmObj start_scm;
899 ScmObj start;
900 ScmObj sequences_scm;
901 ScmObj sequences;
902 SCM_ENTER_SUBR("monotonic-merge");
903 start_scm = SCM_ARGREF(0);
904 start = (start_scm);
905 sequences_scm = SCM_ARGREF(1);
906 if (!SCM_LISTP(sequences_scm)) Scm_Error("list required, but got %S", sequences_scm);
907 sequences = (sequences_scm);
908 {
909 {
910 ScmObj SCM_RESULT;
911 SCM_RESULT = Scm_MonotonicMerge(start, sequences);
912 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
913 }
914 }
915 }
916
917 static SCM_DEFINE_STRING_CONST(extlib_monotonic_merge__NAME, "monotonic-merge", 15, 15);
918 static SCM_DEFINE_SUBR(extlib_monotonic_merge__STUB, 2, 0, SCM_OBJ(&extlib_monotonic_merge__NAME), extlib_monotonic_merge, NULL, NULL);
919
920 static ScmObj extlib_gensym(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
921 {
922 ScmObj prefix_scm;
923 ScmObj prefix;
924 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
925 SCM_ENTER_SUBR("gensym");
926 if (Scm_Length(SCM_OPTARGS) > 1)
927 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
928 if (SCM_NULLP(SCM_OPTARGS)) prefix_scm = SCM_UNBOUND;
929 else {
930 prefix_scm = SCM_CAR(SCM_OPTARGS);
931 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
932 }
933 prefix = (prefix_scm);
934 {
935 ScmString *p = NULL;
936 if (prefix != SCM_UNBOUND) {
937 if (!SCM_STRINGP(prefix))
938 Scm_Error("string expected, but got %S", prefix);
939 p = SCM_STRING(prefix);
940 }
941 SCM_RETURN(Scm_Gensym(p));
942 }
943 }
944
945 static SCM_DEFINE_STRING_CONST(extlib_gensym__NAME, "gensym", 6, 6);
946 static SCM_DEFINE_SUBR(extlib_gensym__STUB, 0, 1, SCM_OBJ(&extlib_gensym__NAME), extlib_gensym, NULL, NULL);
947
948 static ScmObj extlib_keywordP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
949 {
950 ScmObj obj_scm;
951 ScmObj obj;
952 SCM_ENTER_SUBR("keyword?");
953 obj_scm = SCM_ARGREF(0);
954 obj = (obj_scm);
955 {
956 {
957 int SCM_RESULT;
958 SCM_RESULT = SCM_KEYWORDP(obj);
959 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
960 }
961 }
962 }
963
964 static SCM_DEFINE_STRING_CONST(extlib_keywordP__NAME, "keyword?", 8, 8);
965 static SCM_DEFINE_SUBR(extlib_keywordP__STUB, 1, 0, SCM_OBJ(&extlib_keywordP__NAME), extlib_keywordP, NULL, NULL);
966
967 static ScmObj extlib_make_keyword(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
968 {
969 ScmObj name_scm;
970 ScmObj name;
971 SCM_ENTER_SUBR("make-keyword");
972 name_scm = SCM_ARGREF(0);
973 name = (name_scm);
974 {
975 ScmString *sname = NULL;
976 if (SCM_STRINGP(name)) sname = SCM_STRING(name);
977 else if (SCM_SYMBOLP(name)) sname = SCM_SYMBOL_NAME(name);
978 else Scm_Error("string or symbol required, but got %S", name);
979 SCM_RETURN(Scm_MakeKeyword(sname));
980 }
981 }
982
983 static SCM_DEFINE_STRING_CONST(extlib_make_keyword__NAME, "make-keyword", 12, 12);
984 static SCM_DEFINE_SUBR(extlib_make_keyword__STUB, 1, 0, SCM_OBJ(&extlib_make_keyword__NAME), extlib_make_keyword, NULL, NULL);
985
986 static ScmObj extlib_get_keyword(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
987 {
988 ScmObj key_scm;
989 ScmObj key;
990 ScmObj list_scm;
991 ScmObj list;
992 ScmObj fallback_scm;
993 ScmObj fallback;
994 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
995 SCM_ENTER_SUBR("get-keyword");
996 if (Scm_Length(SCM_OPTARGS) > 1)
997 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
998 key_scm = SCM_ARGREF(0);
999 key = (key_scm);
1000 list_scm = SCM_ARGREF(1);
1001 list = (list_scm);
1002 if (SCM_NULLP(SCM_OPTARGS)) fallback_scm = SCM_UNBOUND;
1003 else {
1004 fallback_scm = SCM_CAR(SCM_OPTARGS);
1005 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
1006 }
1007 fallback = (fallback_scm);
1008 {
1009 {
1010 ScmObj SCM_RESULT;
1011 SCM_RESULT = Scm_GetKeyword(key, list, fallback);
1012 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1013 }
1014 }
1015 }
1016
1017 static SCM_DEFINE_STRING_CONST(extlib_get_keyword__NAME, "get-keyword", 11, 11);
1018 static SCM_DEFINE_SUBR(extlib_get_keyword__STUB, 2, 1, SCM_OBJ(&extlib_get_keyword__NAME), extlib_get_keyword, NULL, NULL);
1019
1020 static ScmObj extlib_delete_keyword(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1021 {
1022 ScmObj key_scm;
1023 ScmObj key;
1024 ScmObj list_scm;
1025 ScmObj list;
1026 SCM_ENTER_SUBR("delete-keyword");
1027 key_scm = SCM_ARGREF(0);
1028 key = (key_scm);
1029 list_scm = SCM_ARGREF(1);
1030 list = (list_scm);
1031 {
1032 {
1033 ScmObj SCM_RESULT;
1034 SCM_RESULT = Scm_DeleteKeyword(key, list);
1035 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1036 }
1037 }
1038 }
1039
1040 static SCM_DEFINE_STRING_CONST(extlib_delete_keyword__NAME, "delete-keyword", 14, 14);
1041 static SCM_DEFINE_SUBR(extlib_delete_keyword__STUB, 2, 0, SCM_OBJ(&extlib_delete_keyword__NAME), extlib_delete_keyword, NULL, NULL);
1042
1043 static ScmObj extlib_delete_keywordX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1044 {
1045 ScmObj key_scm;
1046 ScmObj key;
1047 ScmObj list_scm;
1048 ScmObj list;
1049 SCM_ENTER_SUBR("delete-keyword!");
1050 key_scm = SCM_ARGREF(0);
1051 key = (key_scm);
1052 list_scm = SCM_ARGREF(1);
1053 list = (list_scm);
1054 {
1055 {
1056 ScmObj SCM_RESULT;
1057 SCM_RESULT = Scm_DeleteKeywordX(key, list);
1058 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1059 }
1060 }
1061 }
1062
1063 static SCM_DEFINE_STRING_CONST(extlib_delete_keywordX__NAME, "delete-keyword!", 15, 15);
1064 static SCM_DEFINE_SUBR(extlib_delete_keywordX__STUB, 2, 0, SCM_OBJ(&extlib_delete_keywordX__NAME), extlib_delete_keywordX, NULL, NULL);
1065
1066 static ScmObj extlib_keyword_TOstring(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1067 {
1068 ScmObj key_scm;
1069 ScmKeyword* key;
1070 SCM_ENTER_SUBR("keyword->string");
1071 key_scm = SCM_ARGREF(0);
1072 if (!SCM_KEYWORDP(key_scm)) Scm_Error("keyword required, but got %S", key_scm);
1073 key = SCM_KEYWORD(key_scm);
1074 {
1075 {
1076 ScmObj SCM_RESULT;
1077 SCM_RESULT = (SCM_OBJ(SCM_KEYWORD_NAME(key)));
1078 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1079 }
1080 }
1081 }
1082
1083 static SCM_DEFINE_STRING_CONST(extlib_keyword_TOstring__NAME, "keyword->string", 15, 15);
1084 static SCM_DEFINE_SUBR(extlib_keyword_TOstring__STUB, 1, 0, SCM_OBJ(&extlib_keyword_TOstring__NAME), extlib_keyword_TOstring, NULL, NULL);
1085
1086 static ScmObj extlib_identifierP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1087 {
1088 ScmObj obj_scm;
1089 ScmObj obj;
1090 SCM_ENTER_SUBR("identifier?");
1091 obj_scm = SCM_ARGREF(0);
1092 obj = (obj_scm);
1093 {
1094 {
1095 int SCM_RESULT;
1096 SCM_RESULT = SCM_IDENTIFIERP(obj);
1097 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
1098 }
1099 }
1100 }
1101
1102 static SCM_DEFINE_STRING_CONST(extlib_identifierP__NAME, "identifier?", 11, 11);
1103 static SCM_DEFINE_SUBR(extlib_identifierP__STUB, 1, 0, SCM_OBJ(&extlib_identifierP__NAME), extlib_identifierP, SCM_MAKE_INT(SCM_VM_IDENTIFIERP), NULL);
1104
1105 static ScmObj extlib_identifier_TOsymbol(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1106 {
1107 ScmObj obj_scm;
1108 ScmIdentifier* obj;
1109 SCM_ENTER_SUBR("identifier->symbol");
1110 obj_scm = SCM_ARGREF(0);
1111 if (!SCM_IDENTIFIERP(obj_scm)) Scm_Error("identifier required, but got %S", obj_scm);
1112 obj = SCM_IDENTIFIER(obj_scm);
1113 {
1114 {
1115 ScmObj SCM_RESULT;
1116 SCM_RESULT = (SCM_OBJ(SCM_IDENTIFIER(obj)->name));
1117 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1118 }
1119 }
1120 }
1121
1122 static SCM_DEFINE_STRING_CONST(extlib_identifier_TOsymbol__NAME, "identifier->symbol", 18, 18);
1123 static SCM_DEFINE_SUBR(extlib_identifier_TOsymbol__STUB, 1, 0, SCM_OBJ(&extlib_identifier_TOsymbol__NAME), extlib_identifier_TOsymbol, NULL, NULL);
1124
1125 static ScmObj extlib_digit_TOinteger(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1126 {
1127 ScmObj ch_scm;
1128 ScmChar ch;
1129 ScmObj radix_scm;
1130 int radix;
1131 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
1132 SCM_ENTER_SUBR("digit->integer");
1133 if (Scm_Length(SCM_OPTARGS) > 1)
1134 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
1135 ch_scm = SCM_ARGREF(0);
1136 if (!SCM_CHARP(ch_scm)) Scm_Error("character required, but got %S", ch_scm);
1137 ch = SCM_CHAR_VALUE(ch_scm);
1138 if (SCM_NULLP(SCM_OPTARGS)) radix_scm = Scm_MakeInteger(10);
1139 else {
1140 radix_scm = SCM_CAR(SCM_OPTARGS);
1141 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
1142 }
1143 if (!SCM_INTP(radix_scm)) Scm_Error("small integer required, but got %S", radix_scm);
1144 radix = SCM_INT_VALUE(radix_scm);
1145 {
1146 {
1147 ScmObj SCM_RESULT;
1148 int r;
1149 if (radix < 2 && radix > 36)
1150 Scm_Error("radix must be between 2 and 36, but got %d", radix);
1151 r = Scm_DigitToInt(ch, radix);
1152 SCM_RESULT = (r >= 0 ? SCM_MAKE_INT(r) : SCM_FALSE);
1153 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1154 }
1155 }
1156 }
1157
1158 static SCM_DEFINE_STRING_CONST(extlib_digit_TOinteger__NAME, "digit->integer", 14, 14);
1159 static SCM_DEFINE_SUBR(extlib_digit_TOinteger__STUB, 1, 1, SCM_OBJ(&extlib_digit_TOinteger__NAME), extlib_digit_TOinteger, NULL, NULL);
1160
1161 static ScmObj extlib_integer_TOdigit(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1162 {
1163 ScmObj n_scm;
1164 int n;
1165 ScmObj radix_scm;
1166 int radix;
1167 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
1168 SCM_ENTER_SUBR("integer->digit");
1169 if (Scm_Length(SCM_OPTARGS) > 1)
1170 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
1171 n_scm = SCM_ARGREF(0);
1172 if (!SCM_INTP(n_scm)) Scm_Error("small integer required, but got %S", n_scm);
1173 n = SCM_INT_VALUE(n_scm);
1174 if (SCM_NULLP(SCM_OPTARGS)) radix_scm = Scm_MakeInteger(10);
1175 else {
1176 radix_scm = SCM_CAR(SCM_OPTARGS);
1177 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
1178 }
1179 if (!SCM_INTP(radix_scm)) Scm_Error("small integer required, but got %S", radix_scm);
1180 radix = SCM_INT_VALUE(radix_scm);
1181 {
1182 {
1183 ScmObj SCM_RESULT;
1184 ScmChar r;
1185 if (radix < 2 || radix > 36)
1186 Scm_Error("radix must be between 2 and 36, but got %d", radix);
1187 r = Scm_IntToDigit(n, radix);
1188 return (r == SCM_CHAR_INVALID? SCM_FALSE : SCM_MAKE_CHAR(r));
1189 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1190 }
1191 }
1192 }
1193
1194 static SCM_DEFINE_STRING_CONST(extlib_integer_TOdigit__NAME, "integer->digit", 14, 14);
1195 static SCM_DEFINE_SUBR(extlib_integer_TOdigit__STUB, 1, 1, SCM_OBJ(&extlib_integer_TOdigit__NAME), extlib_integer_TOdigit, NULL, NULL);
1196
1197 static ScmObj extlib_ucs_TOchar(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1198 {
1199 ScmObj n_scm;
1200 int n;
1201 SCM_ENTER_SUBR("ucs->char");
1202 n_scm = SCM_ARGREF(0);
1203 if (!SCM_EXACTP(n_scm)) Scm_Error("C integer required, but got %S", n_scm);
1204 n = Scm_GetInteger(n_scm);
1205 {
1206 ScmChar ch = Scm_UcsToChar(n);
1207 if (ch == SCM_CHAR_INVALID) SCM_RETURN(SCM_FALSE);
1208 else SCM_RETURN(SCM_MAKE_CHAR(ch));
1209 }
1210 }
1211
1212 static SCM_DEFINE_STRING_CONST(extlib_ucs_TOchar__NAME, "ucs->char", 9, 9);
1213 static SCM_DEFINE_SUBR(extlib_ucs_TOchar__STUB, 1, 0, SCM_OBJ(&extlib_ucs_TOchar__NAME), extlib_ucs_TOchar, NULL, NULL);
1214
1215 static ScmObj extlib_char_TOucs(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1216 {
1217 ScmObj c_scm;
1218 ScmChar c;
1219 SCM_ENTER_SUBR("char->ucs");
1220 c_scm = SCM_ARGREF(0);
1221 if (!SCM_CHARP(c_scm)) Scm_Error("character required, but got %S", c_scm);
1222 c = SCM_CHAR_VALUE(c_scm);
1223 {
1224 int ucs = Scm_CharToUcs(c);
1225 if (ucs < 0) SCM_RETURN(SCM_FALSE);
1226 else SCM_RETURN(Scm_MakeInteger(ucs));
1227 }
1228 }
1229
1230 static SCM_DEFINE_STRING_CONST(extlib_char_TOucs__NAME, "char->ucs", 9, 9);
1231 static SCM_DEFINE_SUBR(extlib_char_TOucs__STUB, 1, 0, SCM_OBJ(&extlib_char_TOucs__NAME), extlib_char_TOucs, NULL, NULL);
1232
1233 static ScmObj extlib_gauche_character_encoding(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1234 {
1235 SCM_ENTER_SUBR("gauche-character-encoding");
1236 {
1237 {
1238 ScmObj SCM_RESULT;
1239 SCM_RESULT = Scm_CharEncodingName();
1240 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1241 }
1242 }
1243 }
1244
1245 static SCM_DEFINE_STRING_CONST(extlib_gauche_character_encoding__NAME, "gauche-character-encoding", 25, 25);
1246 static SCM_DEFINE_SUBR(extlib_gauche_character_encoding__STUB, 0, 0, SCM_OBJ(&extlib_gauche_character_encoding__NAME), extlib_gauche_character_encoding, NULL, NULL);
1247
1248 static ScmObj extlib_supported_character_encodings(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1249 {
1250 SCM_ENTER_SUBR("supported-character-encodings");
1251 {
1252 {
1253 ScmObj SCM_RESULT;
1254 SCM_RESULT = (Scm_ConstCStringArrayToList(Scm_SupportedCharacterEncodings(), -1));
1255 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1256 }
1257 }
1258 }
1259
1260 static SCM_DEFINE_STRING_CONST(extlib_supported_character_encodings__NAME, "supported-character-encodings", 29, 29);
1261 static SCM_DEFINE_SUBR(extlib_supported_character_encodings__STUB, 0, 0, SCM_OBJ(&extlib_supported_character_encodings__NAME), extlib_supported_character_encodings, NULL, NULL);
1262
1263 static ScmObj extlib_supported_character_encodingP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1264 {
1265 ScmObj encoding_scm;
1266 const char * encoding;
1267 SCM_ENTER_SUBR("supported-character-encoding?");
1268 encoding_scm = SCM_ARGREF(0);
1269 if (!SCM_STRINGP(encoding_scm)) Scm_Error("const C string required, but got %S", encoding_scm);
1270 encoding = SCM_STRING_CONST_CSTRING(encoding_scm);
1271 {
1272 {
1273 int SCM_RESULT;
1274 SCM_RESULT = Scm_SupportedCharacterEncodingP(encoding);
1275 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
1276 }
1277 }
1278 }
1279
1280 static SCM_DEFINE_STRING_CONST(extlib_supported_character_encodingP__NAME, "supported-character-encoding?", 29, 29);
1281 static SCM_DEFINE_SUBR(extlib_supported_character_encodingP__STUB, 1, 0, SCM_OBJ(&extlib_supported_character_encodingP__NAME), extlib_supported_character_encodingP, NULL, NULL);
1282
1283 static SCM_DEFINE_STRING_CONST(extlib__2achar_code_max_2a__VAR__NAME, "*char-code-max*", 15, 15);
1284 static ScmObj extlib__2achar_code_max_2a__VAR = SCM_UNBOUND;
1285 static ScmObj extlib_char_setP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1286 {
1287 ScmObj obj_scm;
1288 ScmObj obj;
1289 SCM_ENTER_SUBR("char-set?");
1290 obj_scm = SCM_ARGREF(0);
1291 obj = (obj_scm);
1292 {
1293 {
1294 int SCM_RESULT;
1295 SCM_RESULT = SCM_CHARSETP(obj);
1296 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
1297 }
1298 }
1299 }
1300
1301 static SCM_DEFINE_STRING_CONST(extlib_char_setP__NAME, "char-set?", 9, 9);
1302 static SCM_DEFINE_SUBR(extlib_char_setP__STUB, 1, 0, SCM_OBJ(&extlib_char_setP__NAME), extlib_char_setP, NULL, NULL);
1303
1304 static void char_set_add(ScmCharSet *cs, ScmObj chars)
1305 { ScmObj cp; ScmChar ch;
1306 SCM_FOR_EACH(cp, chars) {
1307 if (!SCM_CHARP(SCM_CAR(cp)))
1308 Scm_Error("character required, but got %S", SCM_CAR(cp));
1309 ch = SCM_CHAR_VALUE(SCM_CAR(cp));
1310 Scm_CharSetAddRange(cs, ch, ch);
1311 }
1312 }
1313 static ScmObj extlib__25char_set_equalP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1314 {
1315 ScmObj x_scm;
1316 ScmCharSet* x;
1317 ScmObj y_scm;
1318 ScmCharSet* y;
1319 SCM_ENTER_SUBR("%char-set-equal?");
1320 x_scm = SCM_ARGREF(0);
1321 if (!SCM_CHARSETP(x_scm)) Scm_Error("char-set required, but got %S", x_scm);
1322 x = SCM_CHARSET(x_scm);
1323 y_scm = SCM_ARGREF(1);
1324 if (!SCM_CHARSETP(y_scm)) Scm_Error("char-set required, but got %S", y_scm);
1325 y = SCM_CHARSET(y_scm);
1326 {
1327 {
1328 int SCM_RESULT;
1329 SCM_RESULT = Scm_CharSetEq(x, y);
1330 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
1331 }
1332 }
1333 }
1334
1335 static SCM_DEFINE_STRING_CONST(extlib__25char_set_equalP__NAME, "%char-set-equal?", 16, 16);
1336 static SCM_DEFINE_SUBR(extlib__25char_set_equalP__STUB, 2, 0, SCM_OBJ(&extlib__25char_set_equalP__NAME), extlib__25char_set_equalP, NULL, NULL);
1337
1338 static ScmObj extlib__25char_set_LT_3dP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1339 {
1340 ScmObj x_scm;
1341 ScmCharSet* x;
1342 ScmObj y_scm;
1343 ScmCharSet* y;
1344 SCM_ENTER_SUBR("%char-set<=?");
1345 x_scm = SCM_ARGREF(0);
1346 if (!SCM_CHARSETP(x_scm)) Scm_Error("char-set required, but got %S", x_scm);
1347 x = SCM_CHARSET(x_scm);
1348 y_scm = SCM_ARGREF(1);
1349 if (!SCM_CHARSETP(y_scm)) Scm_Error("char-set required, but got %S", y_scm);
1350 y = SCM_CHARSET(y_scm);
1351 {
1352 {
1353 int SCM_RESULT;
1354 SCM_RESULT = Scm_CharSetLE(x, y);
1355 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
1356 }
1357 }
1358 }
1359
1360 static SCM_DEFINE_STRING_CONST(extlib__25char_set_LT_3dP__NAME, "%char-set<=?", 12, 12);
1361 static SCM_DEFINE_SUBR(extlib__25char_set_LT_3dP__STUB, 2, 0, SCM_OBJ(&extlib__25char_set_LT_3dP__NAME), extlib__25char_set_LT_3dP, NULL, NULL);
1362
1363 static ScmObj extlib_char_set(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1364 {
1365 ScmObj chars_scm;
1366 ScmObj chars;
1367 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
1368 SCM_ENTER_SUBR("char-set");
1369 chars_scm = SCM_OPTARGS;
1370 chars = (chars_scm);
1371 {
1372 ScmCharSet *cs = SCM_CHARSET(Scm_MakeEmptyCharSet());
1373 char_set_add(cs, chars);
1374 SCM_RETURN(SCM_OBJ(cs));
1375 }
1376 }
1377
1378 static SCM_DEFINE_STRING_CONST(extlib_char_set__NAME, "char-set", 8, 8);
1379 static SCM_DEFINE_SUBR(extlib_char_set__STUB, 0, 1, SCM_OBJ(&extlib_char_set__NAME), extlib_char_set, NULL, NULL);
1380
1381 static ScmObj extlib_char_set_copy(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1382 {
1383 ScmObj cs_scm;
1384 ScmCharSet* cs;
1385 SCM_ENTER_SUBR("char-set-copy");
1386 cs_scm = SCM_ARGREF(0);
1387 if (!SCM_CHARSETP(cs_scm)) Scm_Error("char-set required, but got %S", cs_scm);
1388 cs = SCM_CHARSET(cs_scm);
1389 {
1390 {
1391 ScmObj SCM_RESULT;
1392 SCM_RESULT = Scm_CopyCharSet(cs);
1393 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1394 }
1395 }
1396 }
1397
1398 static SCM_DEFINE_STRING_CONST(extlib_char_set_copy__NAME, "char-set-copy", 13, 13);
1399 static SCM_DEFINE_SUBR(extlib_char_set_copy__STUB, 1, 0, SCM_OBJ(&extlib_char_set_copy__NAME), extlib_char_set_copy, NULL, NULL);
1400
1401 static ScmObj extlib__25char_set_add_charsX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1402 {
1403 ScmObj cs_scm;
1404 ScmCharSet* cs;
1405 ScmObj chars_scm;
1406 ScmObj chars;
1407 SCM_ENTER_SUBR("%char-set-add-chars!");
1408 cs_scm = SCM_ARGREF(0);
1409 if (!SCM_CHARSETP(cs_scm)) Scm_Error("char-set required, but got %S", cs_scm);
1410 cs = SCM_CHARSET(cs_scm);
1411 chars_scm = SCM_ARGREF(1);
1412 if (!SCM_LISTP(chars_scm)) Scm_Error("list required, but got %S", chars_scm);
1413 chars = (chars_scm);
1414 {
1415 char_set_add(cs, chars); SCM_RETURN(SCM_OBJ(cs));
1416 }
1417 }
1418
1419 static SCM_DEFINE_STRING_CONST(extlib__25char_set_add_charsX__NAME, "%char-set-add-chars!", 20, 20);
1420 static SCM_DEFINE_SUBR(extlib__25char_set_add_charsX__STUB, 2, 0, SCM_OBJ(&extlib__25char_set_add_charsX__NAME), extlib__25char_set_add_charsX, NULL, NULL);
1421
1422 static ScmObj extlib__25char_set_add_rangeX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1423 {
1424 ScmObj cs_scm;
1425 ScmCharSet* cs;
1426 ScmObj from_scm;
1427 ScmObj from;
1428 ScmObj to_scm;
1429 ScmObj to;
1430 SCM_ENTER_SUBR("%char-set-add-range!");
1431 cs_scm = SCM_ARGREF(0);
1432 if (!SCM_CHARSETP(cs_scm)) Scm_Error("char-set required, but got %S", cs_scm);
1433 cs = SCM_CHARSET(cs_scm);
1434 from_scm = SCM_ARGREF(1);
1435 from = (from_scm);
1436 to_scm = SCM_ARGREF(2);
1437 to = (to_scm);
1438 {
1439 long fromc = -1, toc = -1;
1440 if (SCM_EXACTP(from)) fromc = Scm_GetInteger(from);
1441 else if (SCM_CHARP(from)) fromc = SCM_CHAR_VALUE(from);
1442 if (fromc < 0) Scm_Error("character or positive integer required, but got %S", from);
1443 if (fromc > SCM_CHAR_MAX) Scm_Error("argument out of range: %S", from);
1444 if (SCM_EXACTP(to)) toc = Scm_GetInteger(to);
1445 else if (SCM_CHARP(to)) toc = SCM_CHAR_VALUE(to);
1446 if (toc < 0) Scm_Error("character or positive integer required, but got %S", to);
1447 if (toc > SCM_CHAR_MAX) Scm_Error("argument out of range: %S", to);
1448 SCM_RETURN(Scm_CharSetAddRange(cs, (ScmChar)fromc, (ScmChar)toc));
1449 }
1450 }
1451
1452 static SCM_DEFINE_STRING_CONST(extlib__25char_set_add_rangeX__NAME, "%char-set-add-range!", 20, 20);
1453 static SCM_DEFINE_SUBR(extlib__25char_set_add_rangeX__STUB, 3, 0, SCM_OBJ(&extlib__25char_set_add_rangeX__NAME), extlib__25char_set_add_rangeX, NULL, NULL);
1454
1455 static ScmObj extlib__25char_set_addX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1456 {
1457 ScmObj dst_scm;
1458 ScmCharSet* dst;
1459 ScmObj src_scm;
1460 ScmCharSet* src;
1461 SCM_ENTER_SUBR("%char-set-add!");
1462 dst_scm = SCM_ARGREF(0);
1463 if (!SCM_CHARSETP(dst_scm)) Scm_Error("char-set required, but got %S", dst_scm);
1464 dst = SCM_CHARSET(dst_scm);
1465 src_scm = SCM_ARGREF(1);
1466 if (!SCM_CHARSETP(src_scm)) Scm_Error("char-set required, but got %S", src_scm);
1467 src = SCM_CHARSET(src_scm);
1468 {
1469 {
1470 ScmObj SCM_RESULT;
1471 SCM_RESULT = Scm_CharSetAdd(dst, src);
1472 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1473 }
1474 }
1475 }
1476
1477 static SCM_DEFINE_STRING_CONST(extlib__25char_set_addX__NAME, "%char-set-add!", 14, 14);
1478 static SCM_DEFINE_SUBR(extlib__25char_set_addX__STUB, 2, 0, SCM_OBJ(&extlib__25char_set_addX__NAME), extlib__25char_set_addX, NULL, NULL);
1479
1480 static ScmObj extlib_char_set_containsP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1481 {
1482 ScmObj cs_scm;
1483 ScmCharSet* cs;
1484 ScmObj ch_scm;
1485 ScmChar ch;
1486 SCM_ENTER_SUBR("char-set-contains?");
1487 cs_scm = SCM_ARGREF(0);
1488 if (!SCM_CHARSETP(cs_scm)) Scm_Error("char-set required, but got %S", cs_scm);
1489 cs = SCM_CHARSET(cs_scm);
1490 ch_scm = SCM_ARGREF(1);
1491 if (!SCM_CHARP(ch_scm)) Scm_Error("character required, but got %S", ch_scm);
1492 ch = SCM_CHAR_VALUE(ch_scm);
1493 {
1494 {
1495 int SCM_RESULT;
1496 SCM_RESULT = Scm_CharSetContains(cs, ch);
1497 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
1498 }
1499 }
1500 }
1501
1502 static SCM_DEFINE_STRING_CONST(extlib_char_set_containsP__NAME, "char-set-contains?", 18, 18);
1503 static SCM_DEFINE_SUBR(extlib_char_set_containsP__STUB, 2, 0, SCM_OBJ(&extlib_char_set_containsP__NAME), extlib_char_set_containsP, NULL, NULL);
1504
1505 static ScmObj extlib__25char_set_complementX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1506 {
1507 ScmObj cs_scm;
1508 ScmCharSet* cs;
1509 SCM_ENTER_SUBR("%char-set-complement!");
1510 cs_scm = SCM_ARGREF(0);
1511 if (!SCM_CHARSETP(cs_scm)) Scm_Error("char-set required, but got %S", cs_scm);
1512 cs = SCM_CHARSET(cs_scm);
1513 {
1514 {
1515 ScmObj SCM_RESULT;
1516 SCM_RESULT = Scm_CharSetComplement(cs);
1517 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1518 }
1519 }
1520 }
1521
1522 static SCM_DEFINE_STRING_CONST(extlib__25char_set_complementX__NAME, "%char-set-complement!", 21, 21);
1523 static SCM_DEFINE_SUBR(extlib__25char_set_complementX__STUB, 1, 0, SCM_OBJ(&extlib__25char_set_complementX__NAME), extlib__25char_set_complementX, NULL, NULL);
1524
1525 static ScmObj extlib__25char_set_ranges(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1526 {
1527 ScmObj cs_scm;
1528 ScmCharSet* cs;
1529 SCM_ENTER_SUBR("%char-set-ranges");
1530 cs_scm = SCM_ARGREF(0);
1531 if (!SCM_CHARSETP(cs_scm)) Scm_Error("char-set required, but got %S", cs_scm);
1532 cs = SCM_CHARSET(cs_scm);
1533 {
1534 {
1535 ScmObj SCM_RESULT;
1536 SCM_RESULT = Scm_CharSetRanges(cs);
1537 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1538 }
1539 }
1540 }
1541
1542 static SCM_DEFINE_STRING_CONST(extlib__25char_set_ranges__NAME, "%char-set-ranges", 16, 16);
1543 static SCM_DEFINE_SUBR(extlib__25char_set_ranges__STUB, 1, 0, SCM_OBJ(&extlib__25char_set_ranges__NAME), extlib__25char_set_ranges, NULL, NULL);
1544
1545 static ScmObj extlib__25char_set_predefined(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1546 {
1547 ScmObj num_scm;
1548 int num;
1549 SCM_ENTER_SUBR("%char-set-predefined");
1550 num_scm = SCM_ARGREF(0);
1551 if (!SCM_INTP(num_scm)) Scm_Error("small integer required, but got %S", num_scm);
1552 num = SCM_INT_VALUE(num_scm);
1553 {
1554 {
1555 ScmObj SCM_RESULT;
1556 SCM_RESULT = Scm_GetStandardCharSet(num);
1557 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1558 }
1559 }
1560 }
1561
1562 static SCM_DEFINE_STRING_CONST(extlib__25char_set_predefined__NAME, "%char-set-predefined", 20, 20);
1563 static SCM_DEFINE_SUBR(extlib__25char_set_predefined__STUB, 1, 0, SCM_OBJ(&extlib__25char_set_predefined__NAME), extlib__25char_set_predefined, NULL, NULL);
1564
1565 #if SCM_DEBUG_HELPER
1566 static ScmObj extlib__25char_set_dump(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1567 {
1568 ScmObj cs_scm;
1569 ScmCharSet* cs;
1570 SCM_ENTER_SUBR("%char-set-dump");
1571 cs_scm = SCM_ARGREF(0);
1572 if (!SCM_CHARSETP(cs_scm)) Scm_Error("char-set required, but got %S", cs_scm);
1573 cs = SCM_CHARSET(cs_scm);
1574 {
1575 Scm_CharSetDump(cs, SCM_CUROUT);
1576 SCM_RETURN(SCM_UNDEFINED);
1577 }
1578 }
1579
1580 static SCM_DEFINE_STRING_CONST(extlib__25char_set_dump__NAME, "%char-set-dump", 14, 14);
1581 static SCM_DEFINE_SUBR(extlib__25char_set_dump__STUB, 1, 0, SCM_OBJ(&extlib__25char_set_dump__NAME), extlib__25char_set_dump, NULL, NULL);
1582
1583 #endif /*SCM_DEBUG_HELPER*/
1584 static ScmObj extlib_string_incompleteP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1585 {
1586 ScmObj obj_scm;
1587 ScmObj obj;
1588 SCM_ENTER_SUBR("string-incomplete?");
1589 obj_scm = SCM_ARGREF(0);
1590 obj = (obj_scm);
1591 {
1592 {
1593 int SCM_RESULT;
1594 SCM_RESULT = (SCM_STRINGP(obj)&&SCM_STRING_INCOMPLETE_P(obj));
1595 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
1596 }
1597 }
1598 }
1599
1600 static SCM_DEFINE_STRING_CONST(extlib_string_incompleteP__NAME, "string-incomplete?", 18, 18);
1601 static SCM_DEFINE_SUBR(extlib_string_incompleteP__STUB, 1, 0, SCM_OBJ(&extlib_string_incompleteP__NAME), extlib_string_incompleteP, NULL, NULL);
1602
1603 static ScmObj extlib_string_immutableP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1604 {
1605 ScmObj obj_scm;
1606 ScmObj obj;
1607 SCM_ENTER_SUBR("string-immutable?");
1608 obj_scm = SCM_ARGREF(0);
1609 obj = (obj_scm);
1610 {
1611 {
1612 int SCM_RESULT;
1613 SCM_RESULT = (SCM_STRINGP(obj)&&SCM_STRING_IMMUTABLE_P(obj));
1614 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
1615 }
1616 }
1617 }
1618
1619 static SCM_DEFINE_STRING_CONST(extlib_string_immutableP__NAME, "string-immutable?", 17, 17);
1620 static SCM_DEFINE_SUBR(extlib_string_immutableP__STUB, 1, 0, SCM_OBJ(&extlib_string_immutableP__NAME), extlib_string_immutableP, NULL, NULL);
1621
1622 static ScmObj extlib_string_complete_TOincompleteX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1623 {
1624 ScmObj str_scm;
1625 ScmString* str;
1626 SCM_ENTER_SUBR("string-complete->incomplete!");
1627 str_scm = SCM_ARGREF(0);
1628 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1629 str = SCM_STRING(str_scm);
1630 {
1631 {
1632 ScmObj SCM_RESULT;
1633 SCM_RESULT = Scm_StringCompleteToIncompleteX(str);
1634 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1635 }
1636 }
1637 }
1638
1639 static SCM_DEFINE_STRING_CONST(extlib_string_complete_TOincompleteX__NAME, "string-complete->incomplete!", 28, 28);
1640 static SCM_DEFINE_SUBR(extlib_string_complete_TOincompleteX__STUB, 1, 0, SCM_OBJ(&extlib_string_complete_TOincompleteX__NAME), extlib_string_complete_TOincompleteX, NULL, NULL);
1641
1642 static ScmObj extlib_string_incomplete_TOcompleteX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1643 {
1644 ScmObj str_scm;
1645 ScmString* str;
1646 SCM_ENTER_SUBR("string-incomplete->complete!");
1647 str_scm = SCM_ARGREF(0);
1648 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1649 str = SCM_STRING(str_scm);
1650 {
1651 {
1652 ScmObj SCM_RESULT;
1653 SCM_RESULT = Scm_StringIncompleteToCompleteX(str);
1654 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1655 }
1656 }
1657 }
1658
1659 static SCM_DEFINE_STRING_CONST(extlib_string_incomplete_TOcompleteX__NAME, "string-incomplete->complete!", 28, 28);
1660 static SCM_DEFINE_SUBR(extlib_string_incomplete_TOcompleteX__STUB, 1, 0, SCM_OBJ(&extlib_string_incomplete_TOcompleteX__NAME), extlib_string_incomplete_TOcompleteX, NULL, NULL);
1661
1662 static ScmObj extlib_string_complete_TOincomplete(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1663 {
1664 ScmObj str_scm;
1665 ScmString* str;
1666 SCM_ENTER_SUBR("string-complete->incomplete");
1667 str_scm = SCM_ARGREF(0);
1668 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1669 str = SCM_STRING(str_scm);
1670 {
1671 {
1672 ScmObj SCM_RESULT;
1673 SCM_RESULT = Scm_StringCompleteToIncomplete(str);
1674 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1675 }
1676 }
1677 }
1678
1679 static SCM_DEFINE_STRING_CONST(extlib_string_complete_TOincomplete__NAME, "string-complete->incomplete", 27, 27);
1680 static SCM_DEFINE_SUBR(extlib_string_complete_TOincomplete__STUB, 1, 0, SCM_OBJ(&extlib_string_complete_TOincomplete__NAME), extlib_string_complete_TOincomplete, NULL, NULL);
1681
1682 static ScmObj extlib_string_incomplete_TOcomplete(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1683 {
1684 ScmObj str_scm;
1685 ScmString* str;
1686 SCM_ENTER_SUBR("string-incomplete->complete");
1687 str_scm = SCM_ARGREF(0);
1688 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1689 str = SCM_STRING(str_scm);
1690 {
1691 {
1692 ScmObj SCM_RESULT;
1693 SCM_RESULT = Scm_StringIncompleteToComplete(str);
1694 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1695 }
1696 }
1697 }
1698
1699 static SCM_DEFINE_STRING_CONST(extlib_string_incomplete_TOcomplete__NAME, "string-incomplete->complete", 27, 27);
1700 static SCM_DEFINE_SUBR(extlib_string_incomplete_TOcomplete__STUB, 1, 0, SCM_OBJ(&extlib_string_incomplete_TOcomplete__NAME), extlib_string_incomplete_TOcomplete, NULL, NULL);
1701
1702 static ScmObj extlib_string_size(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1703 {
1704 ScmObj str_scm;
1705 ScmString* str;
1706 SCM_ENTER_SUBR("string-size");
1707 str_scm = SCM_ARGREF(0);
1708 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1709 str = SCM_STRING(str_scm);
1710 {
1711 {
1712 int SCM_RESULT;
1713 SCM_RESULT = (SCM_STRING_BODY_SIZE(SCM_STRING_BODY(str)));
1714 SCM_RETURN(SCM_MAKE_INT(SCM_RESULT));
1715 }
1716 }
1717 }
1718
1719 static SCM_DEFINE_STRING_CONST(extlib_string_size__NAME, "string-size", 11, 11);
1720 static SCM_DEFINE_SUBR(extlib_string_size__STUB, 1, 0, SCM_OBJ(&extlib_string_size__NAME), extlib_string_size, NULL, NULL);
1721
1722 static ScmObj extlib_make_byte_string(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1723 {
1724 ScmObj size_scm;
1725 int size;
1726 ScmObj byte_scm;
1727 int byte;
1728 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
1729 SCM_ENTER_SUBR("make-byte-string");
1730 if (Scm_Length(SCM_OPTARGS) > 1)
1731 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
1732 size_scm = SCM_ARGREF(0);
1733 if (!SCM_INTP(size_scm)) Scm_Error("small integer required, but got %S", size_scm);
1734 size = SCM_INT_VALUE(size_scm);
1735 if (SCM_NULLP(SCM_OPTARGS)) byte_scm = Scm_MakeInteger(0);
1736 else {
1737 byte_scm = SCM_CAR(SCM_OPTARGS);
1738 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
1739 }
1740 if (!SCM_INTP(byte_scm)) Scm_Error("small integer required, but got %S", byte_scm);
1741 byte = SCM_INT_VALUE(byte_scm);
1742 {
1743 char *s;
1744 if (size < 0) Scm_Error("size out of bound: %d", size);
1745 s = SCM_NEW_ATOMIC2(char *, size);
1746 memset(s, byte, size);
1747 SCM_RETURN(Scm_MakeString(s, size, size, SCM_MAKSTR_INCOMPLETE));
1748 }
1749 }
1750
1751 static SCM_DEFINE_STRING_CONST(extlib_make_byte_string__NAME, "make-byte-string", 16, 16);
1752 static SCM_DEFINE_SUBR(extlib_make_byte_string__STUB, 1, 1, SCM_OBJ(&extlib_make_byte_string__NAME), extlib_make_byte_string, NULL, NULL);
1753
1754 static ScmObj extlib_string_byte_ref(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1755 {
1756 ScmObj str_scm;
1757 ScmString* str;
1758 ScmObj k_scm;
1759 int k;
1760 ScmObj fallback_scm;
1761 ScmObj fallback;
1762 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
1763 SCM_ENTER_SUBR("string-byte-ref");
1764 if (Scm_Length(SCM_OPTARGS) > 1)
1765 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
1766 str_scm = SCM_ARGREF(0);
1767 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1768 str = SCM_STRING(str_scm);
1769 k_scm = SCM_ARGREF(1);
1770 if (!SCM_INTP(k_scm)) Scm_Error("small integer required, but got %S", k_scm);
1771 k = SCM_INT_VALUE(k_scm);
1772 if (SCM_NULLP(SCM_OPTARGS)) fallback_scm = SCM_UNBOUND;
1773 else {
1774 fallback_scm = SCM_CAR(SCM_OPTARGS);
1775 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
1776 }
1777 fallback = (fallback_scm);
1778 {
1779 {
1780 ScmObj SCM_RESULT;
1781 int r = Scm_StringByteRef(str, k, SCM_UNBOUNDP(fallback));
1782 SCM_RESULT = (r<0)? fallback : SCM_MAKE_INT(r);
1783 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1784 }
1785 }
1786 }
1787
1788 static SCM_DEFINE_STRING_CONST(extlib_string_byte_ref__NAME, "string-byte-ref", 15, 15);
1789 static SCM_DEFINE_SUBR(extlib_string_byte_ref__STUB, 2, 1, SCM_OBJ(&extlib_string_byte_ref__NAME), extlib_string_byte_ref, NULL, NULL);
1790
1791 static ScmObj extlib_string_byte_setX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1792 {
1793 ScmObj str_scm;
1794 ScmString* str;
1795 ScmObj k_scm;
1796 int k;
1797 ScmObj b_scm;
1798 int b;
1799 SCM_ENTER_SUBR("string-byte-set!");
1800 str_scm = SCM_ARGREF(0);
1801 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1802 str = SCM_STRING(str_scm);
1803 k_scm = SCM_ARGREF(1);
1804 if (!SCM_INTP(k_scm)) Scm_Error("small integer required, but got %S", k_scm);
1805 k = SCM_INT_VALUE(k_scm);
1806 b_scm = SCM_ARGREF(2);
1807 if (!SCM_INTP(b_scm)) Scm_Error("small integer required, but got %S", b_scm);
1808 b = SCM_INT_VALUE(b_scm);
1809 {
1810 {
1811 ScmObj SCM_RESULT;
1812 SCM_RESULT = Scm_StringByteSet(str, k, b);
1813 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1814 }
1815 }
1816 }
1817
1818 static SCM_DEFINE_STRING_CONST(extlib_string_byte_setX__NAME, "string-byte-set!", 16, 16);
1819 static SCM_DEFINE_SUBR(extlib_string_byte_setX__STUB, 3, 0, SCM_OBJ(&extlib_string_byte_setX__NAME), extlib_string_byte_setX, NULL, NULL);
1820
1821 static ScmObj extlib_string_substituteX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1822 {
1823 ScmObj target_scm;
1824 ScmString* target;
1825 ScmObj start_scm;
1826 int start;
1827 ScmObj str_scm;
1828 ScmString* str;
1829 SCM_ENTER_SUBR("string-substitute!");
1830 target_scm = SCM_ARGREF(0);
1831 if (!SCM_STRINGP(target_scm)) Scm_Error("string required, but got %S", target_scm);
1832 target = SCM_STRING(target_scm);
1833 start_scm = SCM_ARGREF(1);
1834 if (!SCM_INTP(start_scm)) Scm_Error("small integer required, but got %S", start_scm);
1835 start = SCM_INT_VALUE(start_scm);
1836 str_scm = SCM_ARGREF(2);
1837 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1838 str = SCM_STRING(str_scm);
1839 {
1840 ScmObj r = Scm_StringSubstitute(target, start, str);
1841 if (!SCM_STRINGP(r)) Scm_Error("argument out of range: (%d %S)", start, str);
1842 SCM_RETURN(r);
1843 }
1844 }
1845
1846 static SCM_DEFINE_STRING_CONST(extlib_string_substituteX__NAME, "string-substitute!", 18, 18);
1847 static SCM_DEFINE_SUBR(extlib_string_substituteX__STUB, 3, 0, SCM_OBJ(&extlib_string_substituteX__NAME), extlib_string_substituteX, NULL, NULL);
1848
1849 static ScmObj extlib__25maybe_substring(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1850 {
1851 ScmObj str_scm;
1852 ScmString* str;
1853 ScmObj start_scm;
1854 ScmObj start;
1855 ScmObj end_scm;
1856 ScmObj end;
1857 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
1858 SCM_ENTER_SUBR("%maybe-substring");
1859 if (Scm_Length(SCM_OPTARGS) > 2)
1860 Scm_Error("too many arguments: up to 2 is expected, %d given.", Scm_Length(SCM_OPTARGS));
1861 str_scm = SCM_ARGREF(0);
1862 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1863 str = SCM_STRING(str_scm);
1864 if (SCM_NULLP(SCM_OPTARGS)) start_scm = SCM_UNBOUND;
1865 else {
1866 start_scm = SCM_CAR(SCM_OPTARGS);
1867 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
1868 }
1869 start = (start_scm);
1870 if (SCM_NULLP(SCM_OPTARGS)) end_scm = SCM_UNBOUND;
1871 else {
1872 end_scm = SCM_CAR(SCM_OPTARGS);
1873 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
1874 }
1875 end = (end_scm);
1876 {
1877 {
1878 ScmObj SCM_RESULT;
1879 SCM_RESULT = Scm_MaybeSubstring(str, start, end);
1880 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1881 }
1882 }
1883 }
1884
1885 static SCM_DEFINE_STRING_CONST(extlib__25maybe_substring__NAME, "%maybe-substring", 16, 16);
1886 static SCM_DEFINE_SUBR(extlib__25maybe_substring__STUB, 1, 1, SCM_OBJ(&extlib__25maybe_substring__NAME), extlib__25maybe_substring, NULL, NULL);
1887
1888 static SCM_DEFINE_STRING_CONST(sym_infix__NAME, "infix", 5, 5);
1889 static ScmObj sym_infix = SCM_UNBOUND;
1890 static SCM_DEFINE_STRING_CONST(sym_strict_infix__NAME, "strict-infix", 12, 12);
1891 static ScmObj sym_strict_infix = SCM_UNBOUND;
1892 static SCM_DEFINE_STRING_CONST(sym_suffix__NAME, "suffix", 6, 6);
1893 static ScmObj sym_suffix = SCM_UNBOUND;
1894 static SCM_DEFINE_STRING_CONST(sym_prefix__NAME, "prefix", 6, 6);
1895 static ScmObj sym_prefix = SCM_UNBOUND;
1896 static ScmObj extlib_string_join(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1897 {
1898 ScmObj strs_scm;
1899 ScmObj strs;
1900 ScmObj delim_scm;
1901 ScmString* delim;
1902 ScmObj grammer_scm;
1903 ScmObj grammer;
1904 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
1905 SCM_ENTER_SUBR("string-join");
1906 if (Scm_Length(SCM_OPTARGS) > 2)
1907 Scm_Error("too many arguments: up to 2 is expected, %d given.", Scm_Length(SCM_OPTARGS));
1908 strs_scm = SCM_ARGREF(0);
1909 if (!SCM_LISTP(strs_scm)) Scm_Error("list required, but got %S", strs_scm);
1910 strs = (strs_scm);
1911 if (SCM_NULLP(SCM_OPTARGS)) delim_scm = SCM_MAKE_STR(" ");
1912 else {
1913 delim_scm = SCM_CAR(SCM_OPTARGS);
1914 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
1915 }
1916 if (!SCM_STRINGP(delim_scm)) Scm_Error("string required, but got %S", delim_scm);
1917 delim = SCM_STRING(delim_scm);
1918 if (SCM_NULLP(SCM_OPTARGS)) grammer_scm = SCM_UNBOUND;
1919 else {
1920 grammer_scm = SCM_CAR(SCM_OPTARGS);
1921 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
1922 }
1923 grammer = (grammer_scm);
1924 {
1925 int gm = 0;
1926 if (SCM_UNBOUNDP(grammer) || SCM_UNDEFINEDP(grammer) || grammer == sym_infix)
1927 gm = SCM_STRING_JOIN_INFIX;
1928 else if (grammer == sym_strict_infix)
1929 gm = SCM_STRING_JOIN_STRICT_INFIX;
1930 else if (grammer == sym_suffix)
1931 gm = SCM_STRING_JOIN_SUFFIX;
1932 else if (grammer == sym_prefix)
1933 gm = SCM_STRING_JOIN_PREFIX;
1934 else Scm_Error("invalid grammer specification: %S", grammer);
1935 SCM_RETURN(Scm_StringJoin(strs, delim, gm));
1936 }
1937 }
1938
1939 static SCM_DEFINE_STRING_CONST(extlib_string_join__NAME, "string-join", 11, 11);
1940 static SCM_DEFINE_SUBR(extlib_string_join__STUB, 1, 1, SCM_OBJ(&extlib_string_join__NAME), extlib_string_join, NULL, NULL);
1941
1942 static ScmObj extlib__25hash_string(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1943 {
1944 ScmObj str_scm;
1945 ScmString* str;
1946 ScmObj bound_scm;
1947 ScmObj bound;
1948 SCM_ENTER_SUBR("%hash-string");
1949 str_scm = SCM_ARGREF(0);
1950 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
1951 str = SCM_STRING(str_scm);
1952 bound_scm = SCM_ARGREF(1);
1953 bound = (bound_scm);
1954 {
1955 unsigned long modulo = 0;
1956 if (SCM_UNDEFINEDP(bound)) modulo = SCM_SMALL_INT_MAX;
1957 else if (SCM_INTP(bound)) modulo = SCM_INT_VALUE(bound);
1958 else if (SCM_BIGNUMP(bound)) modulo = Scm_BignumToUI(SCM_BIGNUM(bound), SCM_CLAMP_BOTH, NULL);
1959 if (modulo == 0) Scm_Error("argument out of domain: %S", bound);
1960 SCM_RETURN(Scm_MakeInteger(Scm_HashString(str, modulo)));
1961 }
1962 }
1963
1964 static SCM_DEFINE_STRING_CONST(extlib__25hash_string__NAME, "%hash-string", 12, 12);
1965 static SCM_DEFINE_SUBR(extlib__25hash_string__STUB, 2, 0, SCM_OBJ(&extlib__25hash_string__NAME), extlib__25hash_string, NULL, NULL);
1966
1967 static ScmObj extlib__25string_split_by_char(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
1968 {
1969 ScmObj s_scm;
1970 ScmString* s;
1971 ScmObj ch_scm;
1972 ScmChar ch;
1973 SCM_ENTER_SUBR("%string-split-by-char");
1974 s_scm = SCM_ARGREF(0);
1975 if (!SCM_STRINGP(s_scm)) Scm_Error("string required, but got %S", s_scm);
1976 s = SCM_STRING(s_scm);
1977 ch_scm = SCM_ARGREF(1);
1978 if (!SCM_CHARP(ch_scm)) Scm_Error("character required, but got %S", ch_scm);
1979 ch = SCM_CHAR_VALUE(ch_scm);
1980 {
1981 {
1982 ScmObj SCM_RESULT;
1983 SCM_RESULT = Scm_StringSplitByChar(s, ch);
1984 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
1985 }
1986 }
1987 }
1988
1989 static SCM_DEFINE_STRING_CONST(extlib__25string_split_by_char__NAME, "%string-split-by-char", 21, 21);
1990 static SCM_DEFINE_SUBR(extlib__25string_split_by_char__STUB, 2, 0, SCM_OBJ(&extlib__25string_split_by_char__NAME), extlib__25string_split_by_char, NULL, NULL);
1991
1992 static SCM_DEFINE_STRING_CONST(sym_index__NAME, "index", 5, 5);
1993 static ScmObj sym_index = SCM_UNBOUND;
1994 static SCM_DEFINE_STRING_CONST(sym_before__NAME, "before", 6, 6);
1995 static ScmObj sym_before = SCM_UNBOUND;
1996 static SCM_DEFINE_STRING_CONST(sym_after__NAME, "after", 5, 5);
1997 static ScmObj sym_after = SCM_UNBOUND;
1998 static SCM_DEFINE_STRING_CONST(sym_before2__NAME, "before*", 7, 7);
1999 static ScmObj sym_before2 = SCM_UNBOUND;
2000 static SCM_DEFINE_STRING_CONST(sym_after2__NAME, "after*", 6, 6);
2001 static ScmObj sym_after2 = SCM_UNBOUND;
2002 static SCM_DEFINE_STRING_CONST(sym_both__NAME, "both", 4, 4);
2003 static ScmObj sym_both = SCM_UNBOUND;
2004 static ScmObj extlib_string_scan(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2005 {
2006 ScmObj s1_scm;
2007 ScmString* s1;
2008 ScmObj s2_scm;
2009 ScmObj s2;
2010 ScmObj mode_scm;
2011 ScmObj mode;
2012 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2013 SCM_ENTER_SUBR("string-scan");
2014 if (Scm_Length(SCM_OPTARGS) > 1)
2015 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
2016 s1_scm = SCM_ARGREF(0);
2017 if (!SCM_STRINGP(s1_scm)) Scm_Error("string required, but got %S", s1_scm);
2018 s1 = SCM_STRING(s1_scm);
2019 s2_scm = SCM_ARGREF(1);
2020 s2 = (s2_scm);
2021 if (SCM_NULLP(SCM_OPTARGS)) mode_scm = sym_index;
2022 else {
2023 mode_scm = SCM_CAR(SCM_OPTARGS);
2024 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2025 }
2026 mode = (mode_scm);
2027 {
2028 int retmode = 0;
2029 if (mode == sym_index) retmode = SCM_STRING_SCAN_INDEX;
2030 else if (mode == sym_before) retmode = SCM_STRING_SCAN_BEFORE;
2031 else if (mode == sym_after) retmode = SCM_STRING_SCAN_AFTER;
2032 else if (mode == sym_before2) retmode = SCM_STRING_SCAN_BEFORE2;
2033 else if (mode == sym_after2) retmode = SCM_STRING_SCAN_AFTER2;
2034 else if (mode == sym_both) retmode = SCM_STRING_SCAN_BOTH;
2035 else {
2036 Scm_Error("bad value in mode argumet: %S, must be one of 'index, 'before, 'after, 'before*, 'after* or 'both.", mode);
2037 }
2038 if (SCM_STRINGP(s2)) {
2039 SCM_RETURN(Scm_StringScan(s1, SCM_STRING(s2), retmode));
2040 } else if (SCM_CHARP(s2)) {
2041 SCM_RETURN(Scm_StringScanChar(s1, SCM_CHAR_VALUE(s2), retmode));
2042 } else {
2043 Scm_Error("bad type of argument for s2: %S, must be either string or character", s2);
2044 SCM_RETURN(SCM_UNDEFINED); /* dummy */
2045 }
2046 }
2047 }
2048
2049 static SCM_DEFINE_STRING_CONST(extlib_string_scan__NAME, "string-scan", 11, 11);
2050 static SCM_DEFINE_SUBR(extlib_string_scan__STUB, 2, 1, SCM_OBJ(&extlib_string_scan__NAME), extlib_string_scan, NULL, NULL);
2051
2052 static ScmObj extlib_make_string_pointer(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2053 {
2054 ScmObj str_scm;
2055 ScmString* str;
2056 ScmObj index_scm;
2057 int index;
2058 ScmObj start_scm;
2059 int start;
2060 ScmObj end_scm;
2061 int end;
2062 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2063 SCM_ENTER_SUBR("make-string-pointer");
2064 if (Scm_Length(SCM_OPTARGS) > 3)
2065 Scm_Error("too many arguments: up to 3 is expected, %d given.", Scm_Length(SCM_OPTARGS));
2066 str_scm = SCM_ARGREF(0);
2067 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
2068 str = SCM_STRING(str_scm);
2069 if (SCM_NULLP(SCM_OPTARGS)) index_scm = Scm_MakeInteger(0);
2070 else {
2071 index_scm = SCM_CAR(SCM_OPTARGS);
2072 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2073 }
2074 if (!SCM_INTP(index_scm)) Scm_Error("small integer required, but got %S", index_scm);
2075 index = SCM_INT_VALUE(index_scm);
2076 if (SCM_NULLP(SCM_OPTARGS)) start_scm = Scm_MakeInteger(0);
2077 else {
2078 start_scm = SCM_CAR(SCM_OPTARGS);
2079 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2080 }
2081 if (!SCM_INTP(start_scm)) Scm_Error("small integer required, but got %S", start_scm);
2082 start = SCM_INT_VALUE(start_scm);
2083 if (SCM_NULLP(SCM_OPTARGS)) end_scm = Scm_MakeInteger(-1);
2084 else {
2085 end_scm = SCM_CAR(SCM_OPTARGS);
2086 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2087 }
2088 if (!SCM_INTP(end_scm)) Scm_Error("small integer required, but got %S", end_scm);
2089 end = SCM_INT_VALUE(end_scm);
2090 {
2091 {
2092 ScmObj SCM_RESULT;
2093 SCM_RESULT = Scm_MakeStringPointer(str, index, start, end);
2094 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2095 }
2096 }
2097 }
2098
2099 static SCM_DEFINE_STRING_CONST(extlib_make_string_pointer__NAME, "make-string-pointer", 19, 19);
2100 static SCM_DEFINE_SUBR(extlib_make_string_pointer__STUB, 1, 1, SCM_OBJ(&extlib_make_string_pointer__NAME), extlib_make_string_pointer, NULL, NULL);
2101
2102 static ScmObj extlib_string_pointerP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2103 {
2104 ScmObj obj_scm;
2105 ScmObj obj;
2106 SCM_ENTER_SUBR("string-pointer?");
2107 obj_scm = SCM_ARGREF(0);
2108 obj = (obj_scm);
2109 {
2110 {
2111 int SCM_RESULT;
2112 SCM_RESULT = SCM_STRING_POINTERP(obj);
2113 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
2114 }
2115 }
2116 }
2117
2118 static SCM_DEFINE_STRING_CONST(extlib_string_pointerP__NAME, "string-pointer?", 15, 15);
2119 static SCM_DEFINE_SUBR(extlib_string_pointerP__STUB, 1, 0, SCM_OBJ(&extlib_string_pointerP__NAME), extlib_string_pointerP, NULL, NULL);
2120
2121 static ScmObj extlib_string_pointer_ref(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2122 {
2123 ScmObj sp_scm;
2124 ScmStringPointer* sp;
2125 SCM_ENTER_SUBR("string-pointer-ref");
2126 sp_scm = SCM_ARGREF(0);
2127 if (!SCM_STRING_POINTERP(sp_scm)) Scm_Error("string pointer required, but got %S", sp_scm);
2128 sp = SCM_STRING_POINTER(sp_scm);
2129 {
2130 {
2131 ScmObj SCM_RESULT;
2132 SCM_RESULT = Scm_StringPointerRef(sp);
2133 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2134 }
2135 }
2136 }
2137
2138 static SCM_DEFINE_STRING_CONST(extlib_string_pointer_ref__NAME, "string-pointer-ref", 18, 18);
2139 static SCM_DEFINE_SUBR(extlib_string_pointer_ref__STUB, 1, 0, SCM_OBJ(&extlib_string_pointer_ref__NAME), extlib_string_pointer_ref, NULL, NULL);
2140
2141 static ScmObj extlib_string_pointer_nextX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2142 {
2143 ScmObj sp_scm;
2144 ScmStringPointer* sp;
2145 SCM_ENTER_SUBR("string-pointer-next!");
2146 sp_scm = SCM_ARGREF(0);
2147 if (!SCM_STRING_POINTERP(sp_scm)) Scm_Error("string pointer required, but got %S", sp_scm);
2148 sp = SCM_STRING_POINTER(sp_scm);
2149 {
2150 {
2151 ScmObj SCM_RESULT;
2152 SCM_RESULT = Scm_StringPointerNext(sp);
2153 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2154 }
2155 }
2156 }
2157
2158 static SCM_DEFINE_STRING_CONST(extlib_string_pointer_nextX__NAME, "string-pointer-next!", 20, 20);
2159 static SCM_DEFINE_SUBR(extlib_string_pointer_nextX__STUB, 1, 0, SCM_OBJ(&extlib_string_pointer_nextX__NAME), extlib_string_pointer_nextX, NULL, NULL);
2160
2161 static ScmObj extlib_string_pointer_prevX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2162 {
2163 ScmObj sp_scm;
2164 ScmStringPointer* sp;
2165 SCM_ENTER_SUBR("string-pointer-prev!");
2166 sp_scm = SCM_ARGREF(0);
2167 if (!SCM_STRING_POINTERP(sp_scm)) Scm_Error("string pointer required, but got %S", sp_scm);
2168 sp = SCM_STRING_POINTER(sp_scm);
2169 {
2170 {
2171 ScmObj SCM_RESULT;
2172 SCM_RESULT = Scm_StringPointerPrev(sp);
2173 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2174 }
2175 }
2176 }
2177
2178 static SCM_DEFINE_STRING_CONST(extlib_string_pointer_prevX__NAME, "string-pointer-prev!", 20, 20);
2179 static SCM_DEFINE_SUBR(extlib_string_pointer_prevX__STUB, 1, 0, SCM_OBJ(&extlib_string_pointer_prevX__NAME), extlib_string_pointer_prevX, NULL, NULL);
2180
2181 static ScmObj extlib_string_pointer_setX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2182 {
2183 ScmObj sp_scm;
2184 ScmStringPointer* sp;
2185 ScmObj index_scm;
2186 int index;
2187 SCM_ENTER_SUBR("string-pointer-set!");
2188 sp_scm = SCM_ARGREF(0);
2189 if (!SCM_STRING_POINTERP(sp_scm)) Scm_Error("string pointer required, but got %S", sp_scm);
2190 sp = SCM_STRING_POINTER(sp_scm);
2191 index_scm = SCM_ARGREF(1);
2192 if (!SCM_INTP(index_scm)) Scm_Error("small integer required, but got %S", index_scm);
2193 index = SCM_INT_VALUE(index_scm);
2194 {
2195 {
2196 ScmObj SCM_RESULT;
2197 SCM_RESULT = Scm_StringPointerSet(sp, index);
2198 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2199 }
2200 }
2201 }
2202
2203 static SCM_DEFINE_STRING_CONST(extlib_string_pointer_setX__NAME, "string-pointer-set!", 19, 19);
2204 static SCM_DEFINE_SUBR(extlib_string_pointer_setX__STUB, 2, 0, SCM_OBJ(&extlib_string_pointer_setX__NAME), extlib_string_pointer_setX, NULL, NULL);
2205
2206 static SCM_DEFINE_STRING_CONST(KEYARG_after__NAME, "after", 5, 5);
2207 static ScmObj KEYARG_after = SCM_UNBOUND;
2208 static ScmObj extlib_string_pointer_substring(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2209 {
2210 ScmObj sp_scm;
2211 ScmStringPointer* sp;
2212 ScmObj after_scm;
2213 ScmObj after;
2214 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2215 SCM_ENTER_SUBR("string-pointer-substring");
2216 sp_scm = SCM_ARGREF(0);
2217 if (!SCM_STRING_POINTERP(sp_scm)) Scm_Error("string pointer required, but got %S", sp_scm);
2218 sp = SCM_STRING_POINTER(sp_scm);
2219 after_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_after), SCM_OPTARGS, SCM_FALSE);
2220 after = (after_scm);
2221 {
2222 {
2223 ScmObj SCM_RESULT;
2224 SCM_RESULT = (Scm_StringPointerSubstring(sp, !SCM_FALSEP(after)));
2225 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2226 }
2227 }
2228 }
2229
2230 static SCM_DEFINE_STRING_CONST(extlib_string_pointer_substring__NAME, "string-pointer-substring", 24, 24);
2231 static SCM_DEFINE_SUBR(extlib_string_pointer_substring__STUB, 1, 1, SCM_OBJ(&extlib_string_pointer_substring__NAME), extlib_string_pointer_substring, NULL, NULL);
2232
2233 static ScmObj extlib_string_pointer_index(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2234 {
2235 ScmObj sp_scm;
2236 ScmStringPointer* sp;
2237 SCM_ENTER_SUBR("string-pointer-index");
2238 sp_scm = SCM_ARGREF(0);
2239 if (!SCM_STRING_POINTERP(sp_scm)) Scm_Error("string pointer required, but got %S", sp_scm);
2240 sp = SCM_STRING_POINTER(sp_scm);
2241 {
2242 {
2243 int SCM_RESULT;
2244 SCM_RESULT = (sp->index);
2245 SCM_RETURN(Scm_MakeInteger(SCM_RESULT));
2246 }
2247 }
2248 }
2249
2250 static SCM_DEFINE_STRING_CONST(extlib_string_pointer_index__NAME, "string-pointer-index", 20, 20);
2251 static SCM_DEFINE_SUBR(extlib_string_pointer_index__STUB, 1, 0, SCM_OBJ(&extlib_string_pointer_index__NAME), extlib_string_pointer_index, NULL, NULL);
2252
2253 static ScmObj extlib_string_pointer_copy(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2254 {
2255 ScmObj sp_scm;
2256 ScmStringPointer* sp;
2257 SCM_ENTER_SUBR("string-pointer-copy");
2258 sp_scm = SCM_ARGREF(0);
2259 if (!SCM_STRING_POINTERP(sp_scm)) Scm_Error("string pointer required, but got %S", sp_scm);
2260 sp = SCM_STRING_POINTER(sp_scm);
2261 {
2262 {
2263 ScmObj SCM_RESULT;
2264 SCM_RESULT = Scm_StringPointerCopy(sp);
2265 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2266 }
2267 }
2268 }
2269
2270 static SCM_DEFINE_STRING_CONST(extlib_string_pointer_copy__NAME, "string-pointer-copy", 19, 19);
2271 static SCM_DEFINE_SUBR(extlib_string_pointer_copy__STUB, 1, 0, SCM_OBJ(&extlib_string_pointer_copy__NAME), extlib_string_pointer_copy, NULL, NULL);
2272
2273 static ScmObj extlib_string_pointer_byte_index(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2274 {
2275 ScmObj sp_scm;
2276 ScmStringPointer* sp;
2277 SCM_ENTER_SUBR("string-pointer-byte-index");
2278 sp_scm = SCM_ARGREF(0);
2279 if (!SCM_STRING_POINTERP(sp_scm)) Scm_Error("string pointer required, but got %S", sp_scm);
2280 sp = SCM_STRING_POINTER(sp_scm);
2281 {
2282 {
2283 int SCM_RESULT;
2284 SCM_RESULT = (sp->current - sp->start);
2285 SCM_RETURN(Scm_MakeInteger(SCM_RESULT));
2286 }
2287 }
2288 }
2289
2290 static SCM_DEFINE_STRING_CONST(extlib_string_pointer_byte_index__NAME, "string-pointer-byte-index", 25, 25);
2291 static SCM_DEFINE_SUBR(extlib_string_pointer_byte_index__STUB, 1, 0, SCM_OBJ(&extlib_string_pointer_byte_index__NAME), extlib_string_pointer_byte_index, NULL, NULL);
2292
2293 #if SCM_DEBUG_HELPER
2294 static ScmObj extlib__25string_pointer_dump(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2295 {
2296 ScmObj sp_scm;
2297 ScmStringPointer* sp;
2298 SCM_ENTER_SUBR("%string-pointer-dump");
2299 sp_scm = SCM_ARGREF(0);
2300 if (!SCM_STRING_POINTERP(sp_scm)) Scm_Error("string pointer required, but got %S", sp_scm);
2301 sp = SCM_STRING_POINTER(sp_scm);
2302 {
2303 Scm_StringPointerDump(sp);
2304 SCM_RETURN(SCM_UNDEFINED);
2305 }
2306 }
2307
2308 static SCM_DEFINE_STRING_CONST(extlib__25string_pointer_dump__NAME, "%string-pointer-dump", 20, 20);
2309 static SCM_DEFINE_SUBR(extlib__25string_pointer_dump__STUB, 1, 0, SCM_OBJ(&extlib__25string_pointer_dump__NAME), extlib__25string_pointer_dump, NULL, NULL);
2310
2311 #endif /*SCM_DEBUG_HELPER*/
2312 static ScmObj extlib_regexpP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2313 {
2314 ScmObj obj_scm;
2315 ScmObj obj;
2316 SCM_ENTER_SUBR("regexp?");
2317 obj_scm = SCM_ARGREF(0);
2318 obj = (obj_scm);
2319 {
2320 {
2321 int SCM_RESULT;
2322 SCM_RESULT = SCM_REGEXPP(obj);
2323 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
2324 }
2325 }
2326 }
2327
2328 static SCM_DEFINE_STRING_CONST(extlib_regexpP__NAME, "regexp?", 7, 7);
2329 static SCM_DEFINE_SUBR(extlib_regexpP__STUB, 1, 0, SCM_OBJ(&extlib_regexpP__NAME), extlib_regexpP, NULL, NULL);
2330
2331 static ScmObj extlib_regmatchP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2332 {
2333 ScmObj obj_scm;
2334 ScmObj obj;
2335 SCM_ENTER_SUBR("regmatch?");
2336 obj_scm = SCM_ARGREF(0);
2337 obj = (obj_scm);
2338 {
2339 {
2340 int SCM_RESULT;
2341 SCM_RESULT = SCM_REGMATCHP(obj);
2342 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
2343 }
2344 }
2345 }
2346
2347 static SCM_DEFINE_STRING_CONST(extlib_regmatchP__NAME, "regmatch?", 9, 9);
2348 static SCM_DEFINE_SUBR(extlib_regmatchP__STUB, 1, 0, SCM_OBJ(&extlib_regmatchP__NAME), extlib_regmatchP, NULL, NULL);
2349
2350 static SCM_DEFINE_STRING_CONST(KEYARG_case_fold__NAME, "case-fold", 9, 9);
2351 static ScmObj KEYARG_case_fold = SCM_UNBOUND;
2352 static ScmObj extlib_string_TOregexp(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2353 {
2354 ScmObj str_scm;
2355 ScmString* str;
2356 ScmObj case_fold_scm;
2357 ScmObj case_fold;
2358 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2359 SCM_ENTER_SUBR("string->regexp");
2360 str_scm = SCM_ARGREF(0);
2361 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
2362 str = SCM_STRING(str_scm);
2363 case_fold_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_case_fold), SCM_OPTARGS, SCM_FALSE);
2364 case_fold = (case_fold_scm);
2365 {
2366 {
2367 ScmObj SCM_RESULT;
2368 int flags = SCM_BOOL_VALUE(case_fold)? SCM_REGEXP_CASE_FOLD : 0;
2369 SCM_RESULT = Scm_RegComp(str, flags);
2370 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2371 }
2372 }
2373 }
2374
2375 static SCM_DEFINE_STRING_CONST(extlib_string_TOregexp__NAME, "string->regexp", 14, 14);
2376 static SCM_DEFINE_SUBR(extlib_string_TOregexp__STUB, 1, 1, SCM_OBJ(&extlib_string_TOregexp__NAME), extlib_string_TOregexp, NULL, NULL);
2377
2378 static ScmObj extlib_regexp_TOstring(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2379 {
2380 ScmObj regexp_scm;
2381 ScmRegexp* regexp;
2382 SCM_ENTER_SUBR("regexp->string");
2383 regexp_scm = SCM_ARGREF(0);
2384 if (!SCM_REGEXPP(regexp_scm)) Scm_Error("regexp required, but got %S", regexp_scm);
2385 regexp = SCM_REGEXP(regexp_scm);
2386 {
2387 {
2388 ScmObj SCM_RESULT;
2389 SCM_RESULT = (regexp->pattern?SCM_OBJ(regexp->pattern):SCM_FALSE);
2390 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2391 }
2392 }
2393 }
2394
2395 static SCM_DEFINE_STRING_CONST(extlib_regexp_TOstring__NAME, "regexp->string", 14, 14);
2396 static SCM_DEFINE_SUBR(extlib_regexp_TOstring__STUB, 1, 0, SCM_OBJ(&extlib_regexp_TOstring__NAME), extlib_regexp_TOstring, NULL, NULL);
2397
2398 static ScmObj extlib_regexp_case_foldP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2399 {
2400 ScmObj regexp_scm;
2401 ScmRegexp* regexp;
2402 SCM_ENTER_SUBR("regexp-case-fold?");
2403 regexp_scm = SCM_ARGREF(0);
2404 if (!SCM_REGEXPP(regexp_scm)) Scm_Error("regexp required, but got %S", regexp_scm);
2405 regexp = SCM_REGEXP(regexp_scm);
2406 {
2407 {
2408 int SCM_RESULT;
2409 SCM_RESULT = (regexp->flags&SCM_REGEXP_CASE_FOLD);
2410 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
2411 }
2412 }
2413 }
2414
2415 static SCM_DEFINE_STRING_CONST(extlib_regexp_case_foldP__NAME, "regexp-case-fold?", 17, 17);
2416 static SCM_DEFINE_SUBR(extlib_regexp_case_foldP__STUB, 1, 0, SCM_OBJ(&extlib_regexp_case_foldP__NAME), extlib_regexp_case_foldP, NULL, NULL);
2417
2418 static ScmObj extlib_regexp_parse(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2419 {
2420 ScmObj str_scm;
2421 ScmString* str;
2422 ScmObj case_fold_scm;
2423 ScmObj case_fold;
2424 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2425 SCM_ENTER_SUBR("regexp-parse");
2426 str_scm = SCM_ARGREF(0);
2427 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
2428 str = SCM_STRING(str_scm);
2429 case_fold_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_case_fold), SCM_OPTARGS, SCM_FALSE);
2430 case_fold = (case_fold_scm);
2431 {
2432 {
2433 ScmObj SCM_RESULT;
2434 int flags = SCM_BOOL_VALUE(case_fold)? SCM_REGEXP_CASE_FOLD : 0;
2435 SCM_RESULT = Scm_RegComp(str, flags|SCM_REGEXP_PARSE_ONLY);
2436 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2437 }
2438 }
2439 }
2440
2441 static SCM_DEFINE_STRING_CONST(extlib_regexp_parse__NAME, "regexp-parse", 12, 12);
2442 static SCM_DEFINE_SUBR(extlib_regexp_parse__STUB, 1, 1, SCM_OBJ(&extlib_regexp_parse__NAME), extlib_regexp_parse, NULL, NULL);
2443
2444 static ScmObj extlib_regexp_compile(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2445 {
2446 ScmObj ast_scm;
2447 ScmObj ast;
2448 SCM_ENTER_SUBR("regexp-compile");
2449 ast_scm = SCM_ARGREF(0);
2450 ast = (ast_scm);
2451 {
2452 {
2453 ScmObj SCM_RESULT;
2454 SCM_RESULT = Scm_RegCompFromAST(ast);
2455 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2456 }
2457 }
2458 }
2459
2460 static SCM_DEFINE_STRING_CONST(extlib_regexp_compile__NAME, "regexp-compile", 14, 14);
2461 static SCM_DEFINE_SUBR(extlib_regexp_compile__STUB, 1, 0, SCM_OBJ(&extlib_regexp_compile__NAME), extlib_regexp_compile, NULL, NULL);
2462
2463 static ScmObj extlib_regexp_optimize(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2464 {
2465 ScmObj ast_scm;
2466 ScmObj ast;
2467 SCM_ENTER_SUBR("regexp-optimize");
2468 ast_scm = SCM_ARGREF(0);
2469 ast = (ast_scm);
2470 {
2471 {
2472 ScmObj SCM_RESULT;
2473 SCM_RESULT = Scm_RegOptimizeAST(ast);
2474 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2475 }
2476 }
2477 }
2478
2479 static SCM_DEFINE_STRING_CONST(extlib_regexp_optimize__NAME, "regexp-optimize", 15, 15);
2480 static SCM_DEFINE_SUBR(extlib_regexp_optimize__STUB, 1, 0, SCM_OBJ(&extlib_regexp_optimize__NAME), extlib_regexp_optimize, NULL, NULL);
2481
2482 static ScmObj extlib_rxmatch(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2483 {
2484 ScmObj regexp_scm;
2485 ScmObj regexp;
2486 ScmObj str_scm;
2487 ScmString* str;
2488 SCM_ENTER_SUBR("rxmatch");
2489 regexp_scm = SCM_ARGREF(0);
2490 regexp = (regexp_scm);
2491 str_scm = SCM_ARGREF(1);
2492 if (!SCM_STRINGP(str_scm)) Scm_Error("string required, but got %S", str_scm);
2493 str = SCM_STRING(str_scm);
2494 {
2495 ScmRegexp *rx = NULL;
2496 if (SCM_STRINGP(regexp)) rx = SCM_REGEXP(Scm_RegComp(SCM_STRING(regexp), 0));
2497 else if (SCM_REGEXPP(regexp)) rx = SCM_REGEXP(regexp);
2498 else Scm_Error("regexp required, but got %S", regexp);
2499 SCM_RETURN(Scm_RegExec(rx, str));
2500 }
2501 }
2502
2503 static SCM_DEFINE_STRING_CONST(extlib_rxmatch__NAME, "rxmatch", 7, 7);
2504 static SCM_DEFINE_SUBR(extlib_rxmatch__STUB, 2, 0, SCM_OBJ(&extlib_rxmatch__NAME), extlib_rxmatch, NULL, NULL);
2505
2506 static ScmObj extlib_rxmatch_substring(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2507 {
2508 ScmObj match_scm;
2509 ScmObj match;
2510 ScmObj i_scm;
2511 int i;
2512 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2513 SCM_ENTER_SUBR("rxmatch-substring");
2514 if (Scm_Length(SCM_OPTARGS) > 1)
2515 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
2516 match_scm = SCM_ARGREF(0);
2517 match = (match_scm);
2518 if (SCM_NULLP(SCM_OPTARGS)) i_scm = Scm_MakeInteger(0);
2519 else {
2520 i_scm = SCM_CAR(SCM_OPTARGS);
2521 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2522 }
2523 if (!SCM_INTP(i_scm)) Scm_Error("small integer required, but got %S", i_scm);
2524 i = SCM_INT_VALUE(i_scm);
2525 {
2526 if (SCM_FALSEP(match)) SCM_RETURN(SCM_FALSE);
2527 if (!SCM_REGMATCHP(match))
2528 Scm_Error("regexp match object required, but got %S", match);
2529 SCM_RETURN(Scm_RegMatchSubstr(SCM_REGMATCH(match), i));
2530 }
2531 }
2532
2533 static SCM_DEFINE_STRING_CONST(extlib_rxmatch_substring__NAME, "rxmatch-substring", 17, 17);
2534 static SCM_DEFINE_SUBR(extlib_rxmatch_substring__STUB, 1, 1, SCM_OBJ(&extlib_rxmatch_substring__NAME), extlib_rxmatch_substring, NULL, NULL);
2535
2536 static ScmObj extlib_rxmatch_start(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2537 {
2538 ScmObj match_scm;
2539 ScmObj match;
2540 ScmObj i_scm;
2541 int i;
2542 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2543 SCM_ENTER_SUBR("rxmatch-start");
2544 if (Scm_Length(SCM_OPTARGS) > 1)
2545 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
2546 match_scm = SCM_ARGREF(0);
2547 match = (match_scm);
2548 if (SCM_NULLP(SCM_OPTARGS)) i_scm = Scm_MakeInteger(0);
2549 else {
2550 i_scm = SCM_CAR(SCM_OPTARGS);
2551 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2552 }
2553 if (!SCM_INTP(i_scm)) Scm_Error("small integer required, but got %S", i_scm);
2554 i = SCM_INT_VALUE(i_scm);
2555 {
2556 if (SCM_FALSEP(match)) SCM_RETURN(SCM_FALSE);
2557 if (!SCM_REGMATCHP(match))
2558 Scm_Error("regexp match object required, but got %S", match);
2559 SCM_RETURN(Scm_RegMatchStart(SCM_REGMATCH(match), i));
2560 }
2561 }
2562
2563 static SCM_DEFINE_STRING_CONST(extlib_rxmatch_start__NAME, "rxmatch-start", 13, 13);
2564 static SCM_DEFINE_SUBR(extlib_rxmatch_start__STUB, 1, 1, SCM_OBJ(&extlib_rxmatch_start__NAME), extlib_rxmatch_start, NULL, NULL);
2565
2566 static ScmObj extlib_rxmatch_end(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2567 {
2568 ScmObj match_scm;
2569 ScmObj match;
2570 ScmObj i_scm;
2571 int i;
2572 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2573 SCM_ENTER_SUBR("rxmatch-end");
2574 if (Scm_Length(SCM_OPTARGS) > 1)
2575 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
2576 match_scm = SCM_ARGREF(0);
2577 match = (match_scm);
2578 if (SCM_NULLP(SCM_OPTARGS)) i_scm = Scm_MakeInteger(0);
2579 else {
2580 i_scm = SCM_CAR(SCM_OPTARGS);
2581 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2582 }
2583 if (!SCM_INTP(i_scm)) Scm_Error("small integer required, but got %S", i_scm);
2584 i = SCM_INT_VALUE(i_scm);
2585 {
2586 if (SCM_FALSEP(match)) SCM_RETURN(SCM_FALSE);
2587 if (!SCM_REGMATCHP(match))
2588 Scm_Error("regexp match object required, but got %S", match);
2589 SCM_RETURN(Scm_RegMatchEnd(SCM_REGMATCH(match), i));
2590 }
2591 }
2592
2593 static SCM_DEFINE_STRING_CONST(extlib_rxmatch_end__NAME, "rxmatch-end", 11, 11);
2594 static SCM_DEFINE_SUBR(extlib_rxmatch_end__STUB, 1, 1, SCM_OBJ(&extlib_rxmatch_end__NAME), extlib_rxmatch_end, NULL, NULL);
2595
2596 static ScmObj extlib_rxmatch_before(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2597 {
2598 ScmObj match_scm;
2599 ScmObj match;
2600 ScmObj i_scm;
2601 int i;
2602 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2603 SCM_ENTER_SUBR("rxmatch-before");
2604 if (Scm_Length(SCM_OPTARGS) > 1)
2605 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
2606 match_scm = SCM_ARGREF(0);
2607 match = (match_scm);
2608 if (SCM_NULLP(SCM_OPTARGS)) i_scm = Scm_MakeInteger(0);
2609 else {
2610 i_scm = SCM_CAR(SCM_OPTARGS);
2611 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2612 }
2613 if (!SCM_INTP(i_scm)) Scm_Error("small integer required, but got %S", i_scm);
2614 i = SCM_INT_VALUE(i_scm);
2615 {
2616 if (SCM_FALSEP(match)) SCM_RETURN(SCM_FALSE);
2617 if (!SCM_REGMATCHP(match))
2618 Scm_Error("regexp match object required, but got %S", match);
2619 SCM_RETURN(Scm_RegMatchBefore(SCM_REGMATCH(match), i));
2620 }
2621 }
2622
2623 static SCM_DEFINE_STRING_CONST(extlib_rxmatch_before__NAME, "rxmatch-before", 14, 14);
2624 static SCM_DEFINE_SUBR(extlib_rxmatch_before__STUB, 1, 1, SCM_OBJ(&extlib_rxmatch_before__NAME), extlib_rxmatch_before, NULL, NULL);
2625
2626 static ScmObj extlib_rxmatch_after(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2627 {
2628 ScmObj match_scm;
2629 ScmObj match;
2630 ScmObj i_scm;
2631 int i;
2632 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2633 SCM_ENTER_SUBR("rxmatch-after");
2634 if (Scm_Length(SCM_OPTARGS) > 1)
2635 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
2636 match_scm = SCM_ARGREF(0);
2637 match = (match_scm);
2638 if (SCM_NULLP(SCM_OPTARGS)) i_scm = Scm_MakeInteger(0);
2639 else {
2640 i_scm = SCM_CAR(SCM_OPTARGS);
2641 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2642 }
2643 if (!SCM_INTP(i_scm)) Scm_Error("small integer required, but got %S", i_scm);
2644 i = SCM_INT_VALUE(i_scm);
2645 {
2646 if (SCM_FALSEP(match)) SCM_RETURN(SCM_FALSE);
2647 if (!SCM_REGMATCHP(match))
2648 Scm_Error("regexp match object required, but got %S", match);
2649 SCM_RETURN(Scm_RegMatchAfter(SCM_REGMATCH(match), i));
2650 }
2651 }
2652
2653 static SCM_DEFINE_STRING_CONST(extlib_rxmatch_after__NAME, "rxmatch-after", 13, 13);
2654 static SCM_DEFINE_SUBR(extlib_rxmatch_after__STUB, 1, 1, SCM_OBJ(&extlib_rxmatch_after__NAME), extlib_rxmatch_after, NULL, NULL);
2655
2656 static ScmObj extlib_rxmatch_num_matches(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2657 {
2658 ScmObj match_scm;
2659 ScmObj match;
2660 SCM_ENTER_SUBR("rxmatch-num-matches");
2661 match_scm = SCM_ARGREF(0);
2662 match = (match_scm);
2663 {
2664 if (SCM_FALSEP(match)) SCM_RETURN(SCM_MAKE_INT(0));
2665 if (!SCM_REGMATCHP(match))
2666 Scm_Error("regexp match object required, but got %S", match);
2667 SCM_RETURN(SCM_MAKE_INT(SCM_REGMATCH(match)->numMatches));
2668 }
2669 }
2670
2671 static SCM_DEFINE_STRING_CONST(extlib_rxmatch_num_matches__NAME, "rxmatch-num-matches", 19, 19);
2672 static SCM_DEFINE_SUBR(extlib_rxmatch_num_matches__STUB, 1, 0, SCM_OBJ(&extlib_rxmatch_num_matches__NAME), extlib_rxmatch_num_matches, NULL, NULL);
2673
2674 #if SCM_DEBUG_HELPER
2675 static ScmObj extlib__25regexp_dump(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2676 {
2677 ScmObj rx_scm;
2678 ScmRegexp* rx;
2679 SCM_ENTER_SUBR("%regexp-dump");
2680 rx_scm = SCM_ARGREF(0);
2681 if (!SCM_REGEXPP(rx_scm)) Scm_Error("regexp required, but got %S", rx_scm);
2682 rx = SCM_REGEXP(rx_scm);
2683 {
2684 Scm_RegDump(rx);
2685 SCM_RETURN(SCM_UNDEFINED);
2686 }
2687 }
2688
2689 static SCM_DEFINE_STRING_CONST(extlib__25regexp_dump__NAME, "%regexp-dump", 12, 12);
2690 static SCM_DEFINE_SUBR(extlib__25regexp_dump__STUB, 1, 0, SCM_OBJ(&extlib__25regexp_dump__NAME), extlib__25regexp_dump, NULL, NULL);
2691
2692 #endif /*SCM_DEBUG_HELPER*/
2693 #if SCM_DEBUG_HELPER
2694 static ScmObj extlib__25regmatch_dump(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2695 {
2696 ScmObj rm_scm;
2697 ScmRegMatch* rm;
2698 SCM_ENTER_SUBR("%regmatch-dump");
2699 rm_scm = SCM_ARGREF(0);
2700 if (!SCM_REGMATCHP(rm_scm)) Scm_Error("regmatch required, but got %S", rm_scm);
2701 rm = SCM_REGMATCH(rm_scm);
2702 {
2703 Scm_RegMatchDump(rm);
2704 SCM_RETURN(SCM_UNDEFINED);
2705 }
2706 }
2707
2708 static SCM_DEFINE_STRING_CONST(extlib__25regmatch_dump__NAME, "%regmatch-dump", 14, 14);
2709 static SCM_DEFINE_SUBR(extlib__25regmatch_dump__STUB, 1, 0, SCM_OBJ(&extlib__25regmatch_dump__NAME), extlib__25regmatch_dump, NULL, NULL);
2710
2711 #endif /*SCM_DEBUG_HELPER*/
2712 static ScmObj extlib_vector_copy(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2713 {
2714 ScmObj v_scm;
2715 ScmVector* v;
2716 ScmObj start_scm;
2717 int start;
2718 ScmObj end_scm;
2719 int end;
2720 ScmObj fill_scm;
2721 ScmObj fill;
2722 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2723 SCM_ENTER_SUBR("vector-copy");
2724 if (Scm_Length(SCM_OPTARGS) > 3)
2725 Scm_Error("too many arguments: up to 3 is expected, %d given.", Scm_Length(SCM_OPTARGS));
2726 v_scm = SCM_ARGREF(0);
2727 if (!SCM_VECTORP(v_scm)) Scm_Error("vector required, but got %S", v_scm);
2728 v = SCM_VECTOR(v_scm);
2729 if (SCM_NULLP(SCM_OPTARGS)) start_scm = Scm_MakeInteger(0);
2730 else {
2731 start_scm = SCM_CAR(SCM_OPTARGS);
2732 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2733 }
2734 if (!SCM_INTP(start_scm)) Scm_Error("small integer required, but got %S", start_scm);
2735 start = SCM_INT_VALUE(start_scm);
2736 if (SCM_NULLP(SCM_OPTARGS)) end_scm = Scm_MakeInteger(-1);
2737 else {
2738 end_scm = SCM_CAR(SCM_OPTARGS);
2739 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2740 }
2741 if (!SCM_INTP(end_scm)) Scm_Error("small integer required, but got %S", end_scm);
2742 end = SCM_INT_VALUE(end_scm);
2743 if (SCM_NULLP(SCM_OPTARGS)) fill_scm = SCM_UNBOUND;
2744 else {
2745 fill_scm = SCM_CAR(SCM_OPTARGS);
2746 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2747 }
2748 fill = (fill_scm);
2749 {
2750 {
2751 ScmObj SCM_RESULT;
2752 SCM_RESULT = Scm_VectorCopy(v, start, end, fill);
2753 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2754 }
2755 }
2756 }
2757
2758 static SCM_DEFINE_STRING_CONST(extlib_vector_copy__NAME, "vector-copy", 11, 11);
2759 static SCM_DEFINE_SUBR(extlib_vector_copy__STUB, 1, 1, SCM_OBJ(&extlib_vector_copy__NAME), extlib_vector_copy, NULL, NULL);
2760
2761 static ScmObj extlib_make_weak_vector(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2762 {
2763 ScmObj size_scm;
2764 int size;
2765 SCM_ENTER_SUBR("make-weak-vector");
2766 size_scm = SCM_ARGREF(0);
2767 if (!SCM_INTP(size_scm)) Scm_Error("small integer required, but got %S", size_scm);
2768 size = SCM_INT_VALUE(size_scm);
2769 {
2770 {
2771 ScmObj SCM_RESULT;
2772 SCM_RESULT = Scm_MakeWeakVector(size);
2773 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2774 }
2775 }
2776 }
2777
2778 static SCM_DEFINE_STRING_CONST(extlib_make_weak_vector__NAME, "make-weak-vector", 16, 16);
2779 static SCM_DEFINE_SUBR(extlib_make_weak_vector__STUB, 1, 0, SCM_OBJ(&extlib_make_weak_vector__NAME), extlib_make_weak_vector, NULL, NULL);
2780
2781 static ScmObj extlib_weak_vector_length(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2782 {
2783 ScmObj wv_scm;
2784 ScmWeakVector* wv;
2785 SCM_ENTER_SUBR("weak-vector-length");
2786 wv_scm = SCM_ARGREF(0);
2787 if (!SCM_WEAK_VECTOR_P(wv_scm)) Scm_Error("weak vector required, but got %S", wv_scm);
2788 wv = SCM_WEAK_VECTOR(wv_scm);
2789 {
2790 {
2791 int SCM_RESULT;
2792 SCM_RESULT = (wv->size);
2793 SCM_RETURN(Scm_MakeInteger(SCM_RESULT));
2794 }
2795 }
2796 }
2797
2798 static SCM_DEFINE_STRING_CONST(extlib_weak_vector_length__NAME, "weak-vector-length", 18, 18);
2799 static SCM_DEFINE_SUBR(extlib_weak_vector_length__STUB, 1, 0, SCM_OBJ(&extlib_weak_vector_length__NAME), extlib_weak_vector_length, NULL, NULL);
2800
2801 static ScmObj extlib_weak_vector_ref(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2802 {
2803 ScmObj wv_scm;
2804 ScmWeakVector* wv;
2805 ScmObj index_scm;
2806 int index;
2807 ScmObj fallback_scm;
2808 ScmObj fallback;
2809 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
2810 SCM_ENTER_SUBR("weak-vector-ref");
2811 if (Scm_Length(SCM_OPTARGS) > 1)
2812 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
2813 wv_scm = SCM_ARGREF(0);
2814 if (!SCM_WEAK_VECTOR_P(wv_scm)) Scm_Error("weak vector required, but got %S", wv_scm);
2815 wv = SCM_WEAK_VECTOR(wv_scm);
2816 index_scm = SCM_ARGREF(1);
2817 if (!SCM_INTP(index_scm)) Scm_Error("small integer required, but got %S", index_scm);
2818 index = SCM_INT_VALUE(index_scm);
2819 if (SCM_NULLP(SCM_OPTARGS)) fallback_scm = SCM_UNBOUND;
2820 else {
2821 fallback_scm = SCM_CAR(SCM_OPTARGS);
2822 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
2823 }
2824 fallback = (fallback_scm);
2825 {
2826 {
2827 ScmObj SCM_RESULT;
2828 SCM_RESULT = Scm_WeakVectorRef(wv, index, fallback);
2829 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2830 }
2831 }
2832 }
2833
2834 static SCM_DEFINE_STRING_CONST(extlib_weak_vector_ref__NAME, "weak-vector-ref", 15, 15);
2835 static SCM_DEFINE_SUBR(extlib_weak_vector_ref__STUB, 2, 1, SCM_OBJ(&extlib_weak_vector_ref__NAME), extlib_weak_vector_ref, NULL, NULL);
2836
2837 static ScmObj extlib_weak_vector_setX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2838 {
2839 ScmObj wv_scm;
2840 ScmWeakVector* wv;
2841 ScmObj index_scm;
2842 int index;
2843 ScmObj val_scm;
2844 ScmObj val;
2845 SCM_ENTER_SUBR("weak-vector-set!");
2846 wv_scm = SCM_ARGREF(0);
2847 if (!SCM_WEAK_VECTOR_P(wv_scm)) Scm_Error("weak vector required, but got %S", wv_scm);
2848 wv = SCM_WEAK_VECTOR(wv_scm);
2849 index_scm = SCM_ARGREF(1);
2850 if (!SCM_INTP(index_scm)) Scm_Error("small integer required, but got %S", index_scm);
2851 index = SCM_INT_VALUE(index_scm);
2852 val_scm = SCM_ARGREF(2);
2853 val = (val_scm);
2854 {
2855 {
2856 ScmObj SCM_RESULT;
2857 SCM_RESULT = Scm_WeakVectorSet(wv, index, val);
2858 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2859 }
2860 }
2861 }
2862
2863 static SCM_DEFINE_STRING_CONST(extlib_weak_vector_setX__NAME, "weak-vector-set!", 16, 16);
2864 static SCM_DEFINE_SUBR(extlib_weak_vector_setX__STUB, 3, 0, SCM_OBJ(&extlib_weak_vector_setX__NAME), extlib_weak_vector_setX, NULL, NULL);
2865
2866 static ScmObj extlib_setter_SETTER(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2867 {
2868 ScmObj proc_scm;
2869 ScmProcedure* proc;
2870 ScmObj setter_scm;
2871 ScmProcedure* setter;
2872 SCM_ENTER_SUBR("(setter setter)");
2873 proc_scm = SCM_ARGREF(0);
2874 if (!SCM_PROCEDUREP(proc_scm)) Scm_Error("procedure required, but got %S", proc_scm);
2875 proc = SCM_PROCEDURE(proc_scm);
2876 setter_scm = SCM_ARGREF(1);
2877 if (!SCM_PROCEDUREP(setter_scm)) Scm_Error("procedure required, but got %S", setter_scm);
2878 setter = SCM_PROCEDURE(setter_scm);
2879 {
2880 Scm_SetterSet(proc, setter, FALSE);
2881 SCM_RETURN(SCM_UNDEFINED);
2882 }
2883 }
2884
2885 static SCM_DEFINE_STRING_CONST(extlib_setter_SETTER__NAME, "(setter setter)", 15, 15);
2886 static SCM_DEFINE_SUBR(extlib_setter_SETTER__STUB, 2, 0, SCM_OBJ(&extlib_setter_SETTER__NAME), extlib_setter_SETTER, NULL, NULL);
2887
2888 static ScmObj extlib_setter(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2889 {
2890 ScmObj proc_scm;
2891 ScmObj proc;
2892 SCM_ENTER_SUBR("setter");
2893 proc_scm = SCM_ARGREF(0);
2894 proc = (proc_scm);
2895 {
2896 {
2897 ScmObj SCM_RESULT;
2898 SCM_RESULT = Scm_Setter(proc);
2899 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2900 }
2901 }
2902 }
2903
2904 static SCM_DEFINE_STRING_CONST(extlib_setter__NAME, "setter", 6, 6);
2905 static SCM_DEFINE_SUBR(extlib_setter__STUB, 1, 0, SCM_OBJ(&extlib_setter__NAME), extlib_setter, SCM_MAKE_INT(SCM_VM_SETTER), NULL);
2906
2907 static ScmObj extlib_has_setterP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2908 {
2909 ScmObj proc_scm;
2910 ScmObj proc;
2911 SCM_ENTER_SUBR("has-setter?");
2912 proc_scm = SCM_ARGREF(0);
2913 proc = (proc_scm);
2914 {
2915 {
2916 int SCM_RESULT;
2917 SCM_RESULT = Scm_HasSetter(proc);
2918 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
2919 }
2920 }
2921 }
2922
2923 static SCM_DEFINE_STRING_CONST(extlib_has_setterP__NAME, "has-setter?", 11, 11);
2924 static SCM_DEFINE_SUBR(extlib_has_setterP__STUB, 1, 0, SCM_OBJ(&extlib_has_setterP__NAME), extlib_has_setterP, NULL, NULL);
2925
2926 static ScmObj extlib_identity(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2927 {
2928 ScmObj val_scm;
2929 ScmObj val;
2930 SCM_ENTER_SUBR("identity");
2931 val_scm = SCM_ARGREF(0);
2932 val = (val_scm);
2933 {
2934 {
2935 ScmObj SCM_RESULT;
2936 SCM_RESULT = (val);
2937 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2938 }
2939 }
2940 }
2941
2942 static SCM_DEFINE_STRING_CONST(extlib_identity__NAME, "identity", 8, 8);
2943 static SCM_DEFINE_SUBR(extlib_identity__STUB, 1, 0, SCM_OBJ(&extlib_identity__NAME), extlib_identity, NULL, NULL);
2944
2945 static ScmObj extlib_promiseP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2946 {
2947 ScmObj obj_scm;
2948 ScmObj obj;
2949 SCM_ENTER_SUBR("promise?");
2950 obj_scm = SCM_ARGREF(0);
2951 obj = (obj_scm);
2952 {
2953 {
2954 int SCM_RESULT;
2955 SCM_RESULT = (SCM_XTYPEP(obj, SCM_CLASS_PROMISE));
2956 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
2957 }
2958 }
2959 }
2960
2961 static SCM_DEFINE_STRING_CONST(extlib_promiseP__NAME, "promise?", 8, 8);
2962 static SCM_DEFINE_SUBR(extlib_promiseP__STUB, 1, 0, SCM_OBJ(&extlib_promiseP__NAME), extlib_promiseP, NULL, NULL);
2963
2964 static ScmObj extlib_eager(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2965 {
2966 ScmObj obj_scm;
2967 ScmObj obj;
2968 SCM_ENTER_SUBR("eager");
2969 obj_scm = SCM_ARGREF(0);
2970 obj = (obj_scm);
2971 {
2972 {
2973 ScmObj SCM_RESULT;
2974 SCM_RESULT = (Scm_MakePromise(TRUE, obj));
2975 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
2976 }
2977 }
2978 }
2979
2980 static SCM_DEFINE_STRING_CONST(extlib_eager__NAME, "eager", 5, 5);
2981 static SCM_DEFINE_SUBR(extlib_eager__STUB, 1, 0, SCM_OBJ(&extlib_eager__NAME), extlib_eager, NULL, NULL);
2982
2983 static ScmObj extlib_promise_kind_SETTER(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
2984 {
2985 ScmObj p_scm;
2986 ScmPromise* p;
2987 ScmObj obj_scm;
2988 ScmObj obj;
2989 SCM_ENTER_SUBR("(setter promise-kind)");
2990 p_scm = SCM_ARGREF(0);
2991 if (!SCM_PROMISEP(p_scm)) Scm_Error("promise required, but got %S", p_scm);
2992 p = SCM_PROMISE(p_scm);
2993 obj_scm = SCM_ARGREF(1);
2994 obj = (obj_scm);
2995 {
2996 p->kind = obj;
2997 SCM_RETURN(SCM_UNDEFINED);
2998 }
2999 }
3000
3001 static SCM_DEFINE_STRING_CONST(extlib_promise_kind_SETTER__NAME, "(setter promise-kind)", 21, 21);
3002 static SCM_DEFINE_SUBR(extlib_promise_kind_SETTER__STUB, 2, 0, SCM_OBJ(&extlib_promise_kind_SETTER__NAME), extlib_promise_kind_SETTER, NULL, NULL);
3003
3004 static ScmObj extlib_promise_kind(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3005 {
3006 ScmObj p_scm;
3007 ScmPromise* p;
3008 SCM_ENTER_SUBR("promise-kind");
3009 p_scm = SCM_ARGREF(0);
3010 if (!SCM_PROMISEP(p_scm)) Scm_Error("promise required, but got %S", p_scm);
3011 p = SCM_PROMISE(p_scm);
3012 {
3013 {
3014 ScmObj SCM_RESULT;
3015 SCM_RESULT = (p->kind);
3016 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3017 }
3018 }
3019 }
3020
3021 static SCM_DEFINE_STRING_CONST(extlib_promise_kind__NAME, "promise-kind", 12, 12);
3022 static SCM_DEFINE_SUBR(extlib_promise_kind__STUB, 1, 0, SCM_OBJ(&extlib_promise_kind__NAME), extlib_promise_kind, NULL, NULL);
3023
3024 static SCM_DEFINE_STRING_CONST(key_error__NAME, "error", 5, 5);
3025 static ScmObj key_error = SCM_UNBOUND;
3026 static SCM_DEFINE_STRING_CONST(key_create__NAME, "create", 6, 6);
3027 static ScmObj key_create = SCM_UNBOUND;
3028 static SCM_DEFINE_STRING_CONST(key_append__NAME, "append", 6, 6);
3029 static ScmObj key_append = SCM_UNBOUND;
3030 static SCM_DEFINE_STRING_CONST(key_supersede__NAME, "supersede", 9, 9);
3031 static ScmObj key_supersede = SCM_UNBOUND;
3032 static SCM_DEFINE_STRING_CONST(key_overwrite__NAME, "overwrite", 9, 9);
3033 static ScmObj key_overwrite = SCM_UNBOUND;
3034 static SCM_DEFINE_STRING_CONST(key_character__NAME, "character", 9, 9);
3035 static ScmObj key_character = SCM_UNBOUND;
3036 static SCM_DEFINE_STRING_CONST(key_binary__NAME, "binary", 6, 6);
3037 static ScmObj key_binary = SCM_UNBOUND;
3038 static SCM_DEFINE_STRING_CONST(KEYARG_if_does_not_exist__NAME, "if-does-not-exist", 17, 17);
3039 static ScmObj KEYARG_if_does_not_exist = SCM_UNBOUND;
3040 static SCM_DEFINE_STRING_CONST(KEYARG_buffering__NAME, "buffering", 9, 9);
3041 static ScmObj KEYARG_buffering = SCM_UNBOUND;
3042 static SCM_DEFINE_STRING_CONST(KEYARG_element_type__NAME, "element-type", 12, 12);
3043 static ScmObj KEYARG_element_type = SCM_UNBOUND;
3044 static ScmObj extlib__25open_input_file(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3045 {
3046 ScmObj path_scm;
3047 ScmString* path;
3048 ScmObj if_does_not_exist_scm;
3049 ScmObj if_does_not_exist;
3050 ScmObj buffering_scm;
3051 ScmObj buffering;
3052 ScmObj element_type_scm;
3053 ScmObj element_type;
3054 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3055 SCM_ENTER_SUBR("%open-input-file");
3056 path_scm = SCM_ARGREF(0);
3057 if (!SCM_STRINGP(path_scm)) Scm_Error("string required, but got %S", path_scm);
3058 path = SCM_STRING(path_scm);
3059 if_does_not_exist_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_if_does_not_exist), SCM_OPTARGS, key_error);
3060 if_does_not_exist = (if_does_not_exist_scm);
3061 buffering_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_buffering), SCM_OPTARGS, SCM_FALSE);
3062 buffering = (buffering_scm);
3063 element_type_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_element_type), SCM_OPTARGS, key_character);
3064 element_type = (element_type_scm);
3065 {
3066 ScmObj o; int ignerr = FALSE, bufmode;
3067 if (SCM_FALSEP(if_does_not_exist)) ignerr = TRUE;
3068 else if (!SCM_EQ(if_does_not_exist, key_error)) {
3069 Scm_Error("argument for :if-does-not-exist must be either :error or #f, but got %S", if_does_not_exist);
3070 }
3071 bufmode = Scm_BufferingMode(buffering, SCM_PORT_INPUT, SCM_PORT_BUFFER_FULL);
3072 o = Scm_OpenFilePort(Scm_GetStringConst(path), O_RDONLY, bufmode, 0);
3073 if (o == SCM_FALSE && !ignerr) {
3074 Scm_Error("couldn't open input file: %S", path_scm);
3075 }
3076 SCM_RETURN(o);
3077 }
3078 }
3079
3080 static SCM_DEFINE_STRING_CONST(extlib__25open_input_file__NAME, "%open-input-file", 16, 16);
3081 static SCM_DEFINE_SUBR(extlib__25open_input_file__STUB, 1, 1, SCM_OBJ(&extlib__25open_input_file__NAME), extlib__25open_input_file, NULL, NULL);
3082
3083 static SCM_DEFINE_STRING_CONST(KEYARG_if_exists__NAME, "if-exists", 9, 9);
3084 static ScmObj KEYARG_if_exists = SCM_UNBOUND;
3085 static SCM_DEFINE_STRING_CONST(KEYARG_mode__NAME, "mode", 4, 4);
3086 static ScmObj KEYARG_mode = SCM_UNBOUND;
3087 static ScmObj extlib__25open_output_file(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3088 {
3089 ScmObj path_scm;
3090 ScmString* path;
3091 ScmObj if_exists_scm;
3092 ScmObj if_exists;
3093 ScmObj if_does_not_exist_scm;
3094 ScmObj if_does_not_exist;
3095 ScmObj mode_scm;
3096 int mode;
3097 ScmObj buffering_scm;
3098 ScmObj buffering;
3099 ScmObj element_type_scm;
3100 ScmObj element_type;
3101 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3102 SCM_ENTER_SUBR("%open-output-file");
3103 path_scm = SCM_ARGREF(0);
3104 if (!SCM_STRINGP(path_scm)) Scm_Error("string required, but got %S", path_scm);
3105 path = SCM_STRING(path_scm);
3106 if_exists_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_if_exists), SCM_OPTARGS, key_supersede);
3107 if_exists = (if_exists_scm);
3108 if_does_not_exist_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_if_does_not_exist), SCM_OPTARGS, key_create);
3109 if_does_not_exist = (if_does_not_exist_scm);
3110 mode_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_mode), SCM_OPTARGS, Scm_MakeInteger(438));
3111 if (!SCM_INTP(mode_scm)) Scm_Error("small integer required, but got %S", mode_scm);
3112 mode = SCM_INT_VALUE(mode_scm);
3113 buffering_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_buffering), SCM_OPTARGS, SCM_FALSE);
3114 buffering = (buffering_scm);
3115 element_type_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_element_type), SCM_OPTARGS, key_character);
3116 element_type = (element_type_scm);
3117 {
3118 ScmObj o;
3119 int ignerr = FALSE, bufmode, flags = O_WRONLY;
3120
3121 if (SCM_EQ(if_exists, key_append)) flags |= O_APPEND;
3122 else if (SCM_EQ(if_exists, key_error)) {
3123 flags |= O_EXCL;
3124 if (SCM_EQ(if_does_not_exist, key_error)) {
3125 Scm_Error("bad flag combination: :if-exists and :if-does-not-exist can't be :error the same time.");
3126 }
3127 }
3128 else if (SCM_EQ(if_exists, key_supersede)) flags |= O_TRUNC;
3129 else if (SCM_EQ(if_exists, key_overwrite)) /*no need to add flags*/;
3130 else if (SCM_FALSEP(if_exists)) { flags |= O_EXCL; ignerr = TRUE; }
3131 else {
3132 Scm_Error("argument for :if-exists must be either :supersede, :overwrite, :append, :error or #f, but got %S", if_exists);
3133 }
3134
3135 if (SCM_EQ(if_does_not_exist, key_create)) flags |= O_CREAT;
3136 else if (SCM_FALSEP(if_does_not_exist)) ignerr = TRUE;
3137 else if (!SCM_EQ(if_does_not_exist, key_error)) {
3138 Scm_Error("argument for :if-does-not-exist must be either :error, :create or #f, but got %S", if_does_not_exist);
3139 }
3140
3141 bufmode = Scm_BufferingMode(buffering, SCM_PORT_OUTPUT, SCM_PORT_BUFFER_FULL);
3142 o = Scm_OpenFilePort(Scm_GetStringConst(path), flags, bufmode, mode);
3143 if (!ignerr && o == SCM_FALSE) {
3144 Scm_Error("couldn't open output file: %S", path_scm);
3145 }
3146 SCM_RETURN(o);
3147 }
3148 }
3149
3150 static SCM_DEFINE_STRING_CONST(extlib__25open_output_file__NAME, "%open-output-file", 17, 17);
3151 static SCM_DEFINE_SUBR(extlib__25open_output_file__STUB, 1, 1, SCM_OBJ(&extlib__25open_output_file__NAME), extlib__25open_output_file, NULL, NULL);
3152
3153 static SCM_DEFINE_STRING_CONST(KEYARG_privateP__NAME, "private?", 8, 8);
3154 static ScmObj KEYARG_privateP = SCM_UNBOUND;
3155 static ScmObj extlib_open_input_string(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3156 {
3157 ScmObj string_scm;
3158 ScmString* string;
3159 ScmObj privateP_scm;
3160 int privateP;
3161 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3162 SCM_ENTER_SUBR("open-input-string");
3163 string_scm = SCM_ARGREF(0);
3164 if (!SCM_STRINGP(string_scm)) Scm_Error("string required, but got %S", string_scm);
3165 string = SCM_STRING(string_scm);
3166 privateP_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_privateP), SCM_OPTARGS, SCM_FALSE);
3167 if (!SCM_BOOLP(privateP_scm)) Scm_Error("boolean required, but got %S", privateP_scm);
3168 privateP = SCM_BOOL_VALUE(privateP_scm);
3169 {
3170 {
3171 ScmObj SCM_RESULT;
3172 SCM_RESULT = Scm_MakeInputStringPort(string, privateP);
3173 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3174 }
3175 }
3176 }
3177
3178 static SCM_DEFINE_STRING_CONST(extlib_open_input_string__NAME, "open-input-string", 17, 17);
3179 static SCM_DEFINE_SUBR(extlib_open_input_string__STUB, 1, 1, SCM_OBJ(&extlib_open_input_string__NAME), extlib_open_input_string, NULL, NULL);
3180
3181 static ScmObj extlib_open_output_string(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3182 {
3183 ScmObj privateP_scm;
3184 int privateP;
3185 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3186 SCM_ENTER_SUBR("open-output-string");
3187 privateP_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_privateP), SCM_OPTARGS, SCM_FALSE);
3188 if (!SCM_BOOLP(privateP_scm)) Scm_Error("boolean required, but got %S", privateP_scm);
3189 privateP = SCM_BOOL_VALUE(privateP_scm);
3190 {
3191 {
3192 ScmObj SCM_RESULT;
3193 SCM_RESULT = Scm_MakeOutputStringPort(privateP);
3194 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3195 }
3196 }
3197 }
3198
3199 static SCM_DEFINE_STRING_CONST(extlib_open_output_string__NAME, "open-output-string", 18, 18);
3200 static SCM_DEFINE_SUBR(extlib_open_output_string__STUB, 0, 1, SCM_OBJ(&extlib_open_output_string__NAME), extlib_open_output_string, NULL, NULL);
3201
3202 static ScmObj extlib_get_output_string(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3203 {
3204 ScmObj oport_scm;
3205 ScmPort* oport;
3206 SCM_ENTER_SUBR("get-output-string");
3207 oport_scm = SCM_ARGREF(0);
3208 if (!SCM_OPORTP(oport_scm)) Scm_Error("output port required, but got %S", oport_scm);
3209 oport = SCM_PORT(oport_scm);
3210 {
3211 {
3212 ScmObj SCM_RESULT;
3213 SCM_RESULT = Scm_GetOutputString(oport);
3214 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3215 }
3216 }
3217 }
3218
3219 static SCM_DEFINE_STRING_CONST(extlib_get_output_string__NAME, "get-output-string", 17, 17);
3220 static SCM_DEFINE_SUBR(extlib_get_output_string__STUB, 1, 0, SCM_OBJ(&extlib_get_output_string__NAME), extlib_get_output_string, NULL, NULL);
3221
3222 static ScmObj extlib_get_remaining_input_string(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3223 {
3224 ScmObj iport_scm;
3225 ScmPort* iport;
3226 SCM_ENTER_SUBR("get-remaining-input-string");
3227 iport_scm = SCM_ARGREF(0);
3228 if (!SCM_IPORTP(iport_scm)) Scm_Error("input port required, but got %S", iport_scm);
3229 iport = SCM_PORT(iport_scm);
3230 {
3231 {
3232 ScmObj SCM_RESULT;
3233 SCM_RESULT = Scm_GetRemainingInputString(iport);
3234 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3235 }
3236 }
3237 }
3238
3239 static SCM_DEFINE_STRING_CONST(extlib_get_remaining_input_string__NAME, "get-remaining-input-string", 26, 26);
3240 static SCM_DEFINE_SUBR(extlib_get_remaining_input_string__STUB, 1, 0, SCM_OBJ(&extlib_get_remaining_input_string__NAME), extlib_get_remaining_input_string, NULL, NULL);
3241
3242 static ScmObj extlib_open_coding_aware_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3243 {
3244 ScmObj iport_scm;
3245 ScmPort* iport;
3246 SCM_ENTER_SUBR("open-coding-aware-port");
3247 iport_scm = SCM_ARGREF(0);
3248 if (!SCM_IPORTP(iport_scm)) Scm_Error("input port required, but got %S", iport_scm);
3249 iport = SCM_PORT(iport_scm);
3250 {
3251 {
3252 ScmObj SCM_RESULT;
3253 SCM_RESULT = Scm_MakeCodingAwarePort(iport);
3254 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3255 }
3256 }
3257 }
3258
3259 static SCM_DEFINE_STRING_CONST(extlib_open_coding_aware_port__NAME, "open-coding-aware-port", 22, 22);
3260 static SCM_DEFINE_SUBR(extlib_open_coding_aware_port__STUB, 1, 0, SCM_OBJ(&extlib_open_coding_aware_port__NAME), extlib_open_coding_aware_port, NULL, NULL);
3261
3262 static void bufport_closer(ScmPort *p)
3263 {
3264 if (SCM_PORT_DIR(p) == SCM_PORT_OUTPUT) {
3265 ScmObj scmflusher = SCM_OBJ(p->src.buf.data);
3266 int siz = (int)(p->src.buf.current - p->src.buf.buffer);
3267 if (siz > 0) Scm_Apply(scmflusher, SCM_LIST1(Scm_MakeString(p->src.buf.buffer, siz, siz, SCM_MAKSTR_INCOMPLETE|SCM_MAKSTR_COPYING)));
3268 Scm_Apply(scmflusher, SCM_LIST1(SCM_FALSE));
3269 }
3270 }
3271 static int bufport_filler(ScmPort *p, int cnt)
3272 {
3273 ScmObj scmfiller, r; int siz;
3274 const ScmStringBody *b;
3275 scmfiller = SCM_OBJ(p->src.buf.data);
3276 /* no need to use VMApply; we're in the C callback */
3277 r = Scm_Apply(scmfiller, SCM_LIST1(Scm_MakeInteger(cnt)));
3278 if (SCM_EOFP(r) || SCM_FALSEP(r)) {
3279 return 0;
3280 } else if (!SCM_STRINGP(r)) {
3281 Scm_Error("buffered port callback procedure returned non-string: %S", r);
3282 }
3283 b = SCM_STRING_BODY(r);
3284 siz = SCM_STRING_BODY_SIZE(b);
3285 if (siz > cnt) siz = cnt; /* for safety */
3286 memcpy(p->src.buf.end, SCM_STRING_BODY_START(b), siz);
3287 return SCM_STRING_BODY_SIZE(b);
3288 }
3289 static ScmObj extlib_open_input_buffered_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3290 {
3291 ScmObj filler_scm;
3292 ScmProcedure* filler;
3293 ScmObj buffer_size_scm;
3294 int buffer_size;
3295 SCM_ENTER_SUBR("open-input-buffered-port");
3296 filler_scm = SCM_ARGREF(0);
3297 if (!SCM_PROCEDUREP(filler_scm)) Scm_Error("procedure required, but got %S", filler_scm);
3298 filler = SCM_PROCEDURE(filler_scm);
3299 buffer_size_scm = SCM_ARGREF(1);
3300 if (!SCM_INTP(buffer_size_scm)) Scm_Error("small integer required, but got %S", buffer_size_scm);
3301 buffer_size = SCM_INT_VALUE(buffer_size_scm);
3302 {
3303 ScmPortBuffer bufrec;
3304 bufrec.size = buffer_size;
3305 bufrec.buffer = NULL;
3306 bufrec.mode = SCM_PORT_BUFFER_FULL;
3307 bufrec.filler = bufport_filler;
3308 bufrec.flusher = NULL;
3309 bufrec.closer = bufport_closer;
3310 bufrec.ready = NULL;
3311 bufrec.filenum = NULL;
3312 bufrec.data = (void*)filler;
3313 SCM_RETURN(Scm_MakeBufferedPort(SCM_CLASS_PORT, SCM_FALSE, SCM_PORT_INPUT, TRUE, &bufrec));
3314
3315 }
3316 }
3317
3318 static SCM_DEFINE_STRING_CONST(extlib_open_input_buffered_port__NAME, "open-input-buffered-port", 24, 24);
3319 static SCM_DEFINE_SUBR(extlib_open_input_buffered_port__STUB, 2, 0, SCM_OBJ(&extlib_open_input_buffered_port__NAME), extlib_open_input_buffered_port, NULL, NULL);
3320
3321 static int bufport_flusher(ScmPort *p, int cnt, int forcep)
3322 {
3323 ScmObj scmflusher, s;
3324 scmflusher = SCM_OBJ(p->src.buf.data);
3325 s = Scm_MakeString(p->src.buf.buffer, cnt, cnt, SCM_MAKSTR_INCOMPLETE|SCM_MAKSTR_COPYING);
3326 Scm_Apply(scmflusher, SCM_LIST1(s));
3327 return cnt;
3328 }
3329 static ScmObj extlib_open_output_buffered_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3330 {
3331 ScmObj flusher_scm;
3332 ScmProcedure* flusher;
3333 ScmObj buffer_size_scm;
3334 int buffer_size;
3335 SCM_ENTER_SUBR("open-output-buffered-port");
3336 flusher_scm = SCM_ARGREF(0);
3337 if (!SCM_PROCEDUREP(flusher_scm)) Scm_Error("procedure required, but got %S", flusher_scm);
3338 flusher = SCM_PROCEDURE(flusher_scm);
3339 buffer_size_scm = SCM_ARGREF(1);
3340 if (!SCM_INTP(buffer_size_scm)) Scm_Error("small integer required, but got %S", buffer_size_scm);
3341 buffer_size = SCM_INT_VALUE(buffer_size_scm);
3342 {
3343 ScmPortBuffer bufrec;
3344 bufrec.size = buffer_size;
3345 bufrec.buffer = NULL;
3346 bufrec.mode = SCM_PORT_BUFFER_FULL;
3347 bufrec.filler = NULL;
3348 bufrec.flusher = bufport_flusher;
3349 bufrec.closer = bufport_closer;
3350 bufrec.ready = NULL;
3351 bufrec.filenum = NULL;
3352 bufrec.data = (void*)flusher;
3353 SCM_RETURN(Scm_MakeBufferedPort(SCM_CLASS_PORT, SCM_FALSE, SCM_PORT_OUTPUT, TRUE, &bufrec));
3354
3355 }
3356 }
3357
3358 static SCM_DEFINE_STRING_CONST(extlib_open_output_buffered_port__NAME, "open-output-buffered-port", 25, 25);
3359 static SCM_DEFINE_SUBR(extlib_open_output_buffered_port__STUB, 2, 0, SCM_OBJ(&extlib_open_output_buffered_port__NAME), extlib_open_output_buffered_port, NULL, NULL);
3360
3361 static ScmObj extlib_flush(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3362 {
3363 ScmObj oport_scm;
3364 ScmPort* oport;
3365 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3366 SCM_ENTER_SUBR("flush");
3367 if (Scm_Length(SCM_OPTARGS) > 1)
3368 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
3369 if (SCM_NULLP(SCM_OPTARGS)) oport_scm = SCM_OBJ(SCM_CUROUT);
3370 else {
3371 oport_scm = SCM_CAR(SCM_OPTARGS);
3372 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
3373 }
3374 if (!SCM_OPORTP(oport_scm)) Scm_Error("output port required, but got %S", oport_scm);
3375 oport = SCM_PORT(oport_scm);
3376 {
3377 Scm_Flush(oport);
3378 SCM_RETURN(SCM_UNDEFINED);
3379 }
3380 }
3381
3382 static SCM_DEFINE_STRING_CONST(extlib_flush__NAME, "flush", 5, 5);
3383 static SCM_DEFINE_SUBR(extlib_flush__STUB, 0, 1, SCM_OBJ(&extlib_flush__NAME), extlib_flush, NULL, NULL);
3384
3385 static ScmObj extlib_flush_all_ports(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3386 {
3387 SCM_ENTER_SUBR("flush-all-ports");
3388 {
3389 Scm_FlushAllPorts(FALSE);
3390 SCM_RETURN(SCM_UNDEFINED);
3391 }
3392 }
3393
3394 static SCM_DEFINE_STRING_CONST(extlib_flush_all_ports__NAME, "flush-all-ports", 15, 15);
3395 static SCM_DEFINE_SUBR(extlib_flush_all_ports__STUB, 0, 0, SCM_OBJ(&extlib_flush_all_ports__NAME), extlib_flush_all_ports, NULL, NULL);
3396
3397 static ScmObj extlib_port_closedP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3398 {
3399 ScmObj obj_scm;
3400 ScmPort* obj;
3401 SCM_ENTER_SUBR("port-closed?");
3402 obj_scm = SCM_ARGREF(0);
3403 if (!SCM_PORTP(obj_scm)) Scm_Error("port required, but got %S", obj_scm);
3404 obj = SCM_PORT(obj_scm);
3405 {
3406 {
3407 int SCM_RESULT;
3408 SCM_RESULT = SCM_PORT_CLOSED_P(obj);
3409 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
3410 }
3411 }
3412 }
3413
3414 static SCM_DEFINE_STRING_CONST(extlib_port_closedP__NAME, "port-closed?", 12, 12);
3415 static SCM_DEFINE_SUBR(extlib_port_closedP__STUB, 1, 0, SCM_OBJ(&extlib_port_closedP__NAME), extlib_port_closedP, NULL, NULL);
3416
3417 static ScmObj extlib_current_error_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3418 {
3419 SCM_ENTER_SUBR("current-error-port");
3420 {
3421 {
3422 ScmObj SCM_RESULT;
3423 SCM_RESULT = (SCM_OBJ(SCM_CURERR));
3424 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3425 }
3426 }
3427 }
3428
3429 static SCM_DEFINE_STRING_CONST(extlib_current_error_port__NAME, "current-error-port", 18, 18);
3430 static SCM_DEFINE_SUBR(extlib_current_error_port__STUB, 0, 0, SCM_OBJ(&extlib_current_error_port__NAME), extlib_current_error_port, SCM_MAKE_INT(SCM_VM_CURERR), NULL);
3431
3432 static ScmObj extlib_standard_input_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3433 {
3434 SCM_ENTER_SUBR("standard-input-port");
3435 {
3436 {
3437 ScmObj SCM_RESULT;
3438 SCM_RESULT = Scm_Stdin();
3439 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3440 }
3441 }
3442 }
3443
3444 static SCM_DEFINE_STRING_CONST(extlib_standard_input_port__NAME, "standard-input-port", 19, 19);
3445 static SCM_DEFINE_SUBR(extlib_standard_input_port__STUB, 0, 0, SCM_OBJ(&extlib_standard_input_port__NAME), extlib_standard_input_port, NULL, NULL);
3446
3447 static ScmObj extlib_standard_output_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3448 {
3449 SCM_ENTER_SUBR("standard-output-port");
3450 {
3451 {
3452 ScmObj SCM_RESULT;
3453 SCM_RESULT = Scm_Stdout();
3454 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3455 }
3456 }
3457 }
3458
3459 static SCM_DEFINE_STRING_CONST(extlib_standard_output_port__NAME, "standard-output-port", 20, 20);
3460 static SCM_DEFINE_SUBR(extlib_standard_output_port__STUB, 0, 0, SCM_OBJ(&extlib_standard_output_port__NAME), extlib_standard_output_port, NULL, NULL);
3461
3462 static ScmObj extlib_standard_error_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3463 {
3464 SCM_ENTER_SUBR("standard-error-port");
3465 {
3466 {
3467 ScmObj SCM_RESULT;
3468 SCM_RESULT = Scm_Stderr();
3469 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3470 }
3471 }
3472 }
3473
3474 static SCM_DEFINE_STRING_CONST(extlib_standard_error_port__NAME, "standard-error-port", 19, 19);
3475 static SCM_DEFINE_SUBR(extlib_standard_error_port__STUB, 0, 0, SCM_OBJ(&extlib_standard_error_port__NAME), extlib_standard_error_port, NULL, NULL);
3476
3477 static ScmObj extlib_with_input_from_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3478 {
3479 ScmObj port_scm;
3480 ScmPort* port;
3481 ScmObj thunk_scm;
3482 ScmObj thunk;
3483 SCM_ENTER_SUBR("with-input-from-port");
3484 port_scm = SCM_ARGREF(0);
3485 if (!SCM_IPORTP(port_scm)) Scm_Error("input port required, but got %S", port_scm);
3486 port = SCM_PORT(port_scm);
3487 thunk_scm = SCM_ARGREF(1);
3488 thunk = (thunk_scm);
3489 {
3490 {
3491 ScmObj SCM_RESULT;
3492 SCM_RESULT = (Scm_WithPort(&port, thunk, SCM_PORT_CURIN, FALSE));
3493 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3494 }
3495 }
3496 }
3497
3498 static SCM_DEFINE_STRING_CONST(extlib_with_input_from_port__NAME, "with-input-from-port", 20, 20);
3499 static SCM_DEFINE_SUBR(extlib_with_input_from_port__STUB, 2, 0, SCM_OBJ(&extlib_with_input_from_port__NAME), extlib_with_input_from_port, NULL, NULL);
3500
3501 static ScmObj extlib_with_output_to_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3502 {
3503 ScmObj port_scm;
3504 ScmPort* port;
3505 ScmObj thunk_scm;
3506 ScmObj thunk;
3507 SCM_ENTER_SUBR("with-output-to-port");
3508 port_scm = SCM_ARGREF(0);
3509 if (!SCM_OPORTP(port_scm)) Scm_Error("output port required, but got %S", port_scm);
3510 port = SCM_PORT(port_scm);
3511 thunk_scm = SCM_ARGREF(1);
3512 thunk = (thunk_scm);
3513 {
3514 {
3515 ScmObj SCM_RESULT;
3516 SCM_RESULT = (Scm_WithPort(&port, thunk, SCM_PORT_CUROUT, FALSE));
3517 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3518 }
3519 }
3520 }
3521
3522 static SCM_DEFINE_STRING_CONST(extlib_with_output_to_port__NAME, "with-output-to-port", 19, 19);
3523 static SCM_DEFINE_SUBR(extlib_with_output_to_port__STUB, 2, 0, SCM_OBJ(&extlib_with_output_to_port__NAME), extlib_with_output_to_port, NULL, NULL);
3524
3525 static ScmObj extlib_with_error_to_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3526 {
3527 ScmObj port_scm;
3528 ScmPort* port;
3529 ScmObj thunk_scm;
3530 ScmObj thunk;
3531 SCM_ENTER_SUBR("with-error-to-port");
3532 port_scm = SCM_ARGREF(0);
3533 if (!SCM_OPORTP(port_scm)) Scm_Error("output port required, but got %S", port_scm);
3534 port = SCM_PORT(port_scm);
3535 thunk_scm = SCM_ARGREF(1);
3536 thunk = (thunk_scm);
3537 {
3538 {
3539 ScmObj SCM_RESULT;
3540 SCM_RESULT = (Scm_WithPort(&port, thunk, SCM_PORT_CURERR, FALSE));
3541 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3542 }
3543 }
3544 }
3545
3546 static SCM_DEFINE_STRING_CONST(extlib_with_error_to_port__NAME, "with-error-to-port", 18, 18);
3547 static SCM_DEFINE_SUBR(extlib_with_error_to_port__STUB, 2, 0, SCM_OBJ(&extlib_with_error_to_port__NAME), extlib_with_error_to_port, NULL, NULL);
3548
3549 static ScmObj extlib_port_name(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3550 {
3551 ScmObj port_scm;
3552 ScmPort* port;
3553 SCM_ENTER_SUBR("port-name");
3554 port_scm = SCM_ARGREF(0);
3555 if (!SCM_PORTP(port_scm)) Scm_Error("port required, but got %S", port_scm);
3556 port = SCM_PORT(port_scm);
3557 {
3558 {
3559 ScmObj SCM_RESULT;
3560 SCM_RESULT = Scm_PortName(port);
3561 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3562 }
3563 }
3564 }
3565
3566 static SCM_DEFINE_STRING_CONST(extlib_port_name__NAME, "port-name", 9, 9);
3567 static SCM_DEFINE_SUBR(extlib_port_name__STUB, 1, 0, SCM_OBJ(&extlib_port_name__NAME), extlib_port_name, NULL, NULL);
3568
3569 static ScmObj extlib_port_current_line(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3570 {
3571 ScmObj port_scm;
3572 ScmPort* port;
3573 SCM_ENTER_SUBR("port-current-line");
3574 port_scm = SCM_ARGREF(0);
3575 if (!SCM_PORTP(port_scm)) Scm_Error("port required, but got %S", port_scm);
3576 port = SCM_PORT(port_scm);
3577 {
3578 {
3579 int SCM_RESULT;
3580 SCM_RESULT = Scm_PortLine(port);
3581 SCM_RETURN(SCM_MAKE_INT(SCM_RESULT));
3582 }
3583 }
3584 }
3585
3586 static SCM_DEFINE_STRING_CONST(extlib_port_current_line__NAME, "port-current-line", 17, 17);
3587 static SCM_DEFINE_SUBR(extlib_port_current_line__STUB, 1, 0, SCM_OBJ(&extlib_port_current_line__NAME), extlib_port_current_line, NULL, NULL);
3588
3589 static ScmObj extlib_port_file_number(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3590 {
3591 ScmObj port_scm;
3592 ScmPort* port;
3593 SCM_ENTER_SUBR("port-file-number");
3594 port_scm = SCM_ARGREF(0);
3595 if (!SCM_PORTP(port_scm)) Scm_Error("port required, but got %S", port_scm);
3596 port = SCM_PORT(port_scm);
3597 {
3598 int i = Scm_PortFileNo(port);
3599 SCM_RETURN((i < 0)? SCM_FALSE : Scm_MakeInteger(i));
3600 }
3601 }
3602
3603 static SCM_DEFINE_STRING_CONST(extlib_port_file_number__NAME, "port-file-number", 16, 16);
3604 static SCM_DEFINE_SUBR(extlib_port_file_number__STUB, 1, 0, SCM_OBJ(&extlib_port_file_number__NAME), extlib_port_file_number, NULL, NULL);
3605
3606 static SCM_DEFINE_STRING_CONST(extlib_SEEK_SET__VAR__NAME, "SEEK_SET", 8, 8);
3607 static ScmObj extlib_SEEK_SET__VAR = SCM_UNBOUND;
3608 static SCM_DEFINE_STRING_CONST(extlib_SEEK_CUR__VAR__NAME, "SEEK_CUR", 8, 8);
3609 static ScmObj extlib_SEEK_CUR__VAR = SCM_UNBOUND;
3610 static SCM_DEFINE_STRING_CONST(extlib_SEEK_END__VAR__NAME, "SEEK_END", 8, 8);
3611 static ScmObj extlib_SEEK_END__VAR = SCM_UNBOUND;
3612 static ScmObj extlib_port_seek(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3613 {
3614 ScmObj port_scm;
3615 ScmPort* port;
3616 ScmObj offset_scm;
3617 ScmObj offset;
3618 ScmObj whence_scm;
3619 int whence;
3620 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3621 SCM_ENTER_SUBR("port-seek");
3622 if (Scm_Length(SCM_OPTARGS) > 1)
3623 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
3624 port_scm = SCM_ARGREF(0);
3625 if (!SCM_PORTP(port_scm)) Scm_Error("port required, but got %S", port_scm);
3626 port = SCM_PORT(port_scm);
3627 offset_scm = SCM_ARGREF(1);
3628 if (!SCM_EXACTP(offset_scm)) Scm_Error("exact integer required, but got %S", offset_scm);
3629 offset = (offset_scm);
3630 if (SCM_NULLP(SCM_OPTARGS)) whence_scm = SCM_MAKE_INT(SEEK_SET);
3631 else {
3632 whence_scm = SCM_CAR(SCM_OPTARGS);
3633 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
3634 }
3635 if (!SCM_INTP(whence_scm)) Scm_Error("small integer required, but got %S", whence_scm);
3636 whence = SCM_INT_VALUE(whence_scm);
3637 {
3638 {
3639 ScmObj SCM_RESULT;
3640 SCM_RESULT = Scm_PortSeek(port, offset, whence);
3641 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3642 }
3643 }
3644 }
3645
3646 static SCM_DEFINE_STRING_CONST(extlib_port_seek__NAME, "port-seek", 9, 9);
3647 static SCM_DEFINE_SUBR(extlib_port_seek__STUB, 2, 1, SCM_OBJ(&extlib_port_seek__NAME), extlib_port_seek, NULL, NULL);
3648
3649 static SCM_DEFINE_STRING_CONST(sym_file__NAME, "file", 4, 4);
3650 static ScmObj sym_file = SCM_UNBOUND;
3651 static SCM_DEFINE_STRING_CONST(sym_string__NAME, "string", 6, 6);
3652 static ScmObj sym_string = SCM_UNBOUND;
3653 static SCM_DEFINE_STRING_CONST(sym_proc__NAME, "proc", 4, 4);
3654 static ScmObj sym_proc = SCM_UNBOUND;
3655 static ScmObj extlib_port_type(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3656 {
3657 ScmObj port_scm;
3658 ScmPort* port;
3659 SCM_ENTER_SUBR("port-type");
3660 port_scm = SCM_ARGREF(0);
3661 if (!SCM_PORTP(port_scm)) Scm_Error("port required, but got %S", port_scm);
3662 port = SCM_PORT(port_scm);
3663 {
3664 ScmObj type = SCM_FALSE;
3665 switch (SCM_PORT_TYPE(port)) {
3666 case SCM_PORT_FILE: type = sym_file; break;
3667 case SCM_PORT_PROC: type = sym_proc; break;
3668 case SCM_PORT_OSTR:;
3669 case SCM_PORT_ISTR: type = sym_string; break;
3670 }
3671 SCM_RETURN(type);
3672 }
3673 }
3674
3675 static SCM_DEFINE_STRING_CONST(extlib_port_type__NAME, "port-type", 9, 9);
3676 static SCM_DEFINE_SUBR(extlib_port_type__STUB, 1, 0, SCM_OBJ(&extlib_port_type__NAME), extlib_port_type, NULL, NULL);
3677
3678 static ScmObj extlib_port_buffering_SETTER(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3679 {
3680 ScmObj port_scm;
3681 ScmPort* port;
3682 ScmObj mode_scm;
3683 ScmObj mode;
3684 SCM_ENTER_SUBR("(setter port-buffering)");
3685 port_scm = SCM_ARGREF(0);
3686 if (!SCM_PORTP(port_scm)) Scm_Error("port required, but got %S", port_scm);
3687 port = SCM_PORT(port_scm);
3688 mode_scm = SCM_ARGREF(1);
3689 mode = (mode_scm);
3690 {
3691 if (SCM_PORT_TYPE(port) != SCM_PORT_FILE) {
3692 Scm_Error("can't set buffering mode to non-buffered port: %S", port);
3693 }
3694 port->src.buf.mode = Scm_BufferingMode(mode, port->direction, -1);
3695 SCM_RETURN(SCM_UNDEFINED);
3696 }
3697 }
3698
3699 static SCM_DEFINE_STRING_CONST(extlib_port_buffering_SETTER__NAME, "(setter port-buffering)", 23, 23);
3700 static SCM_DEFINE_SUBR(extlib_port_buffering_SETTER__STUB, 2, 0, SCM_OBJ(&extlib_port_buffering_SETTER__NAME), extlib_port_buffering_SETTER, NULL, NULL);
3701
3702 static ScmObj extlib_port_buffering(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3703 {
3704 ScmObj port_scm;
3705 ScmPort* port;
3706 SCM_ENTER_SUBR("port-buffering");
3707 port_scm = SCM_ARGREF(0);
3708 if (!SCM_PORTP(port_scm)) Scm_Error("port required, but got %S", port_scm);
3709 port = SCM_PORT(port_scm);
3710 {
3711 {
3712 ScmObj SCM_RESULT;
3713 SCM_RESULT = Scm_GetBufferingMode(port);
3714 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3715 }
3716 }
3717 }
3718
3719 static SCM_DEFINE_STRING_CONST(extlib_port_buffering__NAME, "port-buffering", 14, 14);
3720 static SCM_DEFINE_SUBR(extlib_port_buffering__STUB, 1, 0, SCM_OBJ(&extlib_port_buffering__NAME), extlib_port_buffering, NULL, NULL);
3721
3722 static SCM_DEFINE_STRING_CONST(KEYARG_ownerP__NAME, "owner?", 6, 6);
3723 static ScmObj KEYARG_ownerP = SCM_UNBOUND;
3724 static SCM_DEFINE_STRING_CONST(KEYARG_name__NAME, "name", 4, 4);
3725 static ScmObj KEYARG_name = SCM_UNBOUND;
3726 static ScmObj extlib_open_input_fd_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3727 {
3728 ScmObj fd_scm;
3729 int fd;
3730 ScmObj buffering_scm;
3731 ScmObj buffering;
3732 ScmObj ownerP_scm;
3733 int ownerP;
3734 ScmObj name_scm;
3735 ScmObj name;
3736 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3737 SCM_ENTER_SUBR("open-input-fd-port");
3738 fd_scm = SCM_ARGREF(0);
3739 if (!SCM_INTP(fd_scm)) Scm_Error("small integer required, but got %S", fd_scm);
3740 fd = SCM_INT_VALUE(fd_scm);
3741 buffering_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_buffering), SCM_OPTARGS, SCM_FALSE);
3742 buffering = (buffering_scm);
3743 ownerP_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_ownerP), SCM_OPTARGS, SCM_FALSE);
3744 if (!SCM_BOOLP(ownerP_scm)) Scm_Error("boolean required, but got %S", ownerP_scm);
3745 ownerP = SCM_BOOL_VALUE(ownerP_scm);
3746 name_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_name), SCM_OPTARGS, SCM_FALSE);
3747 name = (name_scm);
3748 {
3749 int bufmode = Scm_BufferingMode(buffering, SCM_PORT_INPUT, SCM_PORT_BUFFER_FULL);
3750 if (fd < 0) Scm_Error("bad file descriptor: %d", fd);
3751 return Scm_MakePortWithFd(name, SCM_PORT_INPUT, fd, bufmode, ownerP);
3752 }
3753 }
3754
3755 static SCM_DEFINE_STRING_CONST(extlib_open_input_fd_port__NAME, "open-input-fd-port", 18, 18);
3756 static SCM_DEFINE_SUBR(extlib_open_input_fd_port__STUB, 1, 1, SCM_OBJ(&extlib_open_input_fd_port__NAME), extlib_open_input_fd_port, NULL, NULL);
3757
3758 static ScmObj extlib_open_output_fd_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3759 {
3760 ScmObj fd_scm;
3761 int fd;
3762 ScmObj buffering_scm;
3763 ScmObj buffering;
3764 ScmObj ownerP_scm;
3765 int ownerP;
3766 ScmObj name_scm;
3767 ScmObj name;
3768 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3769 SCM_ENTER_SUBR("open-output-fd-port");
3770 fd_scm = SCM_ARGREF(0);
3771 if (!SCM_INTP(fd_scm)) Scm_Error("small integer required, but got %S", fd_scm);
3772 fd = SCM_INT_VALUE(fd_scm);
3773 buffering_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_buffering), SCM_OPTARGS, SCM_FALSE);
3774 buffering = (buffering_scm);
3775 ownerP_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_ownerP), SCM_OPTARGS, SCM_FALSE);
3776 if (!SCM_BOOLP(ownerP_scm)) Scm_Error("boolean required, but got %S", ownerP_scm);
3777 ownerP = SCM_BOOL_VALUE(ownerP_scm);
3778 name_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_name), SCM_OPTARGS, SCM_FALSE);
3779 name = (name_scm);
3780 {
3781 int bufmode = Scm_BufferingMode(buffering, SCM_PORT_OUTPUT, SCM_PORT_BUFFER_FULL);
3782 if (fd < 0) Scm_Error("bad file descriptor: %d", fd);
3783 return Scm_MakePortWithFd(name, SCM_PORT_OUTPUT, fd, bufmode, ownerP);
3784 }
3785 }
3786
3787 static SCM_DEFINE_STRING_CONST(extlib_open_output_fd_port__NAME, "open-output-fd-port", 19, 19);
3788 static SCM_DEFINE_SUBR(extlib_open_output_fd_port__STUB, 1, 1, SCM_OBJ(&extlib_open_output_fd_port__NAME), extlib_open_output_fd_port, NULL, NULL);
3789
3790 static ScmObj extlib_with_port_locking(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3791 {
3792 ScmObj port_scm;
3793 ScmPort* port;
3794 ScmObj proc_scm;
3795 ScmObj proc;
3796 SCM_ENTER_SUBR("with-port-locking");
3797 port_scm = SCM_ARGREF(0);
3798 if (!SCM_PORTP(port_scm)) Scm_Error("port required, but got %S", port_scm);
3799 port = SCM_PORT(port_scm);
3800 proc_scm = SCM_ARGREF(1);
3801 proc = (proc_scm);
3802 {
3803 {
3804 ScmObj SCM_RESULT;
3805 SCM_RESULT = Scm_VMWithPortLocking(port, proc);
3806 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
3807 }
3808 }
3809 }
3810
3811 static SCM_DEFINE_STRING_CONST(extlib_with_port_locking__NAME, "with-port-locking", 17, 17);
3812 static SCM_DEFINE_SUBR(extlib_with_port_locking__STUB, 2, 0, SCM_OBJ(&extlib_with_port_locking__NAME), extlib_with_port_locking, NULL, NULL);
3813
3814 static ScmObj extlib_port_TObyte_string(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3815 {
3816 ScmObj port_scm;
3817 ScmPort* port;
3818 SCM_ENTER_SUBR("port->byte-string");
3819 port_scm = SCM_ARGREF(0);
3820 if (!SCM_IPORTP(port_scm)) Scm_Error("input port required, but got %S", port_scm);
3821 port = SCM_PORT(port_scm);
3822 {
3823 int b; ScmPort *out = SCM_PORT(Scm_MakeOutputStringPort(TRUE));
3824 for (;;) {
3825 SCM_GETB(b, port);
3826 if (b == EOF) break;
3827 Scm_PutbUnsafe(b, out);
3828 }
3829 SCM_RETURN(Scm_GetOutputString(out));
3830 }
3831 }
3832
3833 static SCM_DEFINE_STRING_CONST(extlib_port_TObyte_string__NAME, "port->byte-string", 17, 17);
3834 static SCM_DEFINE_SUBR(extlib_port_TObyte_string__STUB, 1, 0, SCM_OBJ(&extlib_port_TObyte_string__NAME), extlib_port_TObyte_string, NULL, NULL);
3835
3836 static ScmObj extlib_byte_readyP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3837 {
3838 ScmObj port_scm;
3839 ScmPort* port;
3840 SCM_ENTER_SUBR("byte-ready?");
3841 port_scm = SCM_ARGREF(0);
3842 if (!SCM_IPORTP(port_scm)) Scm_Error("input port required, but got %S", port_scm);
3843 port = SCM_PORT(port_scm);
3844 {
3845 {
3846 int SCM_RESULT;
3847 SCM_RESULT = Scm_ByteReady(port);
3848 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
3849 }
3850 }
3851 }
3852
3853 static SCM_DEFINE_STRING_CONST(extlib_byte_readyP__NAME, "byte-ready?", 11, 11);
3854 static SCM_DEFINE_SUBR(extlib_byte_readyP__STUB, 1, 0, SCM_OBJ(&extlib_byte_readyP__NAME), extlib_byte_readyP, NULL, NULL);
3855
3856 static ScmObj extlib_read_byte(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3857 {
3858 ScmObj port_scm;
3859 ScmPort* port;
3860 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3861 SCM_ENTER_SUBR("read-byte");
3862 if (Scm_Length(SCM_OPTARGS) > 1)
3863 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
3864 if (SCM_NULLP(SCM_OPTARGS)) port_scm = SCM_OBJ(SCM_CURIN);
3865 else {
3866 port_scm = SCM_CAR(SCM_OPTARGS);
3867 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
3868 }
3869 if (!SCM_IPORTP(port_scm)) Scm_Error("input port required, but got %S", port_scm);
3870 port = SCM_PORT(port_scm);
3871 {
3872 int b; SCM_GETB(b, port);
3873 SCM_RETURN((b < 0)? SCM_EOF : SCM_MAKE_INT(b));
3874 }
3875 }
3876
3877 static SCM_DEFINE_STRING_CONST(extlib_read_byte__NAME, "read-byte", 9, 9);
3878 static SCM_DEFINE_SUBR(extlib_read_byte__STUB, 0, 1, SCM_OBJ(&extlib_read_byte__NAME), extlib_read_byte, NULL, NULL);
3879
3880 static ScmObj extlib_peek_byte(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3881 {
3882 ScmObj port_scm;
3883 ScmPort* port;
3884 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3885 SCM_ENTER_SUBR("peek-byte");
3886 if (Scm_Length(SCM_OPTARGS) > 1)
3887 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
3888 if (SCM_NULLP(SCM_OPTARGS)) port_scm = SCM_OBJ(SCM_CURIN);
3889 else {
3890 port_scm = SCM_CAR(SCM_OPTARGS);
3891 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
3892 }
3893 if (!SCM_IPORTP(port_scm)) Scm_Error("input port required, but got %S", port_scm);
3894 port = SCM_PORT(port_scm);
3895 {
3896 int b = Scm_Peekb(port);
3897 SCM_RETURN((b < 0)? SCM_EOF : SCM_MAKE_INT(b));
3898 }
3899 }
3900
3901 static SCM_DEFINE_STRING_CONST(extlib_peek_byte__NAME, "peek-byte", 9, 9);
3902 static SCM_DEFINE_SUBR(extlib_peek_byte__STUB, 0, 1, SCM_OBJ(&extlib_peek_byte__NAME), extlib_peek_byte, NULL, NULL);
3903
3904 static ScmObj extlib_read_line(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3905 {
3906 ScmObj port_scm;
3907 ScmPort* port;
3908 ScmObj allowbytestr_scm;
3909 ScmObj allowbytestr;
3910 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3911 SCM_ENTER_SUBR("read-line");
3912 if (Scm_Length(SCM_OPTARGS) > 2)
3913 Scm_Error("too many arguments: up to 2 is expected, %d given.", Scm_Length(SCM_OPTARGS));
3914 if (SCM_NULLP(SCM_OPTARGS)) port_scm = SCM_OBJ(SCM_CURIN);
3915 else {
3916 port_scm = SCM_CAR(SCM_OPTARGS);
3917 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
3918 }
3919 if (!SCM_IPORTP(port_scm)) Scm_Error("input port required, but got %S", port_scm);
3920 port = SCM_PORT(port_scm);
3921 if (SCM_NULLP(SCM_OPTARGS)) allowbytestr_scm = SCM_FALSE;
3922 else {
3923 allowbytestr_scm = SCM_CAR(SCM_OPTARGS);
3924 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
3925 }
3926 allowbytestr = (allowbytestr_scm);
3927 {
3928 ScmObj r = Scm_ReadLine(port);
3929 if (SCM_FALSEP(allowbytestr)&&SCM_STRINGP(r)&&SCM_STRING_INCOMPLETE_P(r)) {
3930 Scm_ReadError(port, "read-line: encountered illegal byte sequence: %S", r);
3931 }
3932 SCM_RETURN(r);
3933 }
3934 }
3935
3936 static SCM_DEFINE_STRING_CONST(extlib_read_line__NAME, "read-line", 9, 9);
3937 static SCM_DEFINE_SUBR(extlib_read_line__STUB, 0, 1, SCM_OBJ(&extlib_read_line__NAME), extlib_read_line, NULL, NULL);
3938
3939 static ScmObj extlib_read_block(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3940 {
3941 ScmObj bytes_scm;
3942 int bytes;
3943 ScmObj port_scm;
3944 ScmPort* port;
3945 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3946 SCM_ENTER_SUBR("read-block");
3947 if (Scm_Length(SCM_OPTARGS) > 1)
3948 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
3949 bytes_scm = SCM_ARGREF(0);
3950 if (!SCM_INTP(bytes_scm)) Scm_Error("small integer required, but got %S", bytes_scm);
3951 bytes = SCM_INT_VALUE(bytes_scm);
3952 if (SCM_NULLP(SCM_OPTARGS)) port_scm = SCM_OBJ(SCM_CURIN);
3953 else {
3954 port_scm = SCM_CAR(SCM_OPTARGS);
3955 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
3956 }
3957 if (!SCM_IPORTP(port_scm)) Scm_Error("input port required, but got %S", port_scm);
3958 port = SCM_PORT(port_scm);
3959 {
3960 char *buf; int nread;
3961 if (bytes < 0) Scm_Error("bytes must be non-negative integer: %d", bytes);
3962 if (bytes == 0) SCM_RETURN(Scm_MakeString("", 0, 0, 0));
3963 buf = SCM_NEW_ATOMIC2(char*, bytes);
3964 nread = Scm_Getz(buf, bytes, port);
3965 if (nread <= 0) {
3966 SCM_RETURN(SCM_EOF);
3967 } else {
3968 SCM_RETURN(Scm_MakeString(buf, nread, nread, SCM_MAKSTR_INCOMPLETE));
3969 }
3970 }
3971 }
3972
3973 static SCM_DEFINE_STRING_CONST(extlib_read_block__NAME, "read-block", 10, 10);
3974 static SCM_DEFINE_SUBR(extlib_read_block__STUB, 1, 1, SCM_OBJ(&extlib_read_block__NAME), extlib_read_block, NULL, NULL);
3975
3976 static ScmObj extlib_read_list(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
3977 {
3978 ScmObj closer_scm;
3979 ScmChar closer;
3980 ScmObj port_scm;
3981 ScmObj port;
3982 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
3983 SCM_ENTER_SUBR("read-list");
3984 if (Scm_Length(SCM_OPTARGS) > 1)
3985 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
3986 closer_scm = SCM_ARGREF(0);
3987 if (!SCM_CHARP(closer_scm)) Scm_Error("character required, but got %S", closer_scm);
3988 closer = SCM_CHAR_VALUE(closer_scm);
3989 if (SCM_NULLP(SCM_OPTARGS)) port_scm = SCM_OBJ(SCM_CURIN);
3990 else {
3991 port_scm = SCM_CAR(SCM_OPTARGS);
3992 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
3993 }
3994 port = (port_scm);
3995 {
3996 SCM_RETURN(Scm_ReadList(port, closer));
3997 }
3998 }
3999
4000 static SCM_DEFINE_STRING_CONST(extlib_read_list__NAME, "read-list", 9, 9);
4001 static SCM_DEFINE_SUBR(extlib_read_list__STUB, 1, 1, SCM_OBJ(&extlib_read_list__NAME), extlib_read_list, NULL, NULL);
4002
4003 static ScmObj extlib_define_reader_ctor(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4004 {
4005 ScmObj symbol_scm;
4006 ScmObj symbol;
4007 ScmObj proc_scm;
4008 ScmObj proc;
4009 ScmObj finisher_scm;
4010 ScmObj finisher;
4011 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4012 SCM_ENTER_SUBR("define-reader-ctor");
4013 if (Scm_Length(SCM_OPTARGS) > 1)
4014 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
4015 symbol_scm = SCM_ARGREF(0);
4016 symbol = (symbol_scm);
4017 proc_scm = SCM_ARGREF(1);
4018 proc = (proc_scm);
4019 if (SCM_NULLP(SCM_OPTARGS)) finisher_scm = SCM_FALSE;
4020 else {
4021 finisher_scm = SCM_CAR(SCM_OPTARGS);
4022 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
4023 }
4024 finisher = (finisher_scm);
4025 {
4026 {
4027 ScmObj SCM_RESULT;
4028 SCM_RESULT = Scm_DefineReaderCtor(symbol, proc, finisher);
4029 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4030 }
4031 }
4032 }
4033
4034 static SCM_DEFINE_STRING_CONST(extlib_define_reader_ctor__NAME, "define-reader-ctor", 18, 18);
4035 static SCM_DEFINE_SUBR(extlib_define_reader_ctor__STUB, 2, 1, SCM_OBJ(&extlib_define_reader_ctor__NAME), extlib_define_reader_ctor, NULL, NULL);
4036
4037 static ScmObj extlib_read_referenceP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4038 {
4039 ScmObj obj_scm;
4040 ScmObj obj;
4041 SCM_ENTER_SUBR("read-reference?");
4042 obj_scm = SCM_ARGREF(0);
4043 obj = (obj_scm);
4044 {
4045 {
4046 int SCM_RESULT;
4047 SCM_RESULT = SCM_READ_REFERENCE_P(obj);
4048 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
4049 }
4050 }
4051 }
4052
4053 static SCM_DEFINE_STRING_CONST(extlib_read_referenceP__NAME, "read-reference?", 15, 15);
4054 static SCM_DEFINE_SUBR(extlib_read_referenceP__STUB, 1, 0, SCM_OBJ(&extlib_read_referenceP__NAME), extlib_read_referenceP, NULL, NULL);
4055
4056 static ScmObj extlib_read_reference_has_valueP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4057 {
4058 ScmObj ref_scm;
4059 ScmReadReference* ref;
4060 SCM_ENTER_SUBR("read-reference-has-value?");
4061 ref_scm = SCM_ARGREF(0);
4062 if (!SCM_READ_REFERENCE_P(ref_scm)) Scm_Error("read reference required, but got %S", ref_scm);
4063 ref = SCM_READ_REFERENCE(ref_scm);
4064 {
4065 {
4066 int SCM_RESULT;
4067 SCM_RESULT = (!SCM_UNBOUNDP(ref->value));
4068 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
4069 }
4070 }
4071 }
4072
4073 static SCM_DEFINE_STRING_CONST(extlib_read_reference_has_valueP__NAME, "read-reference-has-value?", 25, 25);
4074 static SCM_DEFINE_SUBR(extlib_read_reference_has_valueP__STUB, 1, 0, SCM_OBJ(&extlib_read_reference_has_valueP__NAME), extlib_read_reference_has_valueP, NULL, NULL);
4075
4076 static ScmObj extlib_read_reference_value(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4077 {
4078 ScmObj ref_scm;
4079 ScmReadReference* ref;
4080 SCM_ENTER_SUBR("read-reference-value");
4081 ref_scm = SCM_ARGREF(0);
4082 if (!SCM_READ_REFERENCE_P(ref_scm)) Scm_Error("read reference required, but got %S", ref_scm);
4083 ref = SCM_READ_REFERENCE(ref_scm);
4084 {
4085 if (SCM_UNBOUNDP(ref->value))
4086 Scm_Error("read reference hasn't been resolved");
4087 SCM_RETURN(ref->value);
4088 }
4089 }
4090
4091 static SCM_DEFINE_STRING_CONST(extlib_read_reference_value__NAME, "read-reference-value", 20, 20);
4092 static SCM_DEFINE_SUBR(extlib_read_reference_value__STUB, 1, 0, SCM_OBJ(&extlib_read_reference_value__NAME), extlib_read_reference_value, NULL, NULL);
4093
4094 static ScmObj extlib_write_byte(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4095 {
4096 ScmObj byte_scm;
4097 int byte;
4098 ScmObj port_scm;
4099 ScmPort* port;
4100 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4101 SCM_ENTER_SUBR("write-byte");
4102 if (Scm_Length(SCM_OPTARGS) > 1)
4103 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
4104 byte_scm = SCM_ARGREF(0);
4105 if (!SCM_INTP(byte_scm)) Scm_Error("small integer required, but got %S", byte_scm);
4106 byte = SCM_INT_VALUE(byte_scm);
4107 if (SCM_NULLP(SCM_OPTARGS)) port_scm = SCM_OBJ(SCM_CUROUT);
4108 else {
4109 port_scm = SCM_CAR(SCM_OPTARGS);
4110 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
4111 }
4112 if (!SCM_OPORTP(port_scm)) Scm_Error("output port required, but got %S", port_scm);
4113 port = SCM_PORT(port_scm);
4114 {
4115 if (byte < 0 || byte > 255) Scm_Error("argument out of range: %d", byte);
4116 SCM_PUTB(byte, port);
4117 SCM_RETURN(SCM_MAKE_INT(1));
4118 }
4119 }
4120
4121 static SCM_DEFINE_STRING_CONST(extlib_write_byte__NAME, "write-byte", 10, 10);
4122 static SCM_DEFINE_SUBR(extlib_write_byte__STUB, 1, 1, SCM_OBJ(&extlib_write_byte__NAME), extlib_write_byte, NULL, NULL);
4123
4124 static ScmObj extlib_write_limited(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4125 {
4126 ScmObj obj_scm;
4127 ScmObj obj;
4128 ScmObj limit_scm;
4129 int limit;
4130 ScmObj port_scm;
4131 ScmObj port;
4132 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4133 SCM_ENTER_SUBR("write-limited");
4134 if (Scm_Length(SCM_OPTARGS) > 1)
4135 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
4136 obj_scm = SCM_ARGREF(0);
4137 obj = (obj_scm);
4138 limit_scm = SCM_ARGREF(1);
4139 if (!SCM_INTP(limit_scm)) Scm_Error("small integer required, but got %S", limit_scm);
4140 limit = SCM_INT_VALUE(limit_scm);
4141 if (SCM_NULLP(SCM_OPTARGS)) port_scm = SCM_OBJ(SCM_CUROUT);
4142 else {
4143 port_scm = SCM_CAR(SCM_OPTARGS);
4144 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
4145 }
4146 port = (port_scm);
4147 {
4148 int n = Scm_WriteLimited(obj, port, SCM_WRITE_WRITE, limit);
4149 SCM_RETURN(SCM_MAKE_INT(n));
4150 }
4151 }
4152
4153 static SCM_DEFINE_STRING_CONST(extlib_write_limited__NAME, "write-limited", 13, 13);
4154 static SCM_DEFINE_SUBR(extlib_write_limited__STUB, 2, 1, SCM_OBJ(&extlib_write_limited__NAME), extlib_write_limited, NULL, NULL);
4155
4156 static ScmObj extlib_write_2a(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4157 {
4158 ScmObj obj_scm;
4159 ScmObj obj;
4160 ScmObj port_scm;
4161 ScmObj port;
4162 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4163 SCM_ENTER_SUBR("write*");
4164 if (Scm_Length(SCM_OPTARGS) > 1)
4165 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
4166 obj_scm = SCM_ARGREF(0);
4167 obj = (obj_scm);
4168 if (SCM_NULLP(SCM_OPTARGS)) port_scm = SCM_OBJ(SCM_CUROUT);
4169 else {
4170 port_scm = SCM_CAR(SCM_OPTARGS);
4171 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
4172 }
4173 port = (port_scm);
4174 {
4175 int n = Scm_WriteCircular(obj, port, SCM_WRITE_WRITE, 0);
4176 SCM_RETURN(SCM_MAKE_INT(n));
4177 }
4178 }
4179
4180 static SCM_DEFINE_STRING_CONST(extlib_write_2a__NAME, "write*", 6, 6);
4181 static SCM_DEFINE_SUBR(extlib_write_2a__STUB, 1, 1, SCM_OBJ(&extlib_write_2a__NAME), extlib_write_2a, NULL, NULL);
4182
4183 static ScmObj extlib__25add_load_path(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4184 {
4185 ScmObj path_scm;
4186 ScmString* path;
4187 ScmObj afterp_scm;
4188 ScmObj afterp;
4189 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4190 SCM_ENTER_SUBR("%add-load-path");
4191 if (Scm_Length(SCM_OPTARGS) > 1)
4192 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
4193 path_scm = SCM_ARGREF(0);
4194 if (!SCM_STRINGP(path_scm)) Scm_Error("string required, but got %S", path_scm);
4195 path = SCM_STRING(path_scm);
4196 if (SCM_NULLP(SCM_OPTARGS)) afterp_scm = SCM_FALSE;
4197 else {
4198 afterp_scm = SCM_CAR(SCM_OPTARGS);
4199 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
4200 }
4201 afterp = (afterp_scm);
4202 {
4203 const char *cpath = Scm_GetStringConst(path);
4204 SCM_RETURN(Scm_AddLoadPath(cpath, !SCM_FALSEP(afterp)));
4205 }
4206 }
4207
4208 static SCM_DEFINE_STRING_CONST(extlib__25add_load_path__NAME, "%add-load-path", 14, 14);
4209 static SCM_DEFINE_SUBR(extlib__25add_load_path__STUB, 1, 1, SCM_OBJ(&extlib__25add_load_path__NAME), extlib__25add_load_path, NULL, NULL);
4210
4211 static SCM_DEFINE_STRING_CONST(KEYARG_init_function__NAME, "init-function", 13, 13);
4212 static ScmObj KEYARG_init_function = SCM_UNBOUND;
4213 static SCM_DEFINE_STRING_CONST(KEYARG_export_symbols__NAME, "export-symbols", 14, 14);
4214 static ScmObj KEYARG_export_symbols = SCM_UNBOUND;
4215 static ScmObj extlib_dynamic_load(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4216 {
4217 ScmObj file_scm;
4218 ScmString* file;
4219 ScmObj init_function_scm;
4220 ScmObj init_function;
4221 ScmObj export_symbols_scm;
4222 ScmObj export_symbols;
4223 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4224 SCM_ENTER_SUBR("dynamic-load");
4225 file_scm = SCM_ARGREF(0);
4226 if (!SCM_STRINGP(file_scm)) Scm_Error("string required, but got %S", file_scm);
4227 file = SCM_STRING(file_scm);
4228 init_function_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_init_function), SCM_OPTARGS, SCM_FALSE);
4229 init_function = (init_function_scm);
4230 export_symbols_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_export_symbols), SCM_OPTARGS, SCM_FALSE);
4231 export_symbols = (export_symbols_scm);
4232 {
4233 {
4234 ScmObj SCM_RESULT;
4235 SCM_RESULT = (Scm_DynLoad(file, init_function, !SCM_FALSEP(export_symbols)));
4236 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4237 }
4238 }
4239 }
4240
4241 static SCM_DEFINE_STRING_CONST(extlib_dynamic_load__NAME, "dynamic-load", 12, 12);
4242 static SCM_DEFINE_SUBR(extlib_dynamic_load__STUB, 1, 1, SCM_OBJ(&extlib_dynamic_load__NAME), extlib_dynamic_load, NULL, NULL);
4243
4244 static ScmObj extlib__25require(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4245 {
4246 ScmObj feature_scm;
4247 ScmObj feature;
4248 SCM_ENTER_SUBR("%require");
4249 feature_scm = SCM_ARGREF(0);
4250 feature = (feature_scm);
4251 {
4252 {
4253 ScmObj SCM_RESULT;
4254 SCM_RESULT = Scm_Require(feature);
4255 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4256 }
4257 }
4258 }
4259
4260 static SCM_DEFINE_STRING_CONST(extlib__25require__NAME, "%require", 8, 8);
4261 static SCM_DEFINE_SUBR(extlib__25require__STUB, 1, 0, SCM_OBJ(&extlib__25require__NAME), extlib__25require, NULL, NULL);
4262
4263 static ScmObj extlib_provide(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4264 {
4265 ScmObj feature_scm;
4266 ScmObj feature;
4267 SCM_ENTER_SUBR("provide");
4268 feature_scm = SCM_ARGREF(0);
4269 feature = (feature_scm);
4270 {
4271 {
4272 ScmObj SCM_RESULT;
4273 SCM_RESULT = Scm_Provide(feature);
4274 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4275 }
4276 }
4277 }
4278
4279 static SCM_DEFINE_STRING_CONST(extlib_provide__NAME, "provide", 7, 7);
4280 static SCM_DEFINE_SUBR(extlib_provide__STUB, 1, 0, SCM_OBJ(&extlib_provide__NAME), extlib_provide, NULL, NULL);
4281
4282 static ScmObj extlib_providedP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4283 {
4284 ScmObj feature_scm;
4285 ScmObj feature;
4286 SCM_ENTER_SUBR("provided?");
4287 feature_scm = SCM_ARGREF(0);
4288 feature = (feature_scm);
4289 {
4290 {
4291 int SCM_RESULT;
4292 SCM_RESULT = Scm_ProvidedP(feature);
4293 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
4294 }
4295 }
4296 }
4297
4298 static SCM_DEFINE_STRING_CONST(extlib_providedP__NAME, "provided?", 9, 9);
4299 static SCM_DEFINE_SUBR(extlib_providedP__STUB, 1, 0, SCM_OBJ(&extlib_providedP__NAME), extlib_providedP, NULL, NULL);
4300
4301 static ScmObj extlib__25autoload(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4302 {
4303 ScmObj mod_scm;
4304 ScmModule* mod;
4305 ScmObj file_or_module_scm;
4306 ScmObj file_or_module;
4307 ScmObj entries_scm;
4308 ScmObj entries;
4309 SCM_ENTER_SUBR("%autoload");
4310 mod_scm = SCM_ARGREF(0);
4311 if (!SCM_MODULEP(mod_scm)) Scm_Error("module required, but got %S", mod_scm);
4312 mod = SCM_MODULE(mod_scm);
4313 file_or_module_scm = SCM_ARGREF(1);
4314 file_or_module = (file_or_module_scm);
4315 entries_scm = SCM_ARGREF(2);
4316 entries = (entries_scm);
4317 {
4318 Scm_DefineAutoload(mod, file_or_module, entries);
4319 SCM_RETURN(SCM_UNDEFINED);
4320 }
4321 }
4322
4323 static SCM_DEFINE_STRING_CONST(extlib__25autoload__NAME, "%autoload", 9, 9);
4324 static SCM_DEFINE_SUBR(extlib__25autoload__STUB, 3, 0, SCM_OBJ(&extlib__25autoload__NAME), extlib__25autoload, NULL, NULL);
4325
4326 static ScmObj extlib_undefined(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4327 {
4328 SCM_ENTER_SUBR("undefined");
4329 {
4330 SCM_RETURN(SCM_UNDEFINED);
4331 }
4332 }
4333
4334 static SCM_DEFINE_STRING_CONST(extlib_undefined__NAME, "undefined", 9, 9);
4335 static SCM_DEFINE_SUBR(extlib_undefined__STUB, 0, 0, SCM_OBJ(&extlib_undefined__NAME), extlib_undefined, SCM_MAKE_INT(SCM_VM_CONSTU), NULL);
4336
4337 static ScmObj extlib_undefinedP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4338 {
4339 ScmObj obj_scm;
4340 ScmObj obj;
4341 SCM_ENTER_SUBR("undefined?");
4342 obj_scm = SCM_ARGREF(0);
4343 obj = (obj_scm);
4344 {
4345 {
4346 int SCM_RESULT;
4347 SCM_RESULT = SCM_UNDEFINEDP(obj);
4348 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
4349 }
4350 }
4351 }
4352
4353 static SCM_DEFINE_STRING_CONST(extlib_undefinedP__NAME, "undefined?", 10, 10);
4354 static SCM_DEFINE_SUBR(extlib_undefinedP__STUB, 1, 0, SCM_OBJ(&extlib_undefinedP__NAME), extlib_undefinedP, NULL, NULL);
4355
4356 static ScmObj extlib_warn(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4357 {
4358 ScmObj fmt_scm;
4359 ScmString* fmt;
4360 ScmObj args_scm;
4361 ScmObj args;
4362 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4363 SCM_ENTER_SUBR("warn");
4364 fmt_scm = SCM_ARGREF(0);
4365 if (!SCM_STRINGP(fmt_scm)) Scm_Error("string required, but got %S", fmt_scm);
4366 fmt = SCM_STRING(fmt_scm);
4367 args_scm = SCM_OPTARGS;
4368 args = (args_scm);
4369 {
4370 Scm_FWarn(fmt, args);
4371 SCM_RETURN(SCM_UNDEFINED);
4372 }
4373 }
4374
4375 static SCM_DEFINE_STRING_CONST(extlib_warn__NAME, "warn", 4, 4);
4376 static SCM_DEFINE_SUBR(extlib_warn__STUB, 1, 1, SCM_OBJ(&extlib_warn__NAME), extlib_warn, NULL, NULL);
4377
4378 static ScmObj extlib_eq_hash(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4379 {
4380 ScmObj obj_scm;
4381 ScmObj obj;
4382 SCM_ENTER_SUBR("eq-hash");
4383 obj_scm = SCM_ARGREF(0);
4384 obj = (obj_scm);
4385 {
4386 {
4387 u_long SCM_RESULT;
4388 SCM_RESULT = Scm_EqHash(obj);
4389 SCM_RETURN(Scm_MakeIntegerFromUI(SCM_RESULT));
4390 }
4391 }
4392 }
4393
4394 static SCM_DEFINE_STRING_CONST(extlib_eq_hash__NAME, "eq-hash", 7, 7);
4395 static SCM_DEFINE_SUBR(extlib_eq_hash__STUB, 1, 0, SCM_OBJ(&extlib_eq_hash__NAME), extlib_eq_hash, NULL, NULL);
4396
4397 static ScmObj extlib_eqv_hash(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4398 {
4399 ScmObj obj_scm;
4400 ScmObj obj;
4401 SCM_ENTER_SUBR("eqv-hash");
4402 obj_scm = SCM_ARGREF(0);
4403 obj = (obj_scm);
4404 {
4405 {
4406 u_long SCM_RESULT;
4407 SCM_RESULT = Scm_EqvHash(obj);
4408 SCM_RETURN(Scm_MakeIntegerFromUI(SCM_RESULT));
4409 }
4410 }
4411 }
4412
4413 static SCM_DEFINE_STRING_CONST(extlib_eqv_hash__NAME, "eqv-hash", 8, 8);
4414 static SCM_DEFINE_SUBR(extlib_eqv_hash__STUB, 1, 0, SCM_OBJ(&extlib_eqv_hash__NAME), extlib_eqv_hash, NULL, NULL);
4415
4416 static ScmObj extlib_hash(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4417 {
4418 ScmObj obj_scm;
4419 ScmObj obj;
4420 SCM_ENTER_SUBR("hash");
4421 obj_scm = SCM_ARGREF(0);
4422 obj = (obj_scm);
4423 {
4424 {
4425 u_long SCM_RESULT;
4426 SCM_RESULT = Scm_Hash(obj);
4427 SCM_RETURN(Scm_MakeIntegerFromUI(SCM_RESULT));
4428 }
4429 }
4430 }
4431
4432 static SCM_DEFINE_STRING_CONST(extlib_hash__NAME, "hash", 4, 4);
4433 static SCM_DEFINE_SUBR(extlib_hash__STUB, 1, 0, SCM_OBJ(&extlib_hash__NAME), extlib_hash, NULL, NULL);
4434
4435 static int get_hash_proc(ScmSymbol *type) {
4436 if (SCM_EQ(SCM_OBJ(type), sym_eq)) return SCM_HASH_EQ;
4437 else if (SCM_EQ(SCM_OBJ(type), sym_eqv)) return SCM_HASH_EQV;
4438 else if (SCM_EQ(SCM_OBJ(type), sym_equal)) return SCM_HASH_EQUAL;
4439 else if (SCM_EQ(SCM_OBJ(type), sym_string_eq)) return SCM_HASH_STRING;
4440 else {
4441 Scm_Error("unsupported hash type: %S", type);
4442 return 0; /* dummy */
4443 }
4444 }
4445 static ScmObj extlib_make_hash_table(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4446 {
4447 ScmObj type_scm;
4448 ScmSymbol* type;
4449 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4450 SCM_ENTER_SUBR("make-hash-table");
4451 if (Scm_Length(SCM_OPTARGS) > 1)
4452 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
4453 if (SCM_NULLP(SCM_OPTARGS)) type_scm = sym_eq;
4454 else {
4455 type_scm = SCM_CAR(SCM_OPTARGS);
4456 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
4457 }
4458 if (!SCM_SYMBOLP(type_scm)) Scm_Error("symbol required, but got %S", type_scm);
4459 type = SCM_SYMBOL(type_scm);
4460 {
4461 SCM_RETURN(Scm_MakeHashTableSimple(get_hash_proc(type), 0));
4462 }
4463 }
4464
4465 static SCM_DEFINE_STRING_CONST(extlib_make_hash_table__NAME, "make-hash-table", 15, 15);
4466 static SCM_DEFINE_SUBR(extlib_make_hash_table__STUB, 0, 1, SCM_OBJ(&extlib_make_hash_table__NAME), extlib_make_hash_table, NULL, NULL);
4467
4468 static ScmObj extlib_hash_tableP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4469 {
4470 ScmObj obj_scm;
4471 ScmObj obj;
4472 SCM_ENTER_SUBR("hash-table?");
4473 obj_scm = SCM_ARGREF(0);
4474 obj = (obj_scm);
4475 {
4476 {
4477 int SCM_RESULT;
4478 SCM_RESULT = SCM_HASH_TABLE_P(obj);
4479 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
4480 }
4481 }
4482 }
4483
4484 static SCM_DEFINE_STRING_CONST(extlib_hash_tableP__NAME, "hash-table?", 11, 11);
4485 static SCM_DEFINE_SUBR(extlib_hash_tableP__STUB, 1, 0, SCM_OBJ(&extlib_hash_tableP__NAME), extlib_hash_tableP, NULL, NULL);
4486
4487 static ScmObj extlib_hash_table_type(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4488 {
4489 ScmObj hash_scm;
4490 ScmHashTable* hash;
4491 SCM_ENTER_SUBR("hash-table-type");
4492 hash_scm = SCM_ARGREF(0);
4493 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4494 hash = SCM_HASH_TABLE(hash_scm);
4495 {
4496 switch (hash->type) {
4497 case SCM_HASH_EQ: SCM_RETURN(sym_eq);
4498 case SCM_HASH_EQV: SCM_RETURN(sym_eqv);
4499 case SCM_HASH_EQUAL: SCM_RETURN(sym_equal);
4500 case SCM_HASH_STRING: SCM_RETURN(sym_string_eq);
4501 default: SCM_RETURN(SCM_FALSE); /* TODO: need to think over */
4502 }
4503 }
4504 }
4505
4506 static SCM_DEFINE_STRING_CONST(extlib_hash_table_type__NAME, "hash-table-type", 15, 15);
4507 static SCM_DEFINE_SUBR(extlib_hash_table_type__STUB, 1, 0, SCM_OBJ(&extlib_hash_table_type__NAME), extlib_hash_table_type, NULL, NULL);
4508
4509 static ScmObj extlib_hash_table_num_entries(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4510 {
4511 ScmObj hash_scm;
4512 ScmHashTable* hash;
4513 SCM_ENTER_SUBR("hash-table-num-entries");
4514 hash_scm = SCM_ARGREF(0);
4515 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4516 hash = SCM_HASH_TABLE(hash_scm);
4517 {
4518 {
4519 int SCM_RESULT;
4520 SCM_RESULT = (hash->numEntries);
4521 SCM_RETURN(Scm_MakeInteger(SCM_RESULT));
4522 }
4523 }
4524 }
4525
4526 static SCM_DEFINE_STRING_CONST(extlib_hash_table_num_entries__NAME, "hash-table-num-entries", 22, 22);
4527 static SCM_DEFINE_SUBR(extlib_hash_table_num_entries__STUB, 1, 0, SCM_OBJ(&extlib_hash_table_num_entries__NAME), extlib_hash_table_num_entries, NULL, NULL);
4528
4529 static ScmObj extlib_hash_table_get(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4530 {
4531 ScmObj hash_scm;
4532 ScmHashTable* hash;
4533 ScmObj key_scm;
4534 ScmObj key;
4535 ScmObj defval_scm;
4536 ScmObj defval;
4537 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4538 SCM_ENTER_SUBR("hash-table-get");
4539 if (Scm_Length(SCM_OPTARGS) > 1)
4540 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
4541 hash_scm = SCM_ARGREF(0);
4542 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4543 hash = SCM_HASH_TABLE(hash_scm);
4544 key_scm = SCM_ARGREF(1);
4545 key = (key_scm);
4546 if (SCM_NULLP(SCM_OPTARGS)) defval_scm = SCM_UNBOUND;
4547 else {
4548 defval_scm = SCM_CAR(SCM_OPTARGS);
4549 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
4550 }
4551 defval = (defval_scm);
4552 {
4553 ScmHashEntry *e = Scm_HashTableGet(hash, key);
4554 if (!e || e->value == SCM_UNBOUND) {
4555 if (defval != SCM_UNBOUND) SCM_RETURN(defval);
4556 else Scm_Error("hash table doesn't have an entry for key %S", key);
4557 }
4558 SCM_RETURN(e->value);
4559 }
4560 }
4561
4562 static SCM_DEFINE_STRING_CONST(extlib_hash_table_get__NAME, "hash-table-get", 14, 14);
4563 static SCM_DEFINE_SUBR(extlib_hash_table_get__STUB, 2, 1, SCM_OBJ(&extlib_hash_table_get__NAME), extlib_hash_table_get, NULL, NULL);
4564
4565 static ScmObj extlib_hash_table_putX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4566 {
4567 ScmObj hash_scm;
4568 ScmHashTable* hash;
4569 ScmObj key_scm;
4570 ScmObj key;
4571 ScmObj value_scm;
4572 ScmObj value;
4573 SCM_ENTER_SUBR("hash-table-put!");
4574 hash_scm = SCM_ARGREF(0);
4575 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4576 hash = SCM_HASH_TABLE(hash_scm);
4577 key_scm = SCM_ARGREF(1);
4578 key = (key_scm);
4579 value_scm = SCM_ARGREF(2);
4580 value = (value_scm);
4581 {
4582 Scm_HashTablePut(hash, key, value);
4583 SCM_RETURN(SCM_UNDEFINED);
4584 }
4585 }
4586
4587 static SCM_DEFINE_STRING_CONST(extlib_hash_table_putX__NAME, "hash-table-put!", 15, 15);
4588 static SCM_DEFINE_SUBR(extlib_hash_table_putX__STUB, 3, 0, SCM_OBJ(&extlib_hash_table_putX__NAME), extlib_hash_table_putX, NULL, NULL);
4589
4590 static ScmObj extlib_hash_table_deleteX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4591 {
4592 ScmObj hash_scm;
4593 ScmHashTable* hash;
4594 ScmObj key_scm;
4595 ScmObj key;
4596 SCM_ENTER_SUBR("hash-table-delete!");
4597 hash_scm = SCM_ARGREF(0);
4598 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4599 hash = SCM_HASH_TABLE(hash_scm);
4600 key_scm = SCM_ARGREF(1);
4601 key = (key_scm);
4602 {
4603 {
4604 int SCM_RESULT;
4605 SCM_RESULT = (Scm_HashTableDelete(hash, key) != NULL);
4606 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
4607 }
4608 }
4609 }
4610
4611 static SCM_DEFINE_STRING_CONST(extlib_hash_table_deleteX__NAME, "hash-table-delete!", 18, 18);
4612 static SCM_DEFINE_SUBR(extlib_hash_table_deleteX__STUB, 2, 0, SCM_OBJ(&extlib_hash_table_deleteX__NAME), extlib_hash_table_deleteX, NULL, NULL);
4613
4614 static ScmObj extlib_hash_table_existsP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4615 {
4616 ScmObj hash_scm;
4617 ScmHashTable* hash;
4618 ScmObj key_scm;
4619 ScmObj key;
4620 SCM_ENTER_SUBR("hash-table-exists?");
4621 hash_scm = SCM_ARGREF(0);
4622 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4623 hash = SCM_HASH_TABLE(hash_scm);
4624 key_scm = SCM_ARGREF(1);
4625 key = (key_scm);
4626 {
4627 {
4628 int SCM_RESULT;
4629 SCM_RESULT = (Scm_HashTableGet(hash, key) != NULL);
4630 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
4631 }
4632 }
4633 }
4634
4635 static SCM_DEFINE_STRING_CONST(extlib_hash_table_existsP__NAME, "hash-table-exists?", 18, 18);
4636 static SCM_DEFINE_SUBR(extlib_hash_table_existsP__STUB, 2, 0, SCM_OBJ(&extlib_hash_table_existsP__NAME), extlib_hash_table_existsP, NULL, NULL);
4637
4638 static ScmObj hash_table_update_cc(ScmObj result, void **data)
4639 {
4640 ScmHashEntry *e = (ScmHashEntry*)data[0];
4641 e->value = result;
4642 SCM_RETURN(result);
4643 }
4644 static ScmObj extlib_hash_table_updateX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4645 {
4646 ScmObj hash_scm;
4647 ScmHashTable* hash;
4648 ScmObj key_scm;
4649 ScmObj key;
4650 ScmObj proc_scm;
4651 ScmObj proc;
4652 ScmObj defval_scm;
4653 ScmObj defval;
4654 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4655 SCM_ENTER_SUBR("hash-table-update!");
4656 if (Scm_Length(SCM_OPTARGS) > 1)
4657 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
4658 hash_scm = SCM_ARGREF(0);
4659 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4660 hash = SCM_HASH_TABLE(hash_scm);
4661 key_scm = SCM_ARGREF(1);
4662 key = (key_scm);
4663 proc_scm = SCM_ARGREF(2);
4664 proc = (proc_scm);
4665 if (SCM_NULLP(SCM_OPTARGS)) defval_scm = SCM_UNBOUND;
4666 else {
4667 defval_scm = SCM_CAR(SCM_OPTARGS);
4668 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
4669 }
4670 defval = (defval_scm);
4671 {
4672 {
4673 ScmObj SCM_RESULT;
4674 ScmHashEntry *e;
4675 ScmObj curval;
4676 void *data[1];
4677 if (SCM_UNBOUNDP(defval)) {
4678 e = Scm_HashTableGet(hash, key);
4679 if (!e) Scm_Error("hash table doesn't have an entry for key %S", key);
4680 } else {
4681 e = Scm_HashTableAdd(hash, key, defval);
4682 }
4683 data[0] = (void*)e;
4684 Scm_VMPushCC(hash_table_update_cc, data, 1);
4685 SCM_RESULT = Scm_VMApply1(proc, e->value);
4686 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4687 }
4688 }
4689 }
4690
4691 static SCM_DEFINE_STRING_CONST(extlib_hash_table_updateX__NAME, "hash-table-update!", 18, 18);
4692 static SCM_DEFINE_SUBR(extlib_hash_table_updateX__STUB, 3, 1, SCM_OBJ(&extlib_hash_table_updateX__NAME), extlib_hash_table_updateX, NULL, NULL);
4693
4694 static ScmObj extlib_hash_table_pushX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4695 {
4696 ScmObj hash_scm;
4697 ScmHashTable* hash;
4698 ScmObj key_scm;
4699 ScmObj key;
4700 ScmObj value_scm;
4701 ScmObj value;
4702 SCM_ENTER_SUBR("hash-table-push!");
4703 hash_scm = SCM_ARGREF(0);
4704 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4705 hash = SCM_HASH_TABLE(hash_scm);
4706 key_scm = SCM_ARGREF(1);
4707 key = (key_scm);
4708 value_scm = SCM_ARGREF(2);
4709 value = (value_scm);
4710 {
4711 ScmHashEntry *e = Scm_HashTableAdd(hash, key, SCM_UNBOUND);
4712 if (SCM_UNBOUNDP(e->value)) e->value = SCM_LIST1(value);
4713 else e->value = Scm_Cons(value, e->value);
4714 SCM_RETURN(SCM_UNDEFINED);
4715 }
4716 }
4717
4718 static SCM_DEFINE_STRING_CONST(extlib_hash_table_pushX__NAME, "hash-table-push!", 16, 16);
4719 static SCM_DEFINE_SUBR(extlib_hash_table_pushX__STUB, 3, 0, SCM_OBJ(&extlib_hash_table_pushX__NAME), extlib_hash_table_pushX, NULL, NULL);
4720
4721 static ScmObj extlib_hash_table_popX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4722 {
4723 ScmObj hash_scm;
4724 ScmHashTable* hash;
4725 ScmObj key_scm;
4726 ScmObj key;
4727 ScmObj fallback_scm;
4728 ScmObj fallback;
4729 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
4730 SCM_ENTER_SUBR("hash-table-pop!");
4731 if (Scm_Length(SCM_OPTARGS) > 1)
4732 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
4733 hash_scm = SCM_ARGREF(0);
4734 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4735 hash = SCM_HASH_TABLE(hash_scm);
4736 key_scm = SCM_ARGREF(1);
4737 key = (key_scm);
4738 if (SCM_NULLP(SCM_OPTARGS)) fallback_scm = SCM_UNBOUND;
4739 else {
4740 fallback_scm = SCM_CAR(SCM_OPTARGS);
4741 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
4742 }
4743 fallback = (fallback_scm);
4744 {
4745 ScmHashEntry *e = Scm_HashTableGet(hash, key); ScmObj r;
4746 if (e == NULL) {
4747 if (SCM_UNBOUNDP(fallback)) {
4748 Scm_Error("hash table doesn't have an entry for key %S", key);
4749 }
4750 r = fallback;
4751 } else if (!SCM_PAIRP(e->value)) {
4752 if (SCM_UNBOUNDP(fallback)) {
4753 Scm_Error("hash table value for key %S is not a pair: %S", key, e->value);
4754 }
4755 r = fallback;
4756 } else {
4757 r = SCM_CAR(e->value); e->value = SCM_CDR(e->value);
4758 }
4759 SCM_RETURN(r);
4760 }
4761 }
4762
4763 static SCM_DEFINE_STRING_CONST(extlib_hash_table_popX__NAME, "hash-table-pop!", 15, 15);
4764 static SCM_DEFINE_SUBR(extlib_hash_table_popX__STUB, 2, 1, SCM_OBJ(&extlib_hash_table_popX__NAME), extlib_hash_table_popX, NULL, NULL);
4765
4766 static ScmObj hash_table_iter(ScmObj *args, int nargs, void *data)
4767 {
4768 ScmHashIter *iter = (ScmHashIter*)data;
4769 ScmHashEntry *e = Scm_HashIterNext(iter);
4770 ScmObj eofval = args[0];
4771 if (e == NULL) SCM_RETURN(Scm_Values2(eofval, eofval));
4772 else SCM_RETURN(Scm_Values2(e->key, e->value));
4773 }
4774 static ScmObj extlib__25hash_table_iter(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4775 {
4776 ScmObj hash_scm;
4777 ScmHashTable* hash;
4778 SCM_ENTER_SUBR("%hash-table-iter");
4779 hash_scm = SCM_ARGREF(0);
4780 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4781 hash = SCM_HASH_TABLE(hash_scm);
4782 {
4783 ScmHashIter *iter = SCM_NEW(ScmHashIter);
4784 Scm_HashIterInit(hash, iter);
4785 SCM_RETURN(Scm_MakeSubr(hash_table_iter, iter, 1, 0, SCM_MAKE_STR("hash-table-iterator")));
4786 }
4787 }
4788
4789 static SCM_DEFINE_STRING_CONST(extlib__25hash_table_iter__NAME, "%hash-table-iter", 16, 16);
4790 static SCM_DEFINE_SUBR(extlib__25hash_table_iter__STUB, 1, 0, SCM_OBJ(&extlib__25hash_table_iter__NAME), extlib__25hash_table_iter, NULL, NULL);
4791
4792 static ScmObj extlib_hash_table_keys(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4793 {
4794 ScmObj hash_scm;
4795 ScmHashTable* hash;
4796 SCM_ENTER_SUBR("hash-table-keys");
4797 hash_scm = SCM_ARGREF(0);
4798 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4799 hash = SCM_HASH_TABLE(hash_scm);
4800 {
4801 {
4802 ScmObj SCM_RESULT;
4803 SCM_RESULT = Scm_HashTableKeys(hash);
4804 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4805 }
4806 }
4807 }
4808
4809 static SCM_DEFINE_STRING_CONST(extlib_hash_table_keys__NAME, "hash-table-keys", 15, 15);
4810 static SCM_DEFINE_SUBR(extlib_hash_table_keys__STUB, 1, 0, SCM_OBJ(&extlib_hash_table_keys__NAME), extlib_hash_table_keys, NULL, NULL);
4811
4812 static ScmObj extlib_hash_table_values(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4813 {
4814 ScmObj hash_scm;
4815 ScmHashTable* hash;
4816 SCM_ENTER_SUBR("hash-table-values");
4817 hash_scm = SCM_ARGREF(0);
4818 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4819 hash = SCM_HASH_TABLE(hash_scm);
4820 {
4821 {
4822 ScmObj SCM_RESULT;
4823 SCM_RESULT = Scm_HashTableValues(hash);
4824 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4825 }
4826 }
4827 }
4828
4829 static SCM_DEFINE_STRING_CONST(extlib_hash_table_values__NAME, "hash-table-values", 17, 17);
4830 static SCM_DEFINE_SUBR(extlib_hash_table_values__STUB, 1, 0, SCM_OBJ(&extlib_hash_table_values__NAME), extlib_hash_table_values, NULL, NULL);
4831
4832 static ScmObj extlib_hash_table_stat(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4833 {
4834 ScmObj hash_scm;
4835 ScmHashTable* hash;
4836 SCM_ENTER_SUBR("hash-table-stat");
4837 hash_scm = SCM_ARGREF(0);
4838 if (!SCM_HASH_TABLE_P(hash_scm)) Scm_Error("hash table required, but got %S", hash_scm);
4839 hash = SCM_HASH_TABLE(hash_scm);
4840 {
4841 {
4842 ScmObj SCM_RESULT;
4843 SCM_RESULT = Scm_HashTableStat(hash);
4844 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4845 }
4846 }
4847 }
4848
4849 static SCM_DEFINE_STRING_CONST(extlib_hash_table_stat__NAME, "hash-table-stat", 15, 15);
4850 static SCM_DEFINE_SUBR(extlib_hash_table_stat__STUB, 1, 0, SCM_OBJ(&extlib_hash_table_stat__NAME), extlib_hash_table_stat, NULL, NULL);
4851
4852 static ScmObj extlib_moduleP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4853 {
4854 ScmObj obj_scm;
4855 ScmObj obj;
4856 SCM_ENTER_SUBR("module?");
4857 obj_scm = SCM_ARGREF(0);
4858 obj = (obj_scm);
4859 {
4860 {
4861 int SCM_RESULT;
4862 SCM_RESULT = SCM_MODULEP(obj);
4863 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
4864 }
4865 }
4866 }
4867
4868 static SCM_DEFINE_STRING_CONST(extlib_moduleP__NAME, "module?", 7, 7);
4869 static SCM_DEFINE_SUBR(extlib_moduleP__STUB, 1, 0, SCM_OBJ(&extlib_moduleP__NAME), extlib_moduleP, NULL, NULL);
4870
4871 static ScmObj extlib_module_name(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4872 {
4873 ScmObj mod_scm;
4874 ScmModule* mod;
4875 SCM_ENTER_SUBR("module-name");
4876 mod_scm = SCM_ARGREF(0);
4877 if (!SCM_MODULEP(mod_scm)) Scm_Error("module required, but got %S", mod_scm);
4878 mod = SCM_MODULE(mod_scm);
4879 {
4880 {
4881 ScmObj SCM_RESULT;
4882 SCM_RESULT = (SCM_OBJ(SCM_MODULE(mod)->name));
4883 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4884 }
4885 }
4886 }
4887
4888 static SCM_DEFINE_STRING_CONST(extlib_module_name__NAME, "module-name", 11, 11);
4889 static SCM_DEFINE_SUBR(extlib_module_name__STUB, 1, 0, SCM_OBJ(&extlib_module_name__NAME), extlib_module_name, NULL, NULL);
4890
4891 static ScmObj extlib_module_parents(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4892 {
4893 ScmObj mod_scm;
4894 ScmModule* mod;
4895 SCM_ENTER_SUBR("module-parents");
4896 mod_scm = SCM_ARGREF(0);
4897 if (!SCM_MODULEP(mod_scm)) Scm_Error("module required, but got %S", mod_scm);
4898 mod = SCM_MODULE(mod_scm);
4899 {
4900 {
4901 ScmObj SCM_RESULT;
4902 SCM_RESULT = (mod->parents);
4903 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4904 }
4905 }
4906 }
4907
4908 static SCM_DEFINE_STRING_CONST(extlib_module_parents__NAME, "module-parents", 14, 14);
4909 static SCM_DEFINE_SUBR(extlib_module_parents__STUB, 1, 0, SCM_OBJ(&extlib_module_parents__NAME), extlib_module_parents, NULL, NULL);
4910
4911 static ScmObj extlib_module_precedence_list(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4912 {
4913 ScmObj mod_scm;
4914 ScmModule* mod;
4915 SCM_ENTER_SUBR("module-precedence-list");
4916 mod_scm = SCM_ARGREF(0);
4917 if (!SCM_MODULEP(mod_scm)) Scm_Error("module required, but got %S", mod_scm);
4918 mod = SCM_MODULE(mod_scm);
4919 {
4920 {
4921 ScmObj SCM_RESULT;
4922 SCM_RESULT = (mod->mpl);
4923 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4924 }
4925 }
4926 }
4927
4928 static SCM_DEFINE_STRING_CONST(extlib_module_precedence_list__NAME, "module-precedence-list", 22, 22);
4929 static SCM_DEFINE_SUBR(extlib_module_precedence_list__STUB, 1, 0, SCM_OBJ(&extlib_module_precedence_list__NAME), extlib_module_precedence_list, NULL, NULL);
4930
4931 static ScmObj extlib_module_imports(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4932 {
4933 ScmObj mod_scm;
4934 ScmModule* mod;
4935 SCM_ENTER_SUBR("module-imports");
4936 mod_scm = SCM_ARGREF(0);
4937 if (!SCM_MODULEP(mod_scm)) Scm_Error("module required, but got %S", mod_scm);
4938 mod = SCM_MODULE(mod_scm);
4939 {
4940 {
4941 ScmObj SCM_RESULT;
4942 SCM_RESULT = (mod->imported);
4943 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4944 }
4945 }
4946 }
4947
4948 static SCM_DEFINE_STRING_CONST(extlib_module_imports__NAME, "module-imports", 14, 14);
4949 static SCM_DEFINE_SUBR(extlib_module_imports__STUB, 1, 0, SCM_OBJ(&extlib_module_imports__NAME), extlib_module_imports, NULL, NULL);
4950
4951 static ScmObj extlib_module_exports(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4952 {
4953 ScmObj mod_scm;
4954 ScmModule* mod;
4955 SCM_ENTER_SUBR("module-exports");
4956 mod_scm = SCM_ARGREF(0);
4957 if (!SCM_MODULEP(mod_scm)) Scm_Error("module required, but got %S", mod_scm);
4958 mod = SCM_MODULE(mod_scm);
4959 {
4960 {
4961 ScmObj SCM_RESULT;
4962 SCM_RESULT = (mod->exported);
4963 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4964 }
4965 }
4966 }
4967
4968 static SCM_DEFINE_STRING_CONST(extlib_module_exports__NAME, "module-exports", 14, 14);
4969 static SCM_DEFINE_SUBR(extlib_module_exports__STUB, 1, 0, SCM_OBJ(&extlib_module_exports__NAME), extlib_module_exports, NULL, NULL);
4970
4971 static ScmObj extlib_module_table(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4972 {
4973 ScmObj mod_scm;
4974 ScmModule* mod;
4975 SCM_ENTER_SUBR("module-table");
4976 mod_scm = SCM_ARGREF(0);
4977 if (!SCM_MODULEP(mod_scm)) Scm_Error("module required, but got %S", mod_scm);
4978 mod = SCM_MODULE(mod_scm);
4979 {
4980 {
4981 ScmObj SCM_RESULT;
4982 SCM_RESULT = (SCM_OBJ(mod->table));
4983 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
4984 }
4985 }
4986 }
4987
4988 static SCM_DEFINE_STRING_CONST(extlib_module_table__NAME, "module-table", 12, 12);
4989 static SCM_DEFINE_SUBR(extlib_module_table__STUB, 1, 0, SCM_OBJ(&extlib_module_table__NAME), extlib_module_table, NULL, NULL);
4990
4991 static ScmObj extlib_find_module(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
4992 {
4993 ScmObj name_scm;
4994 ScmSymbol* name;
4995 SCM_ENTER_SUBR("find-module");
4996 name_scm = SCM_ARGREF(0);
4997 if (!SCM_SYMBOLP(name_scm)) Scm_Error("symbol required, but got %S", name_scm);
4998 name = SCM_SYMBOL(name_scm);
4999 {
5000 {
5001 ScmModule* SCM_RESULT;
5002 SCM_RESULT = (Scm_FindModule(name, SCM_FIND_MODULE_QUIET));
5003 SCM_RETURN(SCM_MAKE_MAYBE(SCM_OBJ_SAFE, SCM_RESULT));
5004 }
5005 }
5006 }
5007
5008 static SCM_DEFINE_STRING_CONST(extlib_find_module__NAME, "find-module", 11, 11);
5009 static SCM_DEFINE_SUBR(extlib_find_module__STUB, 1, 0, SCM_OBJ(&extlib_find_module__NAME), extlib_find_module, NULL, NULL);
5010
5011 static ScmObj extlib_all_modules(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5012 {
5013 SCM_ENTER_SUBR("all-modules");
5014 {
5015 {
5016 ScmObj SCM_RESULT;
5017 SCM_RESULT = Scm_AllModules();
5018 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5019 }
5020 }
5021 }
5022
5023 static SCM_DEFINE_STRING_CONST(extlib_all_modules__NAME, "all-modules", 11, 11);
5024 static SCM_DEFINE_SUBR(extlib_all_modules__STUB, 0, 0, SCM_OBJ(&extlib_all_modules__NAME), extlib_all_modules, NULL, NULL);
5025
5026 static ScmObj extlib_make_module(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5027 {
5028 ScmObj name_scm;
5029 ScmObj name;
5030 ScmObj if_exists_scm;
5031 ScmObj if_exists;
5032 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
5033 SCM_ENTER_SUBR("make-module");
5034 name_scm = SCM_ARGREF(0);
5035 name = (name_scm);
5036 if_exists_scm = Scm_GetKeyword(SCM_OBJ(KEYARG_if_exists), SCM_OPTARGS, key_error);
5037 if_exists = (if_exists_scm);
5038 {
5039 int error_if_exists = TRUE;
5040 if (SCM_EQ(if_exists, key_error)) {
5041 error_if_exists = TRUE;
5042 } else if (SCM_FALSEP(if_exists)) {
5043 error_if_exists = FALSE;
5044 } else {
5045 Scm_Error("argument for :if-exists must be either :error or #f, but got %S", if_exists);
5046 }
5047 if (!SCM_FALSEP(name) && !SCM_SYMBOLP(name)) {
5048 Scm_Error("module name must be a symbol or #f, but got %S", name);
5049 }
5050 SCM_RETURN(Scm_MakeModule((SCM_FALSEP(name)?NULL:SCM_SYMBOL(name)),
5051 error_if_exists));
5052 }
5053 }
5054
5055 static SCM_DEFINE_STRING_CONST(extlib_make_module__NAME, "make-module", 11, 11);
5056 static SCM_DEFINE_SUBR(extlib_make_module__STUB, 1, 1, SCM_OBJ(&extlib_make_module__NAME), extlib_make_module, NULL, NULL);
5057
5058 static ScmObj extlib_module_name_TOpath(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5059 {
5060 ScmObj name_scm;
5061 ScmObj name;
5062 SCM_ENTER_SUBR("module-name->path");
5063 name_scm = SCM_ARGREF(0);
5064 name = (name_scm);
5065 {
5066 {
5067 ScmObj SCM_RESULT;
5068 ScmSymbol *s = NULL;
5069 if (SCM_SYMBOLP(name)) s = SCM_SYMBOL(name);
5070 else if (SCM_IDENTIFIERP(name)) s = SCM_IDENTIFIER(name)->name;
5071 else Scm_Error("symbol or identifier required, but got %S", name);
5072 SCM_RESULT = Scm_ModuleNameToPath(s);
5073 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5074 }
5075 }
5076 }
5077
5078 static SCM_DEFINE_STRING_CONST(extlib_module_name_TOpath__NAME, "module-name->path", 17, 17);
5079 static SCM_DEFINE_SUBR(extlib_module_name_TOpath__STUB, 1, 0, SCM_OBJ(&extlib_module_name_TOpath__NAME), extlib_module_name_TOpath, NULL, NULL);
5080
5081 static ScmObj extlib_path_TOmodule_name(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5082 {
5083 ScmObj path_scm;
5084 ScmString* path;
5085 SCM_ENTER_SUBR("path->module-name");
5086 path_scm = SCM_ARGREF(0);
5087 if (!SCM_STRINGP(path_scm)) Scm_Error("string required, but got %S", path_scm);
5088 path = SCM_STRING(path_scm);
5089 {
5090 {
5091 ScmObj SCM_RESULT;
5092 SCM_RESULT = Scm_PathToModuleName(path);
5093 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5094 }
5095 }
5096 }
5097
5098 static SCM_DEFINE_STRING_CONST(extlib_path_TOmodule_name__NAME, "path->module-name", 17, 17);
5099 static SCM_DEFINE_SUBR(extlib_path_TOmodule_name__STUB, 1, 0, SCM_OBJ(&extlib_path_TOmodule_name__NAME), extlib_path_TOmodule_name, NULL, NULL);
5100
5101 static ScmObj extlib__25export_all(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5102 {
5103 ScmObj module_scm;
5104 ScmModule* module;
5105 SCM_ENTER_SUBR("%export-all");
5106 module_scm = SCM_ARGREF(0);
5107 if (!SCM_MODULEP(module_scm)) Scm_Error("module required, but got %S", module_scm);
5108 module = SCM_MODULE(module_scm);
5109 {
5110 {
5111 ScmObj SCM_RESULT;
5112 SCM_RESULT = Scm_ExportAll(module);
5113 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5114 }
5115 }
5116 }
5117
5118 static SCM_DEFINE_STRING_CONST(extlib__25export_all__NAME, "%export-all", 11, 11);
5119 static SCM_DEFINE_SUBR(extlib__25export_all__STUB, 1, 0, SCM_OBJ(&extlib__25export_all__NAME), extlib__25export_all, NULL, NULL);
5120
5121 static ScmObj extlib__25extend_module(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5122 {
5123 ScmObj module_scm;
5124 ScmModule* module;
5125 ScmObj supers_scm;
5126 ScmObj supers;
5127 SCM_ENTER_SUBR("%extend-module");
5128 module_scm = SCM_ARGREF(0);
5129 if (!SCM_MODULEP(module_scm)) Scm_Error("module required, but got %S", module_scm);
5130 module = SCM_MODULE(module_scm);
5131 supers_scm = SCM_ARGREF(1);
5132 if (!SCM_LISTP(supers_scm)) Scm_Error("list required, but got %S", supers_scm);
5133 supers = (supers_scm);
5134 {
5135 {
5136 ScmObj SCM_RESULT;
5137 SCM_RESULT = Scm_ExtendModule(module, supers);
5138 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5139 }
5140 }
5141 }
5142
5143 static SCM_DEFINE_STRING_CONST(extlib__25extend_module__NAME, "%extend-module", 14, 14);
5144 static SCM_DEFINE_SUBR(extlib__25extend_module__STUB, 2, 0, SCM_OBJ(&extlib__25extend_module__NAME), extlib__25extend_module, NULL, NULL);
5145
5146 static ScmModule *get_module_from_mod_or_name(ScmObj mod_or_name)
5147 {
5148 if (SCM_MODULEP(mod_or_name)) return SCM_MODULE(mod_or_name);
5149 else if (SCM_SYMBOLP(mod_or_name)) {
5150 return Scm_FindModule(SCM_SYMBOL(mod_or_name), 0);
5151 } else if (SCM_FALSEP(mod_or_name)) {
5152 return SCM_CURRENT_MODULE();
5153 } else {
5154 Scm_Error("module or symbol required, but got: %S", mod_or_name);
5155 return NULL;
5156 }
5157 }
5158
5159 static ScmObj extlib_global_variable_boundP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5160 {
5161 ScmObj mod_or_name_scm;
5162 ScmObj mod_or_name;
5163 ScmObj name_scm;
5164 ScmSymbol* name;
5165 SCM_ENTER_SUBR("global-variable-bound?");
5166 mod_or_name_scm = SCM_ARGREF(0);
5167 mod_or_name = (mod_or_name_scm);
5168 name_scm = SCM_ARGREF(1);
5169 if (!SCM_SYMBOLP(name_scm)) Scm_Error("symbol required, but got %S", name_scm);
5170 name = SCM_SYMBOL(name_scm);
5171 {
5172 {
5173 int SCM_RESULT;
5174 ScmModule *module = get_module_from_mod_or_name(mod_or_name);
5175 SCM_RESULT = (Scm_SymbolValue(module, name) != SCM_UNBOUND);
5176 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
5177 }
5178 }
5179 }
5180
5181 static SCM_DEFINE_STRING_CONST(extlib_global_variable_boundP__NAME, "global-variable-bound?", 22, 22);
5182 static SCM_DEFINE_SUBR(extlib_global_variable_boundP__STUB, 2, 0, SCM_OBJ(&extlib_global_variable_boundP__NAME), extlib_global_variable_boundP, NULL, NULL);
5183
5184 static ScmObj extlib_global_variable_ref(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5185 {
5186 ScmObj mod_or_name_scm;
5187 ScmObj mod_or_name;
5188 ScmObj name_scm;
5189 ScmSymbol* name;
5190 ScmObj fallback_scm;
5191 ScmObj fallback;
5192 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
5193 SCM_ENTER_SUBR("global-variable-ref");
5194 if (Scm_Length(SCM_OPTARGS) > 1)
5195 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
5196 mod_or_name_scm = SCM_ARGREF(0);
5197 mod_or_name = (mod_or_name_scm);
5198 name_scm = SCM_ARGREF(1);
5199 if (!SCM_SYMBOLP(name_scm)) Scm_Error("symbol required, but got %S", name_scm);
5200 name = SCM_SYMBOL(name_scm);
5201 if (SCM_NULLP(SCM_OPTARGS)) fallback_scm = SCM_UNBOUND;
5202 else {
5203 fallback_scm = SCM_CAR(SCM_OPTARGS);
5204 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
5205 }
5206 fallback = (fallback_scm);
5207 {
5208 {
5209 ScmObj SCM_RESULT;
5210 ScmModule *module = get_module_from_mod_or_name(mod_or_name);
5211 ScmObj r = Scm_SymbolValue(module, name);
5212 SCM_RESULT = fallback;
5213 if (r != SCM_UNBOUND) SCM_RESULT = r;
5214 else if (fallback == SCM_UNBOUND) {
5215 Scm_Error("global variable %S is not bound in module %S", name, module);
5216 }
5217 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5218 }
5219 }
5220 }
5221
5222 static SCM_DEFINE_STRING_CONST(extlib_global_variable_ref__NAME, "global-variable-ref", 19, 19);
5223 static SCM_DEFINE_SUBR(extlib_global_variable_ref__STUB, 2, 1, SCM_OBJ(&extlib_global_variable_ref__NAME), extlib_global_variable_ref, NULL, NULL);
5224
5225 static ScmObj extlib__25format(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5226 {
5227 ScmObj port_scm;
5228 ScmPort* port;
5229 ScmObj fmt_scm;
5230 ScmString* fmt;
5231 ScmObj args_scm;
5232 ScmObj args;
5233 ScmObj shared_scm;
5234 int shared;
5235 SCM_ENTER_SUBR("%format");
5236 port_scm = SCM_ARGREF(0);
5237 if (!SCM_OPORTP(port_scm)) Scm_Error("output port required, but got %S", port_scm);
5238 port = SCM_PORT(port_scm);
5239 fmt_scm = SCM_ARGREF(1);
5240 if (!SCM_STRINGP(fmt_scm)) Scm_Error("string required, but got %S", fmt_scm);
5241 fmt = SCM_STRING(fmt_scm);
5242 args_scm = SCM_ARGREF(2);
5243 args = (args_scm);
5244 shared_scm = SCM_ARGREF(3);
5245 if (!SCM_BOOLP(shared_scm)) Scm_Error("boolean required, but got %S", shared_scm);
5246 shared = SCM_BOOL_VALUE(shared_scm);
5247 {
5248 Scm_Format(port, fmt, args, shared);
5249 SCM_RETURN(SCM_UNDEFINED);
5250 }
5251 }
5252
5253 static SCM_DEFINE_STRING_CONST(extlib__25format__NAME, "%format", 7, 7);
5254 static SCM_DEFINE_SUBR(extlib__25format__STUB, 4, 0, SCM_OBJ(&extlib__25format__NAME), extlib__25format, NULL, NULL);
5255
5256 static ScmObj extlib_exit(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5257 {
5258 ScmObj code_scm;
5259 int code;
5260 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
5261 SCM_ENTER_SUBR("exit");
5262 if (Scm_Length(SCM_OPTARGS) > 1)
5263 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
5264 if (SCM_NULLP(SCM_OPTARGS)) code_scm = Scm_MakeInteger(0);
5265 else {
5266 code_scm = SCM_CAR(SCM_OPTARGS);
5267 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
5268 }
5269 if (!SCM_INTP(code_scm)) Scm_Error("small integer required, but got %S", code_scm);
5270 code = SCM_INT_VALUE(code_scm);
5271 {
5272 Scm_Exit(code);
5273 SCM_RETURN(SCM_UNDEFINED);
5274 }
5275 }
5276
5277 static SCM_DEFINE_STRING_CONST(extlib_exit__NAME, "exit", 4, 4);
5278 static SCM_DEFINE_SUBR(extlib_exit__STUB, 0, 1, SCM_OBJ(&extlib_exit__NAME), extlib_exit, NULL, NULL);
5279
5280 static void Scm_VMClass_PRINT(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
5281 {
5282 ScmVM *vm = SCM_VM(obj);
5283 const char *state;
5284 switch (vm->state) {
5285 case SCM_VM_NEW: state = "new"; break;
5286 case SCM_VM_RUNNABLE: state = "runnable"; break;
5287 case SCM_VM_BLOCKED: state = "blocked"; break;
5288 case SCM_VM_TERMINATED: state = "terminated"; break;
5289 default: state = "(unknown state)";
5290 }
5291 Scm_Printf(port, "#<thread %S %s %p>", vm->name, state, vm);
5292 }
5293
5294 SCM_DEFINE_BUILTIN_CLASS(Scm_VMClass, Scm_VMClass_PRINT, NULL, NULL, NULL, SCM_CLASS_DEFAULT_CPL);
5295
5296 static ScmObj Scm_VMClass_name_GET(ScmObj OBJARG)
5297 {
5298 ScmVM* obj = SCM_VM(OBJARG);
5299 return SCM_OBJ_SAFE(obj->name);
5300 }
5301
5302 static void Scm_VMClass_name_SET(ScmObj OBJARG, ScmObj value)
5303 {
5304 ScmVM* obj = SCM_VM(OBJARG);
5305 obj->name = (value);
5306 }
5307
5308 static ScmObj Scm_VMClass_specific_GET(ScmObj OBJARG)
5309 {
5310 ScmVM* obj = SCM_VM(OBJARG);
5311 return SCM_OBJ_SAFE(obj->specific);
5312 }
5313
5314 static void Scm_VMClass_specific_SET(ScmObj OBJARG, ScmObj value)
5315 {
5316 ScmVM* obj = SCM_VM(OBJARG);
5317 obj->specific = (value);
5318 }
5319
5320 static ScmClassStaticSlotSpec Scm_VMClass__SLOTS[] = {
5321 SCM_CLASS_SLOT_SPEC("name", Scm_VMClass_name_GET, Scm_VMClass_name_SET),
5322 SCM_CLASS_SLOT_SPEC("specific", Scm_VMClass_specific_GET, Scm_VMClass_specific_SET),
5323 { NULL }
5324 };
5325
5326 static ScmObj extlib_vm_dump(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5327 {
5328 ScmObj vm_scm;
5329 ScmObj vm;
5330 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
5331 SCM_ENTER_SUBR("vm-dump");
5332 if (Scm_Length(SCM_OPTARGS) > 1)
5333 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
5334 if (SCM_NULLP(SCM_OPTARGS)) vm_scm = SCM_UNBOUND;
5335 else {
5336 vm_scm = SCM_CAR(SCM_OPTARGS);
5337 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
5338 }
5339 vm = (vm_scm);
5340 {
5341 if (vm == SCM_UNBOUND) vm = SCM_OBJ(Scm_VM());
5342 else if (!SCM_VMP(vm)) Scm_Error("VM object required, got %S", vm);
5343 Scm_VMDump(SCM_VM(vm));
5344 SCM_RETURN(SCM_UNDEFINED);
5345 }
5346 }
5347
5348 static SCM_DEFINE_STRING_CONST(extlib_vm_dump__NAME, "vm-dump", 7, 7);
5349 static SCM_DEFINE_SUBR(extlib_vm_dump__STUB, 0, 1, SCM_OBJ(&extlib_vm_dump__NAME), extlib_vm_dump, NULL, NULL);
5350
5351 static ScmObj extlib_vm_get_stack_trace(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5352 {
5353 ScmObj vm_scm;
5354 ScmObj vm;
5355 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
5356 SCM_ENTER_SUBR("vm-get-stack-trace");
5357 if (Scm_Length(SCM_OPTARGS) > 1)
5358 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
5359 if (SCM_NULLP(SCM_OPTARGS)) vm_scm = SCM_UNBOUND;
5360 else {
5361 vm_scm = SCM_CAR(SCM_OPTARGS);
5362 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
5363 }
5364 vm = (vm_scm);
5365 {
5366 if (vm == SCM_UNBOUND) vm = SCM_OBJ(Scm_VM());
5367 else if (!SCM_VMP(vm)) Scm_Error("VM object required, got %S", vm);
5368 SCM_RETURN(Scm_VMGetStack(SCM_VM(vm)));
5369 }
5370 }
5371
5372 static SCM_DEFINE_STRING_CONST(extlib_vm_get_stack_trace__NAME, "vm-get-stack-trace", 18, 18);
5373 static SCM_DEFINE_SUBR(extlib_vm_get_stack_trace__STUB, 0, 1, SCM_OBJ(&extlib_vm_get_stack_trace__NAME), extlib_vm_get_stack_trace, NULL, NULL);
5374
5375 static ScmObj extlib_vm_get_stack_trace_lite(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5376 {
5377 ScmObj vm_scm;
5378 ScmObj vm;
5379 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
5380 SCM_ENTER_SUBR("vm-get-stack-trace-lite");
5381 if (Scm_Length(SCM_OPTARGS) > 1)
5382 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
5383 if (SCM_NULLP(SCM_OPTARGS)) vm_scm = SCM_UNBOUND;
5384 else {
5385 vm_scm = SCM_CAR(SCM_OPTARGS);
5386 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
5387 }
5388 vm = (vm_scm);
5389 {
5390 if (vm == SCM_UNBOUND) vm = SCM_OBJ(Scm_VM());
5391 else if (!SCM_VMP(vm)) Scm_Error("VM object required, got %S", vm);
5392 SCM_RETURN(Scm_VMGetStackLite(SCM_VM(vm)));
5393 }
5394 }
5395
5396 static SCM_DEFINE_STRING_CONST(extlib_vm_get_stack_trace_lite__NAME, "vm-get-stack-trace-lite", 23, 23);
5397 static SCM_DEFINE_SUBR(extlib_vm_get_stack_trace_lite__STUB, 0, 1, SCM_OBJ(&extlib_vm_get_stack_trace_lite__NAME), extlib_vm_get_stack_trace_lite, NULL, NULL);
5398
5399 static ScmObj extlib_vm_set_default_exception_handler(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5400 {
5401 ScmObj vm_scm;
5402 ScmObj vm;
5403 ScmObj handler_scm;
5404 ScmObj handler;
5405 SCM_ENTER_SUBR("vm-set-default-exception-handler");
5406 vm_scm = SCM_ARGREF(0);
5407 vm = (vm_scm);
5408 handler_scm = SCM_ARGREF(1);
5409 handler = (handler_scm);
5410 {
5411 if (!SCM_VMP(vm)) Scm_Error("VM object required, got %S", vm);
5412 if (!SCM_FALSEP(handler) && !SCM_PROCEDUREP(handler)) {
5413 Scm_Error("a procedure or #f required, but got %S", handler);
5414 }
5415 SCM_VM(vm)->defaultEscapeHandler = handler;
5416 SCM_RETURN(SCM_UNDEFINED);
5417 }
5418 }
5419
5420 static SCM_DEFINE_STRING_CONST(extlib_vm_set_default_exception_handler__NAME, "vm-set-default-exception-handler", 32, 32);
5421 static SCM_DEFINE_SUBR(extlib_vm_set_default_exception_handler__STUB, 2, 0, SCM_OBJ(&extlib_vm_set_default_exception_handler__NAME), extlib_vm_set_default_exception_handler, NULL, NULL);
5422
5423 static ScmObj extlib_current_load_history(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5424 {
5425 SCM_ENTER_SUBR("current-load-history");
5426 {
5427 {
5428 ScmObj SCM_RESULT;
5429 SCM_RESULT = (Scm_VM()->load_history);
5430 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5431 }
5432 }
5433 }
5434
5435 static SCM_DEFINE_STRING_CONST(extlib_current_load_history__NAME, "current-load-history", 20, 20);
5436 static SCM_DEFINE_SUBR(extlib_current_load_history__STUB, 0, 0, SCM_OBJ(&extlib_current_load_history__NAME), extlib_current_load_history, NULL, NULL);
5437
5438 static ScmObj extlib_current_load_next(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5439 {
5440 SCM_ENTER_SUBR("current-load-next");
5441 {
5442 {
5443 ScmObj SCM_RESULT;
5444 SCM_RESULT = (Scm_VM()->load_next);
5445 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5446 }
5447 }
5448 }
5449
5450 static SCM_DEFINE_STRING_CONST(extlib_current_load_next__NAME, "current-load-next", 17, 17);
5451 static SCM_DEFINE_SUBR(extlib_current_load_next__STUB, 0, 0, SCM_OBJ(&extlib_current_load_next__NAME), extlib_current_load_next, NULL, NULL);
5452
5453 static ScmObj extlib_current_load_port(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5454 {
5455 SCM_ENTER_SUBR("current-load-port");
5456 {
5457 {
5458 ScmObj SCM_RESULT;
5459 SCM_RESULT = (Scm_VM()->load_port);
5460 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5461 }
5462 }
5463 }
5464
5465 static SCM_DEFINE_STRING_CONST(extlib_current_load_port__NAME, "current-load-port", 17, 17);
5466 static SCM_DEFINE_SUBR(extlib_current_load_port__STUB, 0, 0, SCM_OBJ(&extlib_current_load_port__NAME), extlib_current_load_port, NULL, NULL);
5467
5468 static ScmObj extlib__25vm_make_parameter_slot(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5469 {
5470 SCM_ENTER_SUBR("%vm-make-parameter-slot");
5471 {
5472 int newid, num;
5473 num = Scm_MakeParameterSlot(Scm_VM(), &newid);
5474 SCM_RETURN(Scm_Values2(SCM_MAKE_INT(num), SCM_MAKE_INT(newid)));
5475 }
5476 }
5477
5478 static SCM_DEFINE_STRING_CONST(extlib__25vm_make_parameter_slot__NAME, "%vm-make-parameter-slot", 23, 23);
5479 static SCM_DEFINE_SUBR(extlib__25vm_make_parameter_slot__STUB, 0, 0, SCM_OBJ(&extlib__25vm_make_parameter_slot__NAME), extlib__25vm_make_parameter_slot, NULL, NULL);
5480
5481 static ScmObj extlib__25vm_parameter_ref(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5482 {
5483 ScmObj index_scm;
5484 int index;
5485 ScmObj id_scm;
5486 int id;
5487 SCM_ENTER_SUBR("%vm-parameter-ref");
5488 index_scm = SCM_ARGREF(0);
5489 if (!SCM_EXACTP(index_scm)) Scm_Error("C integer required, but got %S", index_scm);
5490 index = Scm_GetInteger(index_scm);
5491 id_scm = SCM_ARGREF(1);
5492 if (!SCM_EXACTP(id_scm)) Scm_Error("C integer required, but got %S", id_scm);
5493 id = Scm_GetInteger(id_scm);
5494 {
5495 {
5496 ScmObj SCM_RESULT;
5497 SCM_RESULT = (Scm_ParameterRef(Scm_VM(), index, id));
5498 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5499 }
5500 }
5501 }
5502
5503 static SCM_DEFINE_STRING_CONST(extlib__25vm_parameter_ref__NAME, "%vm-parameter-ref", 17, 17);
5504 static SCM_DEFINE_SUBR(extlib__25vm_parameter_ref__STUB, 2, 0, SCM_OBJ(&extlib__25vm_parameter_ref__NAME), extlib__25vm_parameter_ref, NULL, NULL);
5505
5506 static ScmObj extlib__25vm_parameter_setX(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5507 {
5508 ScmObj index_scm;
5509 int index;
5510 ScmObj id_scm;
5511 int id;
5512 ScmObj value_scm;
5513 ScmObj value;
5514 SCM_ENTER_SUBR("%vm-parameter-set!");
5515 index_scm = SCM_ARGREF(0);
5516 if (!SCM_EXACTP(index_scm)) Scm_Error("C integer required, but got %S", index_scm);
5517 index = Scm_GetInteger(index_scm);
5518 id_scm = SCM_ARGREF(1);
5519 if (!SCM_EXACTP(id_scm)) Scm_Error("C integer required, but got %S", id_scm);
5520 id = Scm_GetInteger(id_scm);
5521 value_scm = SCM_ARGREF(2);
5522 value = (value_scm);
5523 {
5524 {
5525 ScmObj SCM_RESULT;
5526 SCM_RESULT = (Scm_ParameterSet(Scm_VM(), index, id, value));
5527 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5528 }
5529 }
5530 }
5531
5532 static SCM_DEFINE_STRING_CONST(extlib__25vm_parameter_setX__NAME, "%vm-parameter-set!", 18, 18);
5533 static SCM_DEFINE_SUBR(extlib__25vm_parameter_setX__STUB, 3, 0, SCM_OBJ(&extlib__25vm_parameter_setX__NAME), extlib__25vm_parameter_setX, NULL, NULL);
5534
5535 static ScmObj extlib_gauche_version(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5536 {
5537 SCM_ENTER_SUBR("gauche-version");
5538 {
5539 {
5540 ScmObj SCM_RESULT;
5541 SCM_RESULT = (SCM_MAKE_STR(GAUCHE_VERSION));
5542 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5543 }
5544 }
5545 }
5546
5547 static SCM_DEFINE_STRING_CONST(extlib_gauche_version__NAME, "gauche-version", 14, 14);
5548 static SCM_DEFINE_SUBR(extlib_gauche_version__STUB, 0, 0, SCM_OBJ(&extlib_gauche_version__NAME), extlib_gauche_version, NULL, NULL);
5549
5550 static ScmObj extlib_gauche_architecture(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5551 {
5552 SCM_ENTER_SUBR("gauche-architecture");
5553 {
5554 {
5555 ScmObj SCM_RESULT;
5556 SCM_RESULT = (SCM_MAKE_STR(GAUCHE_ARCH));
5557 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5558 }
5559 }
5560 }
5561
5562 static SCM_DEFINE_STRING_CONST(extlib_gauche_architecture__NAME, "gauche-architecture", 19, 19);
5563 static SCM_DEFINE_SUBR(extlib_gauche_architecture__STUB, 0, 0, SCM_OBJ(&extlib_gauche_architecture__NAME), extlib_gauche_architecture, NULL, NULL);
5564
5565 static ScmObj extlib_gauche_library_directory(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5566 {
5567 SCM_ENTER_SUBR("gauche-library-directory");
5568 {
5569 {
5570 ScmObj SCM_RESULT;
5571 SCM_RESULT = Scm_LibraryDirectory();
5572 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5573 }
5574 }
5575 }
5576
5577 static SCM_DEFINE_STRING_CONST(extlib_gauche_library_directory__NAME, "gauche-library-directory", 24, 24);
5578 static SCM_DEFINE_SUBR(extlib_gauche_library_directory__STUB, 0, 0, SCM_OBJ(&extlib_gauche_library_directory__NAME), extlib_gauche_library_directory, NULL, NULL);
5579
5580 static ScmObj extlib_gauche_architecture_directory(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5581 {
5582 SCM_ENTER_SUBR("gauche-architecture-directory");
5583 {
5584 {
5585 ScmObj SCM_RESULT;
5586 SCM_RESULT = Scm_ArchitectureDirectory();
5587 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5588 }
5589 }
5590 }
5591
5592 static SCM_DEFINE_STRING_CONST(extlib_gauche_architecture_directory__NAME, "gauche-architecture-directory", 29, 29);
5593 static SCM_DEFINE_SUBR(extlib_gauche_architecture_directory__STUB, 0, 0, SCM_OBJ(&extlib_gauche_architecture_directory__NAME), extlib_gauche_architecture_directory, NULL, NULL);
5594
5595 static ScmObj extlib_gauche_site_library_directory(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5596 {
5597 SCM_ENTER_SUBR("gauche-site-library-directory");
5598 {
5599 {
5600 ScmObj SCM_RESULT;
5601 SCM_RESULT = Scm_SiteLibraryDirectory();
5602 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5603 }
5604 }
5605 }
5606
5607 static SCM_DEFINE_STRING_CONST(extlib_gauche_site_library_directory__NAME, "gauche-site-library-directory", 29, 29);
5608 static SCM_DEFINE_SUBR(extlib_gauche_site_library_directory__STUB, 0, 0, SCM_OBJ(&extlib_gauche_site_library_directory__NAME), extlib_gauche_site_library_directory, NULL, NULL);
5609
5610 static ScmObj extlib_gauche_site_architecture_directory(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5611 {
5612 SCM_ENTER_SUBR("gauche-site-architecture-directory");
5613 {
5614 {
5615 ScmObj SCM_RESULT;
5616 SCM_RESULT = Scm_SiteArchitectureDirectory();
5617 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5618 }
5619 }
5620 }
5621
5622 static SCM_DEFINE_STRING_CONST(extlib_gauche_site_architecture_directory__NAME, "gauche-site-architecture-directory", 34, 34);
5623 static SCM_DEFINE_SUBR(extlib_gauche_site_architecture_directory__STUB, 0, 0, SCM_OBJ(&extlib_gauche_site_architecture_directory__NAME), extlib_gauche_site_architecture_directory, NULL, NULL);
5624
5625 static ScmObj extlib_gauche_dso_suffix(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5626 {
5627 SCM_ENTER_SUBR("gauche-dso-suffix");
5628 {
5629 {
5630 ScmObj SCM_RESULT;
5631 SCM_RESULT = (SCM_MAKE_STR(SHLIB_SO_SUFFIX));
5632 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5633 }
5634 }
5635 }
5636
5637 static SCM_DEFINE_STRING_CONST(extlib_gauche_dso_suffix__NAME, "gauche-dso-suffix", 17, 17);
5638 static SCM_DEFINE_SUBR(extlib_gauche_dso_suffix__STUB, 0, 0, SCM_OBJ(&extlib_gauche_dso_suffix__NAME), extlib_gauche_dso_suffix, NULL, NULL);
5639
5640 static ScmObj extlib_current_thread(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5641 {
5642 SCM_ENTER_SUBR("current-thread");
5643 {
5644 {
5645 ScmObj SCM_RESULT;
5646 SCM_RESULT = (SCM_OBJ(Scm_VM()));
5647 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5648 }
5649 }
5650 }
5651
5652 static SCM_DEFINE_STRING_CONST(extlib_current_thread__NAME, "current-thread", 14, 14);
5653 static SCM_DEFINE_SUBR(extlib_current_thread__STUB, 0, 0, SCM_OBJ(&extlib_current_thread__NAME), extlib_current_thread, NULL, NULL);
5654
5655 static ScmObj extlib_unwrap_syntax(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5656 {
5657 ScmObj form_scm;
5658 ScmObj form;
5659 SCM_ENTER_SUBR("unwrap-syntax");
5660 form_scm = SCM_ARGREF(0);
5661 form = (form_scm);
5662 {
5663 {
5664 ScmObj SCM_RESULT;
5665 SCM_RESULT = Scm_UnwrapSyntax(form);
5666 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5667 }
5668 }
5669 }
5670
5671 static SCM_DEFINE_STRING_CONST(extlib_unwrap_syntax__NAME, "unwrap-syntax", 13, 13);
5672 static SCM_DEFINE_SUBR(extlib_unwrap_syntax__STUB, 1, 0, SCM_OBJ(&extlib_unwrap_syntax__NAME), extlib_unwrap_syntax, NULL, NULL);
5673
5674 static ScmObj extlib_foreign_pointer_attributes(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5675 {
5676 ScmObj fp_scm;
5677 ScmForeignPointer* fp;
5678 SCM_ENTER_SUBR("foreign-pointer-attributes");
5679 fp_scm = SCM_ARGREF(0);
5680 if (!SCM_FOREIGN_POINTER_P(fp_scm)) Scm_Error("foreign pointer required, but got %S", fp_scm);
5681 fp = SCM_FOREIGN_POINTER(fp_scm);
5682 {
5683 {
5684 ScmObj SCM_RESULT;
5685 SCM_RESULT = Scm_ForeignPointerAttr(fp);
5686 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5687 }
5688 }
5689 }
5690
5691 static SCM_DEFINE_STRING_CONST(extlib_foreign_pointer_attributes__NAME, "foreign-pointer-attributes", 26, 26);
5692 static SCM_DEFINE_SUBR(extlib_foreign_pointer_attributes__STUB, 1, 0, SCM_OBJ(&extlib_foreign_pointer_attributes__NAME), extlib_foreign_pointer_attributes, NULL, NULL);
5693
5694 static ScmObj extlib_foreign_pointer_attribute_get(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5695 {
5696 ScmObj fp_scm;
5697 ScmForeignPointer* fp;
5698 ScmObj key_scm;
5699 ScmObj key;
5700 ScmObj fallback_scm;
5701 ScmObj fallback;
5702 ScmObj SCM_OPTARGS = SCM_ARGREF(SCM_ARGCNT-1);
5703 SCM_ENTER_SUBR("foreign-pointer-attribute-get");
5704 if (Scm_Length(SCM_OPTARGS) > 1)
5705 Scm_Error("too many arguments: up to 1 is expected, %d given.", Scm_Length(SCM_OPTARGS));
5706 fp_scm = SCM_ARGREF(0);
5707 if (!SCM_FOREIGN_POINTER_P(fp_scm)) Scm_Error("foreign pointer required, but got %S", fp_scm);
5708 fp = SCM_FOREIGN_POINTER(fp_scm);
5709 key_scm = SCM_ARGREF(1);
5710 key = (key_scm);
5711 if (SCM_NULLP(SCM_OPTARGS)) fallback_scm = SCM_UNBOUND;
5712 else {
5713 fallback_scm = SCM_CAR(SCM_OPTARGS);
5714 SCM_OPTARGS = SCM_CDR(SCM_OPTARGS);
5715 }
5716 fallback = (fallback_scm);
5717 {
5718 {
5719 ScmObj SCM_RESULT;
5720 SCM_RESULT = Scm_ForeignPointerAttrGet(fp, key, fallback);
5721 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5722 }
5723 }
5724 }
5725
5726 static SCM_DEFINE_STRING_CONST(extlib_foreign_pointer_attribute_get__NAME, "foreign-pointer-attribute-get", 29, 29);
5727 static SCM_DEFINE_SUBR(extlib_foreign_pointer_attribute_get__STUB, 2, 1, SCM_OBJ(&extlib_foreign_pointer_attribute_get__NAME), extlib_foreign_pointer_attribute_get, NULL, NULL);
5728
5729 static ScmObj extlib_foreign_pointer_attribute_set(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5730 {
5731 ScmObj fp_scm;
5732 ScmForeignPointer* fp;
5733 ScmObj key_scm;
5734 ScmObj key;
5735 ScmObj value_scm;
5736 ScmObj value;
5737 SCM_ENTER_SUBR("foreign-pointer-attribute-set");
5738 fp_scm = SCM_ARGREF(0);
5739 if (!SCM_FOREIGN_POINTER_P(fp_scm)) Scm_Error("foreign pointer required, but got %S", fp_scm);
5740 fp = SCM_FOREIGN_POINTER(fp_scm);
5741 key_scm = SCM_ARGREF(1);
5742 key = (key_scm);
5743 value_scm = SCM_ARGREF(2);
5744 value = (value_scm);
5745 {
5746 {
5747 ScmObj SCM_RESULT;
5748 SCM_RESULT = Scm_ForeignPointerAttrSet(fp, key, value);
5749 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5750 }
5751 }
5752 }
5753
5754 static SCM_DEFINE_STRING_CONST(extlib_foreign_pointer_attribute_set__NAME, "foreign-pointer-attribute-set", 29, 29);
5755 static SCM_DEFINE_SUBR(extlib_foreign_pointer_attribute_set__STUB, 3, 0, SCM_OBJ(&extlib_foreign_pointer_attribute_set__NAME), extlib_foreign_pointer_attribute_set, NULL, NULL);
5756
5757 static ScmObj extlib_gc(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5758 {
5759 SCM_ENTER_SUBR("gc");
5760 {
5761 GC_gcollect();
5762 SCM_RETURN(SCM_UNDEFINED);
5763 }
5764 }
5765
5766 static SCM_DEFINE_STRING_CONST(extlib_gc__NAME, "gc", 2, 2);
5767 static SCM_DEFINE_SUBR(extlib_gc__STUB, 0, 0, SCM_OBJ(&extlib_gc__NAME), extlib_gc, NULL, NULL);
5768
5769 static SCM_DEFINE_STRING_CONST(key_total_heap_size__NAME, "total-heap-size", 15, 15);
5770 static ScmObj key_total_heap_size = SCM_UNBOUND;
5771 static SCM_DEFINE_STRING_CONST(key_free_bytes__NAME, "free-bytes", 10, 10);
5772 static ScmObj key_free_bytes = SCM_UNBOUND;
5773 static SCM_DEFINE_STRING_CONST(key_bytes_since_gc__NAME, "bytes-since-gc", 14, 14);
5774 static ScmObj key_bytes_since_gc = SCM_UNBOUND;
5775 static SCM_DEFINE_STRING_CONST(key_total_bytes__NAME, "total-bytes", 11, 11);
5776 static ScmObj key_total_bytes = SCM_UNBOUND;
5777 static ScmObj extlib_gc_stat(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5778 {
5779 SCM_ENTER_SUBR("gc-stat");
5780 {
5781 ScmObj h = SCM_NIL, t = SCM_NIL;
5782 SCM_APPEND(h, t, SCM_LIST2(key_total_heap_size,
5783 Scm_MakeIntegerFromUI(GC_get_heap_size())));
5784 SCM_APPEND(h, t, SCM_LIST2(key_free_bytes,
5785 Scm_MakeIntegerFromUI(GC_get_free_bytes())));
5786 SCM_APPEND(h, t, SCM_LIST2(key_bytes_since_gc,
5787 Scm_MakeIntegerFromUI(GC_get_bytes_since_gc())));
5788 SCM_APPEND(h, t, SCM_LIST2(key_total_bytes,
5789 Scm_MakeIntegerFromUI(GC_get_total_bytes())));
5790 SCM_RETURN(h);
5791 }
5792 }
5793
5794 static SCM_DEFINE_STRING_CONST(extlib_gc_stat__NAME, "gc-stat", 7, 7);
5795 static SCM_DEFINE_SUBR(extlib_gc_stat__STUB, 0, 0, SCM_OBJ(&extlib_gc_stat__NAME), extlib_gc_stat, NULL, NULL);
5796
5797 static ScmObj extlib_profiler_start(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5798 {
5799 SCM_ENTER_SUBR("profiler-start");
5800 {
5801 Scm_ProfilerStart();
5802 SCM_RETURN(SCM_UNDEFINED);
5803 }
5804 }
5805
5806 static SCM_DEFINE_STRING_CONST(extlib_profiler_start__NAME, "profiler-start", 14, 14);
5807 static SCM_DEFINE_SUBR(extlib_profiler_start__STUB, 0, 0, SCM_OBJ(&extlib_profiler_start__NAME), extlib_profiler_start, NULL, NULL);
5808
5809 static ScmObj extlib_profiler_stop(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5810 {
5811 SCM_ENTER_SUBR("profiler-stop");
5812 {
5813 {
5814 int SCM_RESULT;
5815 SCM_RESULT = Scm_ProfilerStop();
5816 SCM_RETURN(Scm_MakeInteger(SCM_RESULT));
5817 }
5818 }
5819 }
5820
5821 static SCM_DEFINE_STRING_CONST(extlib_profiler_stop__NAME, "profiler-stop", 13, 13);
5822 static SCM_DEFINE_SUBR(extlib_profiler_stop__STUB, 0, 0, SCM_OBJ(&extlib_profiler_stop__NAME), extlib_profiler_stop, NULL, NULL);
5823
5824 static ScmObj extlib_profiler_reset(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5825 {
5826 SCM_ENTER_SUBR("profiler-reset");
5827 {
5828 Scm_ProfilerReset();
5829 SCM_RETURN(SCM_UNDEFINED);
5830 }
5831 }
5832
5833 static SCM_DEFINE_STRING_CONST(extlib_profiler_reset__NAME, "profiler-reset", 14, 14);
5834 static SCM_DEFINE_SUBR(extlib_profiler_reset__STUB, 0, 0, SCM_OBJ(&extlib_profiler_reset__NAME), extlib_profiler_reset, NULL, NULL);
5835
5836 static ScmObj extlib_subrP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5837 {
5838 ScmObj obj_scm;
5839 ScmObj obj;
5840 SCM_ENTER_SUBR("subr?");
5841 obj_scm = SCM_ARGREF(0);
5842 obj = (obj_scm);
5843 {
5844 {
5845 int SCM_RESULT;
5846 SCM_RESULT = SCM_SUBRP(obj);
5847 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
5848 }
5849 }
5850 }
5851
5852 static SCM_DEFINE_STRING_CONST(extlib_subrP__NAME, "subr?", 5, 5);
5853 static SCM_DEFINE_SUBR(extlib_subrP__STUB, 1, 0, SCM_OBJ(&extlib_subrP__NAME), extlib_subrP, NULL, NULL);
5854
5855 static ScmObj extlib_closureP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5856 {
5857 ScmObj obj_scm;
5858 ScmObj obj;
5859 SCM_ENTER_SUBR("closure?");
5860 obj_scm = SCM_ARGREF(0);
5861 obj = (obj_scm);
5862 {
5863 {
5864 int SCM_RESULT;
5865 SCM_RESULT = SCM_CLOSUREP(obj);
5866 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
5867 }
5868 }
5869 }
5870
5871 static SCM_DEFINE_STRING_CONST(extlib_closureP__NAME, "closure?", 8, 8);
5872 static SCM_DEFINE_SUBR(extlib_closureP__STUB, 1, 0, SCM_OBJ(&extlib_closureP__NAME), extlib_closureP, NULL, NULL);
5873
5874 static ScmObj extlib_toplevel_closureP(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5875 {
5876 ScmObj obj_scm;
5877 ScmObj obj;
5878 SCM_ENTER_SUBR("toplevel-closure?");
5879 obj_scm = SCM_ARGREF(0);
5880 obj = (obj_scm);
5881 {
5882 {
5883 int SCM_RESULT;
5884 SCM_RESULT = (SCM_CLOSUREP(obj) && SCM_CLOSURE(obj)->env == NULL);
5885 SCM_RETURN(SCM_MAKE_BOOL(SCM_RESULT));
5886 }
5887 }
5888 }
5889
5890 static SCM_DEFINE_STRING_CONST(extlib_toplevel_closureP__NAME, "toplevel-closure?", 17, 17);
5891 static SCM_DEFINE_SUBR(extlib_toplevel_closureP__STUB, 1, 0, SCM_OBJ(&extlib_toplevel_closureP__NAME), extlib_toplevel_closureP, NULL, NULL);
5892
5893 static ScmObj extlib_closure_code(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5894 {
5895 ScmObj clo_scm;
5896 ScmClosure* clo;
5897 SCM_ENTER_SUBR("closure-code");
5898 clo_scm = SCM_ARGREF(0);
5899 if (!SCM_CLOSUREP(clo_scm)) Scm_Error("closure required, but got %S", clo_scm);
5900 clo = SCM_CLOSURE(clo_scm);
5901 {
5902 {
5903 ScmObj SCM_RESULT;
5904 SCM_RESULT = (clo->code);
5905 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5906 }
5907 }
5908 }
5909
5910 static SCM_DEFINE_STRING_CONST(extlib_closure_code__NAME, "closure-code", 12, 12);
5911 static SCM_DEFINE_SUBR(extlib_closure_code__STUB, 1, 0, SCM_OBJ(&extlib_closure_code__NAME), extlib_closure_code, NULL, NULL);
5912
5913 static ScmObj extlib_procedure_info(ScmObj *SCM_FP, int SCM_ARGCNT, void *data_)
5914 {
5915 ScmObj proc_scm;
5916 ScmProcedure* proc;
5917 SCM_ENTER_SUBR("procedure-info");
5918 proc_scm = SCM_ARGREF(0);
5919 if (!SCM_PROCEDUREP(proc_scm)) Scm_Error("procedure required, but got %S", proc_scm);
5920 proc = SCM_PROCEDURE(proc_scm);
5921 {
5922 {
5923 ScmObj SCM_RESULT;
5924 SCM_RESULT = (SCM_PROCEDURE_INFO(proc));
5925 SCM_RETURN(SCM_OBJ_SAFE(SCM_RESULT));
5926 }
5927 }
5928 }
5929
5930 static SCM_DEFINE_STRING_CONST(extlib_procedure_info__NAME, "procedure-info", 14, 14);
5931 static SCM_DEFINE_SUBR(extlib_procedure_info__STUB, 1, 0, SCM_OBJ(&extlib_procedure_info__NAME), extlib_procedure_info, NULL, NULL);
5932
5933 void Scm_Init_extlib(ScmModule *module)
5934 {
5935
5936 SCM_DEFINE(module, "procedure-info", SCM_OBJ(&extlib_procedure_info__STUB));
5937 SCM_DEFINE(module, "closure-code", SCM_OBJ(&extlib_closure_code__STUB));
5938 SCM_DEFINE(module, "toplevel-closure?", SCM_OBJ(&extlib_toplevel_closureP__STUB));
5939 SCM_DEFINE(module, "closure?", SCM_OBJ(&extlib_closureP__STUB));
5940 SCM_DEFINE(module, "subr?", SCM_OBJ(&extlib_subrP__STUB));
5941 SCM_DEFINE(module, "profiler-reset", SCM_OBJ(&extlib_profiler_reset__STUB));
5942 SCM_DEFINE(module, "profiler-stop", SCM_OBJ(&extlib_profiler_stop__STUB));
5943 SCM_DEFINE(module, "profiler-start", SCM_OBJ(&extlib_profiler_start__STUB));
5944 SCM_DEFINE(module, "gc-stat", SCM_OBJ(&extlib_gc_stat__STUB));
5945 key_total_bytes = Scm_MakeKeyword(&key_total_bytes__NAME);
5946 key_bytes_since_gc = Scm_MakeKeyword(&key_bytes_since_gc__NAME);
5947 key_free_bytes = Scm_MakeKeyword(&key_free_bytes__NAME);
5948 key_total_heap_size = Scm_MakeKeyword(&key_total_heap_size__NAME);
5949 SCM_DEFINE(module, "gc", SCM_OBJ(&extlib_gc__STUB));
5950 SCM_DEFINE(module, "foreign-pointer-attribute-set", SCM_OBJ(&extlib_foreign_pointer_attribute_set__STUB));
5951 SCM_DEFINE(module, "foreign-pointer-attribute-get", SCM_OBJ(&extlib_foreign_pointer_attribute_get__STUB));
5952 SCM_DEFINE(module, "foreign-pointer-attributes", SCM_OBJ(&extlib_foreign_pointer_attributes__STUB));
5953 SCM_DEFINE(module, "unwrap-syntax", SCM_OBJ(&extlib_unwrap_syntax__STUB));
5954 SCM_DEFINE(module, "current-thread", SCM_OBJ(&extlib_current_thread__STUB));
5955 SCM_DEFINE(module, "gauche-dso-suffix", SCM_OBJ(&extlib_gauche_dso_suffix__STUB));
5956 SCM_DEFINE(module, "gauche-site-architecture-directory", SCM_OBJ(&extlib_gauche_site_architecture_directory__STUB));
5957 SCM_DEFINE(module, "gauche-site-library-directory", SCM_OBJ(&extlib_gauche_site_library_directory__STUB));
5958 SCM_DEFINE(module, "gauche-architecture-directory", SCM_OBJ(&extlib_gauche_architecture_directory__STUB));
5959 SCM_DEFINE(module, "gauche-library-directory", SCM_OBJ(&extlib_gauche_library_directory__STUB));
5960 SCM_DEFINE(module, "gauche-architecture", SCM_OBJ(&extlib_gauche_architecture__STUB));
5961 SCM_DEFINE(module, "gauche-version", SCM_OBJ(&extlib_gauche_version__STUB));
5962 SCM_DEFINE(module, "%vm-parameter-set!", SCM_OBJ(&extlib__25vm_parameter_setX__STUB));
5963 SCM_DEFINE(module, "%vm-parameter-ref", SCM_OBJ(&extlib__25vm_parameter_ref__STUB));
5964 SCM_DEFINE(module, "%vm-make-parameter-slot", SCM_OBJ(&extlib__25vm_make_parameter_slot__STUB));
5965 SCM_DEFINE(module, "current-load-port", SCM_OBJ(&extlib_current_load_port__STUB));
5966 SCM_DEFINE(module, "current-load-next", SCM_OBJ(&extlib_current_load_next__STUB));
5967 SCM_DEFINE(module, "current-load-history", SCM_OBJ(&extlib_current_load_history__STUB));
5968 SCM_DEFINE(module, "vm-set-default-exception-handler", SCM_OBJ(&extlib_vm_set_default_exception_handler__STUB));
5969 SCM_DEFINE(module, "vm-get-stack-trace-lite", SCM_OBJ(&extlib_vm_get_stack_trace_lite__STUB));
5970 SCM_DEFINE(module, "vm-get-stack-trace", SCM_OBJ(&extlib_vm_get_stack_trace__STUB));
5971 SCM_DEFINE(module, "vm-dump", SCM_OBJ(&extlib_vm_dump__STUB));
5972 Scm_InitBuiltinClass(&Scm_VMClass, "<thread>", Scm_VMClass__SLOTS, TRUE, module);
5973 SCM_DEFINE(module, "exit", SCM_OBJ(&extlib_exit__STUB));
5974 SCM_DEFINE(module, "%format", SCM_OBJ(&extlib__25format__STUB));
5975 SCM_DEFINE(module, "global-variable-ref", SCM_OBJ(&extlib_global_variable_ref__STUB));
5976 SCM_DEFINE(module, "global-variable-bound?", SCM_OBJ(&extlib_global_variable_boundP__STUB));
5977 SCM_DEFINE(module, "%extend-module", SCM_OBJ(&extlib__25extend_module__STUB));
5978 SCM_DEFINE(module, "%export-all", SCM_OBJ(&extlib__25export_all__STUB));
5979 SCM_DEFINE(module, "path->module-name", SCM_OBJ(&extlib_path_TOmodule_name__STUB));
5980 SCM_DEFINE(module, "module-name->path", SCM_OBJ(&extlib_module_name_TOpath__STUB));
5981 SCM_DEFINE(module, "make-module", SCM_OBJ(&extlib_make_module__STUB));
5982 SCM_DEFINE(module, "all-modules", SCM_OBJ(&extlib_all_modules__STUB));
5983 SCM_DEFINE(module, "find-module", SCM_OBJ(&extlib_find_module__STUB));
5984 SCM_DEFINE(module, "module-table", SCM_OBJ(&extlib_module_table__STUB));
5985 SCM_DEFINE(module, "module-exports", SCM_OBJ(&extlib_module_exports__STUB));
5986 SCM_DEFINE(module, "module-imports", SCM_OBJ(&extlib_module_imports__STUB));
5987 SCM_DEFINE(module, "module-precedence-list", SCM_OBJ(&extlib_module_precedence_list__STUB));
5988 SCM_DEFINE(module, "module-parents", SCM_OBJ(&extlib_module_parents__STUB));
5989 SCM_DEFINE(module, "module-name", SCM_OBJ(&extlib_module_name__STUB));
5990 SCM_DEFINE(module, "module?", SCM_OBJ(&extlib_moduleP__STUB));
5991 SCM_DEFINE(module, "hash-table-stat", SCM_OBJ(&extlib_hash_table_stat__STUB));
5992 SCM_DEFINE(module, "hash-table-values", SCM_OBJ(&extlib_hash_table_values__STUB));
5993 SCM_DEFINE(module, "hash-table-keys", SCM_OBJ(&extlib_hash_table_keys__STUB));
5994 SCM_DEFINE(module, "%hash-table-iter", SCM_OBJ(&extlib__25hash_table_iter__STUB));
5995 SCM_DEFINE(module, "hash-table-pop!", SCM_OBJ(&extlib_hash_table_popX__STUB));
5996 SCM_DEFINE(module, "hash-table-push!", SCM_OBJ(&extlib_hash_table_pushX__STUB));
5997 SCM_DEFINE(module, "hash-table-update!", SCM_OBJ(&extlib_hash_table_updateX__STUB));
5998 SCM_DEFINE(module, "hash-table-exists?", SCM_OBJ(&extlib_hash_table_existsP__STUB));
5999 SCM_DEFINE(module, "hash-table-delete!", SCM_OBJ(&extlib_hash_table_deleteX__STUB));
6000 SCM_DEFINE(module, "hash-table-put!", SCM_OBJ(&extlib_hash_table_putX__STUB));
6001 SCM_DEFINE(module, "hash-table-get", SCM_OBJ(&extlib_hash_table_get__STUB));
6002 SCM_DEFINE(module, "hash-table-num-entries", SCM_OBJ(&extlib_hash_table_num_entries__STUB));
6003 SCM_DEFINE(module, "hash-table-type", SCM_OBJ(&extlib_hash_table_type__STUB));
6004 SCM_DEFINE(module, "hash-table?", SCM_OBJ(&extlib_hash_tableP__STUB));
6005 SCM_DEFINE(module, "make-hash-table", SCM_OBJ(&extlib_make_hash_table__STUB));
6006 SCM_DEFINE(module, "hash", SCM_OBJ(&extlib_hash__STUB));
6007 SCM_DEFINE(module, "eqv-hash", SCM_OBJ(&extlib_eqv_hash__STUB));
6008 SCM_DEFINE(module, "eq-hash", SCM_OBJ(&extlib_eq_hash__STUB));
6009 SCM_DEFINE(module, "warn", SCM_OBJ(&extlib_warn__STUB));
6010 SCM_DEFINE(module, "undefined?", SCM_OBJ(&extlib_undefinedP__STUB));
6011 SCM_DEFINE(module, "undefined", SCM_OBJ(&extlib_undefined__STUB));
6012 SCM_DEFINE(module, "%autoload", SCM_OBJ(&extlib__25autoload__STUB));
6013 SCM_DEFINE(module, "provided?", SCM_OBJ(&extlib_providedP__STUB));
6014 SCM_DEFINE(module, "provide", SCM_OBJ(&extlib_provide__STUB));
6015 SCM_DEFINE(module, "%require", SCM_OBJ(&extlib__25require__STUB));
6016 KEYARG_export_symbols = Scm_MakeKeyword(&KEYARG_export_symbols__NAME);
6017 KEYARG_init_function = Scm_MakeKeyword(&KEYARG_init_function__NAME);
6018 SCM_DEFINE(module, "dynamic-load", SCM_OBJ(&extlib_dynamic_load__STUB));
6019 SCM_DEFINE(module, "%add-load-path", SCM_OBJ(&extlib__25add_load_path__STUB));
6020 SCM_DEFINE(module, "write*", SCM_OBJ(&extlib_write_2a__STUB));
6021 SCM_DEFINE(module, "write-limited", SCM_OBJ(&extlib_write_limited__STUB));
6022 SCM_DEFINE(module, "write-byte", SCM_OBJ(&extlib_write_byte__STUB));
6023 SCM_DEFINE(module, "read-reference-value", SCM_OBJ(&extlib_read_reference_value__STUB));
6024 SCM_DEFINE(module, "read-reference-has-value?", SCM_OBJ(&extlib_read_reference_has_valueP__STUB));
6025 SCM_DEFINE(module, "read-reference?", SCM_OBJ(&extlib_read_referenceP__STUB));
6026 SCM_DEFINE(module, "define-reader-ctor", SCM_OBJ(&extlib_define_reader_ctor__STUB));
6027 SCM_DEFINE(module, "read-list", SCM_OBJ(&extlib_read_list__STUB));
6028 SCM_DEFINE(module, "read-block", SCM_OBJ(&extlib_read_block__STUB));
6029 SCM_DEFINE(module, "read-line", SCM_OBJ(&extlib_read_line__STUB));
6030 SCM_DEFINE(module, "peek-byte", SCM_OBJ(&extlib_peek_byte__STUB));
6031 SCM_DEFINE(module, "read-byte", SCM_OBJ(&extlib_read_byte__STUB));
6032 SCM_DEFINE(module, "byte-ready?", SCM_OBJ(&extlib_byte_readyP__STUB));
6033 SCM_DEFINE(module, "port->byte-string", SCM_OBJ(&extlib_port_TObyte_string__STUB));
6034 SCM_DEFINE(module, "with-port-locking", SCM_OBJ(&extlib_with_port_locking__STUB));
6035 SCM_DEFINE(module, "open-output-fd-port", SCM_OBJ(&extlib_open_output_fd_port__STUB));
6036 KEYARG_name = Scm_MakeKeyword(&KEYARG_name__NAME);
6037 KEYARG_ownerP = Scm_MakeKeyword(&KEYARG_ownerP__NAME);
6038 SCM_DEFINE(module, "open-input-fd-port", SCM_OBJ(&extlib_open_input_fd_port__STUB));
6039 SCM_DEFINE(module, "port-buffering", SCM_OBJ(&extlib_port_buffering__STUB));
6040 Scm_SetterSet(SCM_PROCEDURE(&extlib_port_buffering__STUB), SCM_PROCEDURE(&extlib_port_buffering_SETTER__STUB), TRUE);
6041 SCM_DEFINE(module, "port-type", SCM_OBJ(&extlib_port_type__STUB));
6042 sym_proc = Scm_Intern(&sym_proc__NAME);
6043 sym_string = Scm_Intern(&sym_string__NAME);
6044 sym_file = Scm_Intern(&sym_file__NAME);
6045 SCM_DEFINE(module, "port-seek", SCM_OBJ(&extlib_port_seek__STUB));
6046 extlib_SEEK_END__VAR = Scm_Intern(&extlib_SEEK_END__VAR__NAME);
6047 Scm_DefineConst(module, SCM_SYMBOL(SCM_OBJ(extlib_SEEK_END__VAR)), SCM_OBJ(Scm_MakeInteger(SEEK_END)));
6048 extlib_SEEK_CUR__VAR = Scm_Intern(&extlib_SEEK_CUR__VAR__NAME);
6049 Scm_DefineConst(module, SCM_SYMBOL(SCM_OBJ(extlib_SEEK_CUR__VAR)), SCM_OBJ(Scm_MakeInteger(SEEK_CUR)));
6050 extlib_SEEK_SET__VAR = Scm_Intern(&extlib_SEEK_SET__VAR__NAME);
6051 Scm_DefineConst(module, SCM_SYMBOL(SCM_OBJ(extlib_SEEK_SET__VAR)), SCM_OBJ(Scm_MakeInteger(SEEK_SET)));
6052 SCM_DEFINE(module, "port-file-number", SCM_OBJ(&extlib_port_file_number__STUB));
6053 SCM_DEFINE(module, "port-current-line", SCM_OBJ(&extlib_port_current_line__STUB));
6054 SCM_DEFINE(module, "port-name", SCM_OBJ(&extlib_port_name__STUB));
6055 SCM_DEFINE(module, "with-error-to-port", SCM_OBJ(&extlib_with_error_to_port__STUB));
6056 SCM_DEFINE(module, "with-output-to-port", SCM_OBJ(&extlib_with_output_to_port__STUB));
6057 SCM_DEFINE(module, "with-input-from-port", SCM_OBJ(&extlib_with_input_from_port__STUB));
6058 SCM_DEFINE(module, "standard-error-port", SCM_OBJ(&extlib_standard_error_port__STUB));
6059 SCM_DEFINE(module, "standard-output-port", SCM_OBJ(&extlib_standard_output_port__STUB));
6060 SCM_DEFINE(module, "standard-input-port", SCM_OBJ(&extlib_standard_input_port__STUB));
6061 SCM_DEFINE(module, "current-error-port", SCM_OBJ(&extlib_current_error_port__STUB));
6062 SCM_DEFINE(module, "port-closed?", SCM_OBJ(&extlib_port_closedP__STUB));
6063 SCM_DEFINE(module, "flush-all-ports", SCM_OBJ(&extlib_flush_all_ports__STUB));
6064 SCM_DEFINE(module, "flush", SCM_OBJ(&extlib_flush__STUB));
6065 SCM_DEFINE(module, "open-output-buffered-port", SCM_OBJ(&extlib_open_output_buffered_port__STUB));
6066 SCM_DEFINE(module, "open-input-buffered-port", SCM_OBJ(&extlib_open_input_buffered_port__STUB));
6067 SCM_DEFINE(module, "open-coding-aware-port", SCM_OBJ(&extlib_open_coding_aware_port__STUB));
6068 SCM_DEFINE(module, "get-remaining-input-string", SCM_OBJ(&extlib_get_remaining_input_string__STUB));
6069 SCM_DEFINE(module, "get-output-string", SCM_OBJ(&extlib_get_output_string__STUB));
6070 SCM_DEFINE(module, "open-output-string", SCM_OBJ(&extlib_open_output_string__STUB));
6071 KEYARG_privateP = Scm_MakeKeyword(&KEYARG_privateP__NAME);
6072 SCM_DEFINE(module, "open-input-string", SCM_OBJ(&extlib_open_input_string__STUB));
6073 KEYARG_mode = Scm_MakeKeyword(&KEYARG_mode__NAME);
6074 KEYARG_if_exists = Scm_MakeKeyword(&KEYARG_if_exists__NAME);
6075 SCM_DEFINE(module, "%open-output-file", SCM_OBJ(&extlib__25open_output_file__STUB));
6076 KEYARG_element_type = Scm_MakeKeyword(&KEYARG_element_type__NAME);
6077 KEYARG_buffering = Scm_MakeKeyword(&KEYARG_buffering__NAME);
6078 KEYARG_if_does_not_exist = Scm_MakeKeyword(&KEYARG_if_does_not_exist__NAME);
6079 SCM_DEFINE(module, "%open-input-file", SCM_OBJ(&extlib__25open_input_file__STUB));
6080 key_binary = Scm_MakeKeyword(&key_binary__NAME);
6081 key_character = Scm_MakeKeyword(&key_character__NAME);
6082 key_overwrite = Scm_MakeKeyword(&key_overwrite__NAME);
6083 key_supersede = Scm_MakeKeyword(&key_supersede__NAME);
6084 key_append = Scm_MakeKeyword(&key_append__NAME);
6085 key_create = Scm_MakeKeyword(&key_create__NAME);
6086 key_error = Scm_MakeKeyword(&key_error__NAME);
6087 SCM_DEFINE(module, "promise-kind", SCM_OBJ(&extlib_promise_kind__STUB));
6088 Scm_SetterSet(SCM_PROCEDURE(&extlib_promise_kind__STUB), SCM_PROCEDURE(&extlib_promise_kind_SETTER__STUB), TRUE);
6089 SCM_DEFINE(module, "eager", SCM_OBJ(&extlib_eager__STUB));
6090 SCM_DEFINE(module, "promise?", SCM_OBJ(&extlib_promiseP__STUB));
6091 SCM_DEFINE(module, "identity", SCM_OBJ(&extlib_identity__STUB));
6092 SCM_DEFINE(module, "has-setter?", SCM_OBJ(&extlib_has_setterP__STUB));
6093 SCM_DEFINE(module, "setter", SCM_OBJ(&extlib_setter__STUB));
6094 Scm_SetterSet(SCM_PROCEDURE(&extlib_setter__STUB), SCM_PROCEDURE(&extlib_setter_SETTER__STUB), TRUE);
6095 SCM_DEFINE(module, "weak-vector-set!", SCM_OBJ(&extlib_weak_vector_setX__STUB));
6096 SCM_DEFINE(module, "weak-vector-ref", SCM_OBJ(&extlib_weak_vector_ref__STUB));
6097 SCM_DEFINE(module, "weak-vector-length", SCM_OBJ(&extlib_weak_vector_length__STUB));
6098 SCM_DEFINE(module, "make-weak-vector", SCM_OBJ(&extlib_make_weak_vector__STUB));
6099 SCM_DEFINE(module, "vector-copy", SCM_OBJ(&extlib_vector_copy__STUB));
6100 #if SCM_DEBUG_HELPER
6101 SCM_DEFINE(module, "%regmatch-dump", SCM_OBJ(&extlib__25regmatch_dump__STUB));
6102 #endif /* SCM_DEBUG_HELPER */
6103 #if SCM_DEBUG_HELPER
6104 SCM_DEFINE(module, "%regexp-dump", SCM_OBJ(&extlib__25regexp_dump__STUB));
6105 #endif /* SCM_DEBUG_HELPER */
6106 SCM_DEFINE(module, "rxmatch-num-matches", SCM_OBJ(&extlib_rxmatch_num_matches__STUB));
6107 SCM_DEFINE(module, "rxmatch-after", SCM_OBJ(&extlib_rxmatch_after__STUB));
6108 SCM_DEFINE(module, "rxmatch-before", SCM_OBJ(&extlib_rxmatch_before__STUB));
6109 SCM_DEFINE(module, "rxmatch-end", SCM_OBJ(&extlib_rxmatch_end__STUB));
6110 SCM_DEFINE(module, "rxmatch-start", SCM_OBJ(&extlib_rxmatch_start__STUB));
6111 SCM_DEFINE(module, "rxmatch-substring", SCM_OBJ(&extlib_rxmatch_substring__STUB));
6112 SCM_DEFINE(module, "rxmatch", SCM_OBJ(&extlib_rxmatch__STUB));
6113 SCM_DEFINE(module, "regexp-optimize", SCM_OBJ(&extlib_regexp_optimize__STUB));
6114 SCM_DEFINE(module, "regexp-compile", SCM_OBJ(&extlib_regexp_compile__STUB));
6115 SCM_DEFINE(module, "regexp-parse", SCM_OBJ(&extlib_regexp_parse__STUB));
6116 SCM_DEFINE(module, "regexp-case-fold?", SCM_OBJ(&extlib_regexp_case_foldP__STUB));
6117 SCM_DEFINE(module, "regexp->string", SCM_OBJ(&extlib_regexp_TOstring__STUB));
6118 KEYARG_case_fold = Scm_MakeKeyword(&KEYARG_case_fold__NAME);
6119 SCM_DEFINE(module, "string->regexp", SCM_OBJ(&extlib_string_TOregexp__STUB));
6120 SCM_DEFINE(module, "regmatch?", SCM_OBJ(&extlib_regmatchP__STUB));
6121 SCM_DEFINE(module, "regexp?", SCM_OBJ(&extlib_regexpP__STUB));
6122 #if SCM_DEBUG_HELPER
6123 SCM_DEFINE(module, "%string-pointer-dump", SCM_OBJ(&extlib__25string_pointer_dump__STUB));
6124 #endif /* SCM_DEBUG_HELPER */
6125 SCM_DEFINE(module, "string-pointer-byte-index", SCM_OBJ(&extlib_string_pointer_byte_index__STUB));
6126 SCM_DEFINE(module, "string-pointer-copy", SCM_OBJ(&extlib_string_pointer_copy__STUB));
6127 SCM_DEFINE(module, "string-pointer-index", SCM_OBJ(&extlib_string_pointer_index__STUB));
6128 KEYARG_after = Scm_MakeKeyword(&KEYARG_after__NAME);
6129 SCM_DEFINE(module, "string-pointer-substring", SCM_OBJ(&extlib_string_pointer_substring__STUB));
6130 SCM_DEFINE(module, "string-pointer-set!", SCM_OBJ(&extlib_string_pointer_setX__STUB));
6131 SCM_DEFINE(module, "string-pointer-prev!", SCM_OBJ(&extlib_string_pointer_prevX__STUB));
6132 SCM_DEFINE(module, "string-pointer-next!", SCM_OBJ(&extlib_string_pointer_nextX__STUB));
6133 SCM_DEFINE(module, "string-pointer-ref", SCM_OBJ(&extlib_string_pointer_ref__STUB));
6134 SCM_DEFINE(module, "string-pointer?", SCM_OBJ(&extlib_string_pointerP__STUB));
6135 SCM_DEFINE(module, "make-string-pointer", SCM_OBJ(&extlib_make_string_pointer__STUB));
6136 SCM_DEFINE(module, "string-scan", SCM_OBJ(&extlib_string_scan__STUB));
6137 sym_both = Scm_Intern(&sym_both__NAME);
6138 sym_after2 = Scm_Intern(&sym_after2__NAME);
6139 sym_before2 = Scm_Intern(&sym_before2__NAME);
6140 sym_after = Scm_Intern(&sym_after__NAME);
6141 sym_before = Scm_Intern(&sym_before__NAME);
6142 sym_index = Scm_Intern(&sym_index__NAME);
6143 SCM_DEFINE(module, "%string-split-by-char", SCM_OBJ(&extlib__25string_split_by_char__STUB));
6144 SCM_DEFINE(module, "%hash-string", SCM_OBJ(&extlib__25hash_string__STUB));
6145 SCM_DEFINE(module, "string-join", SCM_OBJ(&extlib_string_join__STUB));
6146 sym_prefix = Scm_Intern(&sym_prefix__NAME);
6147 sym_suffix = Scm_Intern(&sym_suffix__NAME);
6148 sym_strict_infix = Scm_Intern(&sym_strict_infix__NAME);
6149 sym_infix = Scm_Intern(&sym_infix__NAME);
6150 SCM_DEFINE(module, "%maybe-substring", SCM_OBJ(&extlib__25maybe_substring__STUB));
6151 SCM_DEFINE(module, "string-substitute!", SCM_OBJ(&extlib_string_substituteX__STUB));
6152 SCM_DEFINE(module, "string-byte-set!", SCM_OBJ(&extlib_string_byte_setX__STUB));
6153 SCM_DEFINE(module, "string-byte-ref", SCM_OBJ(&extlib_string_byte_ref__STUB));
6154 SCM_DEFINE(module, "make-byte-string", SCM_OBJ(&extlib_make_byte_string__STUB));
6155 SCM_DEFINE(module, "string-size", SCM_OBJ(&extlib_string_size__STUB));
6156 SCM_DEFINE(module, "string-incomplete->complete", SCM_OBJ(&extlib_string_incomplete_TOcomplete__STUB));
6157 SCM_DEFINE(module, "string-complete->incomplete", SCM_OBJ(&extlib_string_complete_TOincomplete__STUB));
6158 SCM_DEFINE(module, "string-incomplete->complete!", SCM_OBJ(&extlib_string_incomplete_TOcompleteX__STUB));
6159 SCM_DEFINE(module, "string-complete->incomplete!", SCM_OBJ(&extlib_string_complete_TOincompleteX__STUB));
6160 SCM_DEFINE(module, "string-immutable?", SCM_OBJ(&extlib_string_immutableP__STUB));
6161 SCM_DEFINE(module, "string-incomplete?", SCM_OBJ(&extlib_string_incompleteP__STUB));
6162 #if SCM_DEBUG_HELPER
6163 SCM_DEFINE(module, "%char-set-dump", SCM_OBJ(&extlib__25char_set_dump__STUB));
6164 #endif /* SCM_DEBUG_HELPER */
6165 SCM_DEFINE(module, "%char-set-predefined", SCM_OBJ(&extlib__25char_set_predefined__STUB));
6166 SCM_DEFINE(module, "%char-set-ranges", SCM_OBJ(&extlib__25char_set_ranges__STUB));
6167 SCM_DEFINE(module, "%char-set-complement!", SCM_OBJ(&extlib__25char_set_complementX__STUB));
6168 SCM_DEFINE(module, "char-set-contains?", SCM_OBJ(&extlib_char_set_containsP__STUB));
6169 SCM_DEFINE(module, "%char-set-add!", SCM_OBJ(&extlib__25char_set_addX__STUB));
6170 SCM_DEFINE(module, "%char-set-add-range!", SCM_OBJ(&extlib__25char_set_add_rangeX__STUB));
6171 SCM_DEFINE(module, "%char-set-add-chars!", SCM_OBJ(&extlib__25char_set_add_charsX__STUB));
6172 SCM_DEFINE(module, "char-set-copy", SCM_OBJ(&extlib_char_set_copy__STUB));
6173 SCM_DEFINE(module, "char-set", SCM_OBJ(&extlib_char_set__STUB));
6174 SCM_DEFINE(module, "%char-set<=?", SCM_OBJ(&extlib__25char_set_LT_3dP__STUB));
6175 SCM_DEFINE(module, "%char-set-equal?", SCM_OBJ(&extlib__25char_set_equalP__STUB));
6176 SCM_DEFINE(module, "char-set?", SCM_OBJ(&extlib_char_setP__STUB));
6177 extlib__2achar_code_max_2a__VAR = Scm_Intern(&extlib__2achar_code_max_2a__VAR__NAME);
6178 Scm_DefineConst(module, SCM_SYMBOL(SCM_OBJ(extlib__2achar_code_max_2a__VAR)), SCM_OBJ(Scm_MakeInteger(SCM_CHAR_MAX)));
6179 SCM_DEFINE(module, "supported-character-encoding?", SCM_OBJ(&extlib_supported_character_encodingP__STUB));
6180 SCM_DEFINE(module, "supported-character-encodings", SCM_OBJ(&extlib_supported_character_encodings__STUB));
6181 SCM_DEFINE(module, "gauche-character-encoding", SCM_OBJ(&extlib_gauche_character_encoding__STUB));
6182 SCM_DEFINE(module, "char->ucs", SCM_OBJ(&extlib_char_TOucs__STUB));
6183 SCM_DEFINE(module, "ucs->char", SCM_OBJ(&extlib_ucs_TOchar__STUB));
6184 SCM_DEFINE(module, "integer->digit", SCM_OBJ(&extlib_integer_TOdigit__STUB));
6185 SCM_DEFINE(module, "digit->integer", SCM_OBJ(&extlib_digit_TOinteger__STUB));
6186 SCM_DEFINE(module, "identifier->symbol", SCM_OBJ(&extlib_identifier_TOsymbol__STUB));
6187 SCM_DEFINE(module, "identifier?", SCM_OBJ(&extlib_identifierP__STUB));
6188 SCM_DEFINE(module, "keyword->string", SCM_OBJ(&extlib_keyword_TOstring__STUB));
6189 SCM_DEFINE(module, "delete-keyword!", SCM_OBJ(&extlib_delete_keywordX__STUB));
6190 SCM_DEFINE(module, "delete-keyword", SCM_OBJ(&extlib_delete_keyword__STUB));
6191 SCM_DEFINE(module, "get-keyword", SCM_OBJ(&extlib_get_keyword__STUB));
6192 SCM_DEFINE(module, "make-keyword", SCM_OBJ(&extlib_make_keyword__STUB));
6193 SCM_DEFINE(module, "keyword?", SCM_OBJ(&extlib_keywordP__STUB));
6194 SCM_DEFINE(module, "gensym", SCM_OBJ(&extlib_gensym__STUB));
6195 SCM_DEFINE(module, "monotonic-merge", SCM_OBJ(&extlib_monotonic_merge__STUB));
6196 SCM_DEFINE(module, "%sort!", SCM_OBJ(&extlib__25sortX__STUB));
6197 SCM_DEFINE(module, "%sort", SCM_OBJ(&extlib__25sort__STUB));
6198 SCM_DEFINE(module, "reverse!", SCM_OBJ(&extlib_reverseX__STUB));
6199 SCM_DEFINE(module, "append!", SCM_OBJ(&extlib_appendX__STUB));
6200 SCM_DEFINE(module, "%alist-delete!", SCM_OBJ(&extlib__25alist_deleteX__STUB));
6201 SCM_DEFINE(module, "%alist-delete", SCM_OBJ(&extlib__25alist_delete__STUB));
6202 SCM_DEFINE(module, "%delete-duplicates!", SCM_OBJ(&extlib__25delete_duplicatesX__STUB));
6203 SCM_DEFINE(module, "%delete-duplicates", SCM_OBJ(&extlib__25delete_duplicates__STUB));
6204 SCM_DEFINE(module, "%delete!", SCM_OBJ(&extlib__25deleteX__STUB));
6205 SCM_DEFINE(module, "%delete", SCM_OBJ(&extlib__25delete__STUB));
6206 SCM_DEFINE(module, "list*", SCM_OBJ(&extlib_list_2a__STUB));
6207 SCM_DEFINE(module, "list-copy", SCM_OBJ(&extlib_list_copy__STUB));
6208 SCM_DEFINE(module, "last-pair", SCM_OBJ(&extlib_last_pair__STUB));
6209 SCM_DEFINE(module, "acons", SCM_OBJ(&extlib_acons__STUB));
6210 SCM_DEFINE(module, "make-list", SCM_OBJ(&extlib_make_list__STUB));
6211 SCM_DEFINE(module, "circular-list?", SCM_OBJ(&extlib_circular_listP__STUB));
6212 SCM_DEFINE(module, "dotted-list?", SCM_OBJ(&extlib_dotted_listP__STUB));
6213 SCM_DEFINE(module, "proper-list?", SCM_OBJ(&extlib_proper_listP__STUB));
6214 SCM_DEFINE(module, "quotient&remainder", SCM_OBJ(&extlib_quotient_26remainder__STUB));
6215 SCM_DEFINE(module, "min&max", SCM_OBJ(&extlib_min_26max__STUB));
6216 #if SCM_DEBUG_HELPER
6217 SCM_DEFINE(module, "%bignum-dump", SCM_OBJ(&extlib__25bignum_dump__STUB));
6218 #endif /* SCM_DEBUG_HELPER */
6219 SCM_DEFINE(module, "decode-float", SCM_OBJ(&extlib_decode_float__STUB));
6220 SCM_DEFINE(module, "clamp", SCM_OBJ(&extlib_clamp__STUB));
6221 SCM_DEFINE(module, "flonum?", SCM_OBJ(&extlib_flonumP__STUB));
6222 SCM_DEFINE(module, "bignum?", SCM_OBJ(&extlib_bignumP__STUB));
6223 SCM_DEFINE(module, "fixnum?", SCM_OBJ(&extlib_fixnumP__STUB));
6224 SCM_DEFINE(module, "logxor", SCM_OBJ(&extlib_logxor__STUB));
6225 SCM_DEFINE(module, "logior", SCM_OBJ(&extlib_logior__STUB));
6226 SCM_DEFINE(module, "logand", SCM_OBJ(&extlib_logand__STUB));
6227 SCM_DEFINE(module, "lognot", SCM_OBJ(&extlib_lognot__STUB));
6228 SCM_DEFINE(module, "ash", SCM_OBJ(&extlib_ash__STUB));
6229 SCM_DEFINE(module, "compare", SCM_OBJ(&extlib_compare__STUB));
6230 sym_string_eq = Scm_Intern(&sym_string_eq__NAME);
6231 sym_equal = Scm_Intern(&sym_equal__NAME);
6232 sym_eqv = Scm_Intern(&sym_eqv__NAME);
6233 sym_eq = Scm_Intern(&sym_eq__NAME);
6234 SCM_DEFINE(module, "macroexpand-1", SCM_OBJ(&extlib_macroexpand_1__STUB));
6235 SCM_DEFINE(module, "macroexpand", SCM_OBJ(&extlib_macroexpand__STUB));
6236 }