void scheme_init_char (Scheme_Env *env)
{
Scheme_Object *p;
REGISTER_SO(scheme_char_p_proc);
p = scheme_make_folding_prim(char_p, "char?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_char_p_proc = p;
scheme_add_global_constant("char?", p, env);
REGISTER_SO(scheme_interned_char_p_proc);
p = scheme_make_folding_prim(interned_char_p, "interned-char?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_interned_char_p_proc = p;
scheme_add_global_constant("interned-char?", p, env);
p = scheme_make_folding_prim(char_eq, "char=?", 2, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("char=?", p, env);
GLOBAL_FOLDING_PRIM("char<?", char_lt, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char>?", char_gt, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char<=?", char_lt_eq, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char>=?", char_gt_eq, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci=?", char_eq_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci<?", char_lt_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci>?", char_gt_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci<=?", char_lt_eq_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci>=?", char_gt_eq_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-alphabetic?", char_alphabetic, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-numeric?", char_numeric, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-symbolic?", char_symbolic, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-graphic?", char_graphic, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-whitespace?", char_whitespace, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-blank?", char_blank, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-iso-control?", char_control, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-punctuation?", char_punctuation, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-upper-case?", char_upper_case, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-lower-case?", char_lower_case, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-title-case?", char_title_case, 1, 1, 1, env);
p = scheme_make_folding_prim(scheme_checked_char_to_integer, "char->integer", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
scheme_add_global_constant("char->integer", p, env);
p = scheme_make_folding_prim(scheme_checked_integer_to_char, "integer->char", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
scheme_add_global_constant("integer->char", p, env);
GLOBAL_FOLDING_PRIM("char-upcase", char_upcase, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-downcase", char_downcase, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-titlecase", char_titlecase, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-foldcase", char_foldcase, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-general-category", char_general_category, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-utf-8-length", char_utf8_length, 1, 1, 1, env);
GLOBAL_IMMED_PRIM("make-known-char-range-list", char_map_list, 0, 0, env);
}
void scheme_init_numarith(Scheme_Env *env)
{
Scheme_Object *p;
p = scheme_make_folding_prim(scheme_add1, "add1", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
scheme_add_global_constant("add1", p, env);
p = scheme_make_folding_prim(scheme_sub1, "sub1", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
scheme_add_global_constant("sub1", p, env);
p = scheme_make_folding_prim(plus, "+", 0, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("+", p, env);
p = scheme_make_folding_prim(minus, "-", 1, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("-", p, env);
p = scheme_make_folding_prim(mult, "*", 0, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("*", p, env);
p = scheme_make_folding_prim(div_prim, "/", 1, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("/", p, env);
p = scheme_make_folding_prim(scheme_abs, "abs", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED);
scheme_add_global_constant("abs", p, env);
p = scheme_make_folding_prim(quotient, "quotient", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("quotient", p, env);
p = scheme_make_folding_prim(rem_prim, "remainder", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("remainder", p, env);
scheme_add_global_constant("quotient/remainder",
scheme_make_prim_w_arity2(quotient_remainder,
"quotient/remainder",
2, 2,
2, 2),
env);
p = scheme_make_folding_prim(scheme_modulo, "modulo", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("modulo", p, env);
}
void scheme_init_numcomp(Scheme_Env *env)
{
Scheme_Object *p;
p = scheme_make_folding_prim(eq, "=", 2, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("=", p, env);
p = scheme_make_folding_prim(lt, "<", 2, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("<", p, env);
p = scheme_make_folding_prim(gt, ">", 2, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant(">", p, env);
p = scheme_make_folding_prim(lt_eq, "<=", 2, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("<=", p, env);
p = scheme_make_folding_prim(gt_eq, ">=", 2, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant(">=", p, env);
p = scheme_make_folding_prim(zero_p, "zero?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("zero?", p, env);
p = scheme_make_folding_prim(positive_p, "positive?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("positive?", p, env);
p = scheme_make_folding_prim(negative_p, "negative?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("negative?", p, env);
p = scheme_make_folding_prim(sch_max, "max", 1, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("max", p, env);
p = scheme_make_folding_prim(sch_min, "min", 1, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("min", p, env);
}
void scheme_init_bool (Scheme_Env *env)
{
Scheme_Object *p;
REGISTER_SO(scheme_not_prim);
REGISTER_SO(scheme_eq_prim);
REGISTER_SO(scheme_eqv_prim);
REGISTER_SO(scheme_equal_prim);
p = scheme_make_folding_prim(not_prim, "not", 1, 1, 1);
scheme_not_prim = p;
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("not", p, env);
p = scheme_make_folding_prim(boolean_p_prim, "boolean?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("boolean?", p, env);
p = scheme_make_folding_prim(eq_prim, "eq?", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_eq_prim = p;
scheme_add_global_constant("eq?", p, env);
p = scheme_make_folding_prim(eqv_prim, "eqv?", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_eqv_prim = p;
scheme_add_global_constant("eqv?", scheme_eqv_prim, env);
p = scheme_make_prim_w_arity(equal_prim, "equal?", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_equal_prim = p;
scheme_add_global_constant("equal?", scheme_equal_prim, env);
scheme_add_global_constant("equal?/recur",
scheme_make_prim_w_arity(equalish_prim, "equal?/recur", 3, 3),
env);
p = scheme_make_immed_prim(chaperone_p, "chaperone?", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("chaperone?", p, env);
p = scheme_make_immed_prim(impersonator_p, "impersonator?", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("impersonator?", p, env);
scheme_add_global_constant("chaperone-of?",
scheme_make_prim_w_arity(chaperone_of, "chaperone-of?", 2, 2),
env);
scheme_add_global_constant("impersonator-of?",
scheme_make_prim_w_arity(impersonator_of, "impersonator-of?", 2, 2),
env);
}
void scheme_init_char (Scheme_Env *env)
{
Scheme_Object *p;
int i;
REGISTER_SO(scheme_char_constants);
REGISTER_SO(general_category_symbols);
scheme_char_constants =
(Scheme_Object **)scheme_malloc_eternal(256 * sizeof(Scheme_Object*));
for (i = 0; i < 256; i++) {
Scheme_Object *sc;
sc = scheme_alloc_eternal_small_object();
sc->type = scheme_char_type;
SCHEME_CHAR_VAL(sc) = i;
scheme_char_constants[i] = sc;
}
p = scheme_make_folding_prim(char_p, "char?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("char?", p, env);
p = scheme_make_folding_prim(char_eq, "char=?", 2, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_add_global_constant("char=?", p, env);
scheme_add_global_constant("char<?",
scheme_make_folding_prim(char_lt,
"char<?",
2, -1, 1),
env);
scheme_add_global_constant("char>?",
scheme_make_folding_prim(char_gt,
"char>?",
2, -1, 1),
env);
scheme_add_global_constant("char<=?",
scheme_make_folding_prim(char_lt_eq,
"char<=?",
2, -1, 1),
env);
scheme_add_global_constant("char>=?",
scheme_make_folding_prim(char_gt_eq,
"char>=?",
2, -1, 1),
env);
scheme_add_global_constant("char-ci=?",
scheme_make_folding_prim(char_eq_ci,
"char-ci=?",
2, -1, 1),
env);
scheme_add_global_constant("char-ci<?",
scheme_make_folding_prim(char_lt_ci,
"char-ci<?",
2, -1, 1),
env);
scheme_add_global_constant("char-ci>?",
scheme_make_folding_prim(char_gt_ci,
"char-ci>?",
2, -1, 1),
env);
scheme_add_global_constant("char-ci<=?",
scheme_make_folding_prim(char_lt_eq_ci,
"char-ci<=?",
2, -1, 1),
env);
scheme_add_global_constant("char-ci>=?",
scheme_make_folding_prim(char_gt_eq_ci,
"char-ci>=?",
2, -1, 1),
env);
scheme_add_global_constant("char-alphabetic?",
scheme_make_folding_prim(char_alphabetic,
"char-alphabetic?",
1, 1, 1),
env);
scheme_add_global_constant("char-numeric?",
scheme_make_folding_prim(char_numeric,
"char-numeric?",
1, 1, 1),
env);
scheme_add_global_constant("char-symbolic?",
scheme_make_folding_prim(char_symbolic,
"char-symbolic?",
1, 1, 1),
env);
scheme_add_global_constant("char-graphic?",
scheme_make_folding_prim(char_graphic,
"char-graphic?",
1, 1, 1),
env);
scheme_add_global_constant("char-whitespace?",
scheme_make_folding_prim(char_whitespace,
"char-whitespace?",
1, 1, 1),
env);
scheme_add_global_constant("char-blank?",
scheme_make_folding_prim(char_blank,
"char-blank?",
1, 1, 1),
env);
scheme_add_global_constant("char-iso-control?",
scheme_make_folding_prim(char_control,
"char-iso-control?",
1, 1, 1),
env);
scheme_add_global_constant("char-punctuation?",
scheme_make_folding_prim(char_punctuation,
"char-punctuation?",
1, 1, 1),
env);
scheme_add_global_constant("char-upper-case?",
scheme_make_folding_prim(char_upper_case,
"char-upper-case?",
1, 1, 1),
env);
scheme_add_global_constant("char-title-case?",
scheme_make_folding_prim(char_title_case,
"char-title-case?",
1, 1, 1),
env);
scheme_add_global_constant("char-lower-case?",
scheme_make_folding_prim(char_lower_case,
"char-lower-case?",
1, 1, 1),
env);
scheme_add_global_constant("char-title-case?",
scheme_make_folding_prim(char_title_case,
"char-title-case?",
1, 1, 1),
env);
scheme_add_global_constant("char->integer",
scheme_make_folding_prim(char_to_integer,
"char->integer",
1, 1, 1),
env);
scheme_add_global_constant("integer->char",
scheme_make_folding_prim(integer_to_char,
"integer->char",
1, 1, 1),
env);
scheme_add_global_constant("char-upcase",
scheme_make_folding_prim(char_upcase,
"char-upcase",
1, 1, 1),
env);
scheme_add_global_constant("char-downcase",
scheme_make_folding_prim(char_downcase,
"char-downcase",
1, 1, 1),
env);
scheme_add_global_constant("char-titlecase",
scheme_make_folding_prim(char_titlecase,
"char-titlecase",
1, 1, 1),
env);
scheme_add_global_constant("char-foldcase",
scheme_make_folding_prim(char_foldcase,
"char-foldcase",
1, 1, 1),
env);
scheme_add_global_constant("char-general-category",
scheme_make_folding_prim(char_general_category,
"char-general-category",
1, 1, 1),
env);
scheme_add_global_constant("char-utf-8-length",
scheme_make_folding_prim(char_utf8_length,
"char-utf-8-length",
1, 1, 1),
env);
scheme_add_global_constant("make-known-char-range-list",
scheme_make_noncm_prim(char_map_list,
"make-known-char-range-list",
0, 0),
env);
}
void scheme_init_unsafe_numcomp(Scheme_Env *env)
{
Scheme_Object *p;
p = scheme_make_folding_prim(unsafe_fx_eq, "unsafe-fx=", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-fx=", p, env);
p = scheme_make_folding_prim(unsafe_fx_lt, "unsafe-fx<", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-fx<", p, env);
p = scheme_make_folding_prim(unsafe_fx_gt, "unsafe-fx>", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-fx>", p, env);
p = scheme_make_folding_prim(unsafe_fx_lt_eq, "unsafe-fx<=", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-fx<=", p, env);
p = scheme_make_folding_prim(unsafe_fx_gt_eq, "unsafe-fx>=", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-fx>=", p, env);
p = scheme_make_folding_prim(unsafe_fx_min, "unsafe-fxmin", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-fxmin", p, env);
p = scheme_make_folding_prim(unsafe_fx_max, "unsafe-fxmax", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-fxmax", p, env);
p = scheme_make_folding_prim(unsafe_fl_eq, "unsafe-fl=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl=", p, env);
p = scheme_make_folding_prim(unsafe_fl_lt, "unsafe-fl<", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl<", p, env);
p = scheme_make_folding_prim(unsafe_fl_gt, "unsafe-fl>", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl>", p, env);
p = scheme_make_folding_prim(unsafe_fl_lt_eq, "unsafe-fl<=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl<=", p, env);
p = scheme_make_folding_prim(unsafe_fl_gt_eq, "unsafe-fl>=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-fl>=", p, env);
p = scheme_make_folding_prim(unsafe_fl_min, "unsafe-flmin", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-flmin", p, env);
p = scheme_make_folding_prim(unsafe_fl_max, "unsafe-flmax", 2, 2, 1);
if (scheme_can_inline_fp_op())
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
else
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL;
scheme_add_global_constant("unsafe-flmax", p, env);
}
void scheme_init_unsafe_numarith(Scheme_Env *env)
{
Scheme_Object *p;
int flags;
p = scheme_make_folding_prim(unsafe_fx_plus, "unsafe-fx+", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fx+", p, env);
p = scheme_make_folding_prim(unsafe_fx_minus, "unsafe-fx-", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fx-", p, env);
p = scheme_make_folding_prim(unsafe_fx_mult, "unsafe-fx*", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fx*", p, env);
p = scheme_make_folding_prim(unsafe_fx_div, "unsafe-fxquotient", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxquotient", p, env);
p = scheme_make_folding_prim(unsafe_fx_rem, "unsafe-fxremainder", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxremainder", p, env);
p = scheme_make_folding_prim(unsafe_fx_mod, "unsafe-fxmodulo", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxmodulo", p, env);
p = scheme_make_folding_prim(unsafe_fx_abs, "unsafe-fxabs", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-fxabs", p, env);
p = scheme_make_folding_prim(unsafe_fl_plus, "unsafe-fl+", 2, 2, 1);
if (scheme_can_inline_fp_op())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl+", p, env);
p = scheme_make_folding_prim(unsafe_fl_minus, "unsafe-fl-", 2, 2, 1);
if (scheme_can_inline_fp_op())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl-", p, env);
p = scheme_make_folding_prim(unsafe_fl_mult, "unsafe-fl*", 2, 2, 1);
if (scheme_can_inline_fp_op())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl*", p, env);
p = scheme_make_folding_prim(unsafe_fl_div, "unsafe-fl/", 2, 2, 1);
if (scheme_can_inline_fp_op())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("unsafe-fl/", p, env);
p = scheme_make_folding_prim(unsafe_fl_abs, "unsafe-flabs", 1, 1, 1);
if (scheme_can_inline_fp_op())
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_FIRST);
scheme_add_global_constant("unsafe-flabs", p, env);
p = scheme_make_folding_prim(unsafe_fl_sqrt, "unsafe-flsqrt", 1, 1, 1);
if (scheme_can_inline_fp_op() && SQRT_MACHINE_CODE_AVAILABLE)
flags = SCHEME_PRIM_IS_UNARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_FIRST);
scheme_add_global_constant("unsafe-flsqrt", p, env);
}
void
scheme_init_vector (Scheme_Env *env)
{
Scheme_Object *p;
REGISTER_SO(scheme_vector_p_proc);
p = scheme_make_folding_prim(vector_p, "vector?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("vector?", p, env);
scheme_vector_p_proc = p;
REGISTER_SO(scheme_make_vector_proc);
p = scheme_make_immed_prim(scheme_checked_make_vector, "make-vector", 1, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("make-vector", p, env);
scheme_make_vector_proc = p;
REGISTER_SO(scheme_vector_proc);
p = scheme_make_immed_prim(vector, "vector", 0, -1);
scheme_vector_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED
| SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
scheme_add_global_constant("vector", p, env);
REGISTER_SO(scheme_vector_immutable_proc);
p = scheme_make_immed_prim(vector_immutable, "vector-immutable", 0, -1);
scheme_vector_immutable_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_NARY_INLINED
| SCHEME_PRIM_IS_OMITABLE_ALLOCATION);
scheme_add_global_constant("vector-immutable", p, env);
p = scheme_make_folding_prim(vector_length, "vector-length", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("vector-length", p, env);
REGISTER_SO(scheme_vector_ref_proc);
p = scheme_make_noncm_prim(scheme_checked_vector_ref,
"vector-ref",
2, 2);
scheme_vector_ref_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("vector-ref", p, env);
REGISTER_SO(scheme_vector_set_proc);
p = scheme_make_noncm_prim(scheme_checked_vector_set,
"vector-set!",
3, 3);
scheme_vector_set_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("vector-set!", p, env);
scheme_add_global_constant("vector->list",
scheme_make_immed_prim(vector_to_list,
"vector->list",
1, 1),
env);
REGISTER_SO(scheme_list_to_vector_proc);
p = scheme_make_immed_prim(list_to_vector,
"list->vector",
1, 1);
scheme_list_to_vector_proc = p;
scheme_add_global_constant("list->vector", p, env);
scheme_add_global_constant("vector-fill!",
scheme_make_immed_prim(vector_fill,
"vector-fill!",
2, 2),
env);
scheme_add_global_constant("vector-copy!",
scheme_make_immed_prim(vector_copy_bang,
"vector-copy!",
3, 5),
env);
scheme_add_global_constant("vector->immutable-vector",
scheme_make_immed_prim(vector_to_immutable,
"vector->immutable-vector",
1, 1),
env);
scheme_add_global_constant("vector->values",
scheme_make_prim_w_arity2(vector_to_values,
"vector->values",
1, 3,
0, -1),
env);
scheme_add_global_constant("chaperone-vector",
scheme_make_prim_w_arity(chaperone_vector,
"chaperone-vector",
3, -1),
env);
scheme_add_global_constant("impersonate-vector",
scheme_make_prim_w_arity(impersonate_vector,
"impersonate-vector",
3, -1),
env);
}
void
scheme_init_unsafe_vector (Scheme_Env *env)
{
Scheme_Object *p;
REGISTER_SO(scheme_unsafe_vector_length_proc);
p = scheme_make_immed_prim(unsafe_vector_len, "unsafe-vector-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-vector-length", p, env);
scheme_unsafe_vector_length_proc = p;
p = scheme_make_immed_prim(unsafe_vector_star_len, "unsafe-vector*-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-vector*-length", p, env);
p = scheme_make_immed_prim(unsafe_vector_ref, "unsafe-vector-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("unsafe-vector-ref", p, env);
p = scheme_make_immed_prim(unsafe_vector_star_ref, "unsafe-vector*-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("unsafe-vector*-ref", p, env);
p = scheme_make_immed_prim(unsafe_vector_set, "unsafe-vector-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("unsafe-vector-set!", p, env);
p = scheme_make_immed_prim(unsafe_vector_star_set, "unsafe-vector*-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("unsafe-vector*-set!", p, env);
REGISTER_SO(scheme_unsafe_struct_ref_proc);
p = scheme_make_immed_prim(unsafe_struct_ref, "unsafe-struct-ref", 2, 2);
scheme_unsafe_struct_ref_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("unsafe-struct-ref", p, env);
p = scheme_make_immed_prim(unsafe_struct_star_ref, "unsafe-struct*-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("unsafe-struct*-ref", p, env);
p = scheme_make_immed_prim(unsafe_struct_set, "unsafe-struct-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("unsafe-struct-set!", p, env);
p = scheme_make_immed_prim(unsafe_struct_star_set, "unsafe-struct*-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("unsafe-struct*-set!", p, env);
REGISTER_SO(scheme_unsafe_string_length_proc);
p = scheme_make_immed_prim(unsafe_string_len, "unsafe-string-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-string-length", p, env);
scheme_unsafe_string_length_proc = p;
p = scheme_make_immed_prim(unsafe_string_ref, "unsafe-string-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("unsafe-string-ref", p, env);
p = scheme_make_immed_prim(unsafe_string_set, "unsafe-string-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("unsafe-string-set!", p, env);
REGISTER_SO(scheme_unsafe_byte_string_length_proc);
p = scheme_make_immed_prim(unsafe_bytes_len, "unsafe-bytes-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-bytes-length", p, env);
scheme_unsafe_byte_string_length_proc = p;
p = scheme_make_immed_prim(unsafe_bytes_ref, "unsafe-bytes-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("unsafe-bytes-ref", p, env);
p = scheme_make_immed_prim(unsafe_bytes_set, "unsafe-bytes-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_add_global_constant("unsafe-bytes-set!", p, env);
}
void scheme_init_extfl_unsafe_numcomp(Scheme_Env *env)
{
Scheme_Object *p;
int flags;
p = scheme_make_folding_prim(unsafe_extfl_eq, "unsafe-extfl=", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
scheme_add_global_constant("unsafe-extfl=", p, env);
p = scheme_make_folding_prim(unsafe_extfl_lt, "unsafe-extfl<", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
scheme_add_global_constant("unsafe-extfl<", p, env);
p = scheme_make_folding_prim(unsafe_extfl_gt, "unsafe-extfl>", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
scheme_add_global_constant("unsafe-extfl>", p, env);
p = scheme_make_folding_prim(unsafe_extfl_lt_eq, "unsafe-extfl<=", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
scheme_add_global_constant("unsafe-extfl<=", p, env);
p = scheme_make_folding_prim(unsafe_extfl_gt_eq, "unsafe-extfl>=", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_comp()))
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
scheme_add_global_constant("unsafe-extfl>=", p, env);
p = scheme_make_folding_prim(unsafe_extfl_min, "unsafe-extflmin", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_op()))
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_EXTFLONUM
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
scheme_add_global_constant("unsafe-extflmin", p, env);
p = scheme_make_folding_prim(unsafe_extfl_max, "unsafe-extflmax", 2, 2, 1);
if (MZ_LONG_DOUBLE_AND(scheme_can_inline_fp_op()))
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_EXTFLONUM
| SCHEME_PRIM_WANTS_EXTFLONUM_BOTH);
scheme_add_global_constant("unsafe-extflmax", p, env);
}
void scheme_init_flfxnum_numcomp(Scheme_Env *env)
{
Scheme_Object *p;
int flags;
p = scheme_make_folding_prim(fx_eq, "fx=", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("fx=", p, env);
p = scheme_make_folding_prim(fx_lt, "fx<", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("fx<", p, env);
p = scheme_make_folding_prim(fx_gt, "fx>", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("fx>", p, env);
p = scheme_make_folding_prim(fx_lt_eq, "fx<=", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("fx<=", p, env);
p = scheme_make_folding_prim(fx_gt_eq, "fx>=", 2, 2, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("fx>=", p, env);
p = scheme_make_folding_prim(fx_min, "fxmin", 2, 2, 1);
if (scheme_can_inline_fp_comp())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxmin", p, env);
p = scheme_make_folding_prim(fx_max, "fxmax", 2, 2, 1);
if (scheme_can_inline_fp_comp())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_add_global_constant("fxmax", p, env);
p = scheme_make_folding_prim(fl_eq, "fl=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl=", p, env);
p = scheme_make_folding_prim(fl_lt, "fl<", 2, 2, 1);
if (scheme_can_inline_fp_comp())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl<", p, env);
p = scheme_make_folding_prim(fl_gt, "fl>", 2, 2, 1);
if (scheme_can_inline_fp_comp())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl>", p, env);
p = scheme_make_folding_prim(fl_lt_eq, "fl<=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl<=", p, env);
p = scheme_make_folding_prim(fl_gt_eq, "fl>=", 2, 2, 1);
if (scheme_can_inline_fp_comp())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("fl>=", p, env);
p = scheme_make_folding_prim(fl_min, "flmin", 2, 2, 1);
if (scheme_can_inline_fp_op())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("flmin", p, env);
p = scheme_make_folding_prim(fl_max, "flmax", 2, 2, 1);
if (scheme_can_inline_fp_op())
flags = SCHEME_PRIM_IS_BINARY_INLINED;
else
flags = SCHEME_PRIM_SOMETIMES_INLINED;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(flags
| SCHEME_PRIM_PRODUCES_FLONUM
| SCHEME_PRIM_WANTS_FLONUM_BOTH);
scheme_add_global_constant("flmax", p, env);
}
void scheme_init_char (Scheme_Env *env)
{
Scheme_Object *p;
int i;
REGISTER_SO(scheme_char_constants);
REGISTER_SO(general_category_symbols);
scheme_char_constants =
(Scheme_Object **)scheme_malloc_eternal(256 * sizeof(Scheme_Object*));
for (i = 0; i < 256; i++) {
Scheme_Object *sc;
sc = scheme_alloc_eternal_small_object();
sc->type = scheme_char_type;
SCHEME_CHAR_VAL(sc) = i;
scheme_char_constants[i] = sc;
}
for (i = 0; i < NUM_GENERAL_CATEGORIES; i++) {
Scheme_Object *s;
s = scheme_intern_symbol(general_category_names[i]);
general_category_symbols[i] = s;
}
p = scheme_make_folding_prim(char_p, "char?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_OMITABLE);
scheme_add_global_constant("char?", p, env);
p = scheme_make_folding_prim(char_eq, "char=?", 2, -1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED);
scheme_add_global_constant("char=?", p, env);
GLOBAL_FOLDING_PRIM("char<?", char_lt, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char>?", char_gt, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char<=?", char_lt_eq, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char>=?", char_gt_eq, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci=?", char_eq_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci<?", char_lt_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci>?", char_gt_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci<=?", char_lt_eq_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-ci>=?", char_gt_eq_ci, 2, -1, 1, env);
GLOBAL_FOLDING_PRIM("char-alphabetic?", char_alphabetic, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-numeric?", char_numeric, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-symbolic?", char_symbolic, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-graphic?", char_graphic, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-whitespace?", char_whitespace, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-blank?", char_blank, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-iso-control?", char_control, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-punctuation?", char_punctuation, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-upper-case?", char_upper_case, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-title-case?", char_title_case, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-lower-case?", char_lower_case, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-title-case?", char_title_case, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char->integer", char_to_integer, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("integer->char", integer_to_char, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-upcase", char_upcase, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-downcase", char_downcase, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-titlecase", char_titlecase, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-foldcase", char_foldcase, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-general-category", char_general_category, 1, 1, 1, env);
GLOBAL_FOLDING_PRIM("char-utf-8-length", char_utf8_length, 1, 1, 1, env);
GLOBAL_IMMED_PRIM("make-known-char-range-list", char_map_list, 0, 0, env);
}
void
scheme_init_unsafe_vector (Scheme_Env *env)
{
Scheme_Object *p;
p = scheme_make_immed_prim(unsafe_vector_len, "unsafe-vector-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-vector-length", p, env);
p = scheme_make_immed_prim(unsafe_vector_len, "unsafe-vector*-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-vector*-length", p, env);
p = scheme_make_immed_prim(unsafe_vector_ref, "unsafe-vector-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-vector-ref", p, env);
p = scheme_make_immed_prim(unsafe_vector_ref, "unsafe-vector*-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-vector*-ref", p, env);
p = scheme_make_immed_prim(unsafe_vector_set, "unsafe-vector-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-vector-set!", p, env);
p = scheme_make_immed_prim(unsafe_vector_set, "unsafe-vector*-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-vector*-set!", p, env);
p = scheme_make_immed_prim(unsafe_struct_ref, "unsafe-struct-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-struct-ref", p, env);
p = scheme_make_immed_prim(unsafe_struct_ref, "unsafe-struct*-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-struct*-ref", p, env);
p = scheme_make_immed_prim(unsafe_struct_set, "unsafe-struct-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-struct-set!", p, env);
p = scheme_make_immed_prim(unsafe_struct_set, "unsafe-struct*-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-struct*-set!", p, env);
p = scheme_make_immed_prim(unsafe_string_len, "unsafe-string-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-string-length", p, env);
p = scheme_make_immed_prim(unsafe_string_ref, "unsafe-string-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-string-ref", p, env);
p = scheme_make_immed_prim(unsafe_string_set, "unsafe-string-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-string-set!", p, env);
p = scheme_make_immed_prim(unsafe_bytes_len, "unsafe-bytes-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-bytes-length", p, env);
p = scheme_make_immed_prim(unsafe_bytes_ref, "unsafe-bytes-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= (SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL);
scheme_add_global_constant("unsafe-bytes-ref", p, env);
p = scheme_make_immed_prim(unsafe_bytes_set, "unsafe-bytes-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_NARY_INLINED;
scheme_add_global_constant("unsafe-bytes-set!", p, env);
}
void
scheme_init_unsafe_vector (Scheme_Startup_Env *env)
{
Scheme_Object *p;
REGISTER_SO(scheme_unsafe_vector_length_proc);
p = scheme_make_immed_prim(unsafe_vector_len, "unsafe-vector-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_addto_prim_instance("unsafe-vector-length", p, env);
scheme_unsafe_vector_length_proc = p;
REGISTER_SO(scheme_unsafe_vector_star_length_proc);
p = scheme_make_immed_prim(unsafe_vector_star_len, "unsafe-vector*-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_addto_prim_instance("unsafe-vector*-length", p, env);
scheme_unsafe_vector_star_length_proc = p;
p = scheme_make_immed_prim(unsafe_vector_ref, "unsafe-vector-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_addto_prim_instance("unsafe-vector-ref", p, env);
REGISTER_SO(scheme_unsafe_vector_star_ref_proc);
p = scheme_make_immed_prim(unsafe_vector_star_ref, "unsafe-vector*-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_addto_prim_instance("unsafe-vector*-ref", p, env);
scheme_unsafe_vector_star_ref_proc = p;
p = scheme_make_immed_prim(unsafe_vector_set, "unsafe-vector-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_addto_prim_instance("unsafe-vector-set!", p, env);
REGISTER_SO(scheme_unsafe_vector_star_set_proc);
p = scheme_make_immed_prim(unsafe_vector_star_set, "unsafe-vector*-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_addto_prim_instance("unsafe-vector*-set!", p, env);
scheme_unsafe_vector_star_set_proc = p;
p = scheme_make_immed_prim(unsafe_vector_star_cas, "unsafe-vector*-cas!", 4, 4);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_addto_prim_instance("unsafe-vector*-cas!", p, env);
REGISTER_SO(scheme_unsafe_struct_ref_proc);
p = scheme_make_immed_prim(unsafe_struct_ref, "unsafe-struct-ref", 2, 2);
scheme_unsafe_struct_ref_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_addto_prim_instance("unsafe-struct-ref", p, env);
REGISTER_SO(scheme_unsafe_struct_ref_proc);
p = scheme_make_immed_prim(unsafe_struct_star_ref, "unsafe-struct*-ref", 2, 2);
scheme_unsafe_struct_star_ref_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_addto_prim_instance("unsafe-struct*-ref", p, env);
REGISTER_SO(scheme_unsafe_struct_set_proc);
p = scheme_make_immed_prim(unsafe_struct_set, "unsafe-struct-set!", 3, 3);
scheme_unsafe_struct_set_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_addto_prim_instance("unsafe-struct-set!", p, env);
REGISTER_SO(scheme_unsafe_struct_star_set_proc);
p = scheme_make_immed_prim(unsafe_struct_star_set, "unsafe-struct*-set!", 3, 3);
scheme_unsafe_struct_star_set_proc = p;
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_addto_prim_instance("unsafe-struct*-set!", p, env);
p = scheme_make_immed_prim(unsafe_struct_star_cas, "unsafe-struct*-cas!", 4, 4);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_addto_prim_instance("unsafe-struct*-cas!", p, env);
REGISTER_SO(scheme_unsafe_string_length_proc);
p = scheme_make_immed_prim(unsafe_string_len, "unsafe-string-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_addto_prim_instance("unsafe-string-length", p, env);
scheme_unsafe_string_length_proc = p;
REGISTER_SO(scheme_unsafe_string_ref_proc);
p = scheme_make_immed_prim(unsafe_string_ref, "unsafe-string-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE);
scheme_addto_prim_instance("unsafe-string-ref", p, env);
scheme_unsafe_string_ref_proc = p;
REGISTER_SO(scheme_unsafe_string_set_proc);
p = scheme_make_immed_prim(unsafe_string_set, "unsafe-string-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_addto_prim_instance("unsafe-string-set!", p, env);
scheme_unsafe_string_set_proc = p;
REGISTER_SO(scheme_unsafe_byte_string_length_proc);
p = scheme_make_immed_prim(unsafe_bytes_len, "unsafe-bytes-length", 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_UNARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_FUNCTIONAL
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_addto_prim_instance("unsafe-bytes-length", p, env);
scheme_unsafe_byte_string_length_proc = p;
REGISTER_SO(scheme_unsafe_bytes_ref_proc);
p = scheme_make_immed_prim(unsafe_bytes_ref, "unsafe-bytes-ref", 2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_BINARY_INLINED
| SCHEME_PRIM_IS_UNSAFE_OMITABLE
| SCHEME_PRIM_IS_OMITABLE
| SCHEME_PRIM_PRODUCES_FIXNUM);
scheme_addto_prim_instance("unsafe-bytes-ref", p, env);
scheme_unsafe_bytes_ref_proc = p;
REGISTER_SO(scheme_unsafe_bytes_set_proc);
p = scheme_make_immed_prim(unsafe_bytes_set, "unsafe-bytes-set!", 3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= scheme_intern_prim_opt_flags(SCHEME_PRIM_IS_NARY_INLINED);
scheme_addto_prim_instance("unsafe-bytes-set!", p, env);
scheme_unsafe_bytes_set_proc = p;
scheme_addto_prim_instance("unsafe-impersonate-vector",
scheme_make_prim_w_arity(unsafe_impersonate_vector,
"unsafe-impersonate-vector",
2, -1),
env);
scheme_addto_prim_instance("unsafe-chaperone-vector",
scheme_make_prim_w_arity(unsafe_chaperone_vector,
"unsafe-chaperone-vector",
2, -1),
env);
}
void
scheme_init_vector (Scheme_Env *env)
{
Scheme_Object *p;
REGISTER_SO(zero_length_vector);
zero_length_vector = (Scheme_Object *)scheme_malloc_tagged(sizeof(Scheme_Vector)
- sizeof(Scheme_Object *));
zero_length_vector->type = scheme_vector_type;
SCHEME_VEC_SIZE(zero_length_vector) = 0;
p = scheme_make_folding_prim(vector_p, "vector?", 1, 1, 1);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_UNARY_INLINED;
scheme_add_global_constant("vector?", p, env);
scheme_add_global_constant("make-vector",
scheme_make_noncm_prim(make_vector,
"make-vector",
1, 2),
env);
scheme_add_global_constant("vector",
scheme_make_noncm_prim(vector,
"vector",
0, -1),
env);
scheme_add_global_constant("vector-immutable",
scheme_make_noncm_prim(vector_immutable,
"vector-immutable",
0, -1),
env);
scheme_add_global_constant("vector-length",
scheme_make_folding_prim(vector_length,
"vector-length",
1, 1, 1),
env);
p = scheme_make_noncm_prim(scheme_checked_vector_ref,
"vector-ref",
2, 2);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_BINARY_INLINED;
scheme_add_global_constant("vector-ref", p, env);
p = scheme_make_noncm_prim(scheme_checked_vector_set,
"vector-set!",
3, 3);
SCHEME_PRIM_PROC_FLAGS(p) |= SCHEME_PRIM_IS_MIN_NARY_INLINED;
scheme_add_global_constant("vector-set!", p, env);
scheme_add_global_constant("vector->list",
scheme_make_noncm_prim(vector_to_list,
"vector->list",
1, 1),
env);
scheme_add_global_constant("list->vector",
scheme_make_noncm_prim(list_to_vector,
"list->vector",
1, 1),
env);
scheme_add_global_constant("vector-fill!",
scheme_make_noncm_prim(vector_fill,
"vector-fill!",
2, 2),
env);
scheme_add_global_constant("vector->immutable-vector",
scheme_make_noncm_prim(vector_to_immutable,
"vector->immutable-vector",
1, 1),
env);
scheme_add_global_constant("vector->values",
scheme_make_prim_w_arity2(vector_to_values,
"vector->values",
1, 3,
0, -1),
env);
}
