Beispiel #1
0
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);
}
Beispiel #2
0
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_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_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);
}