Example #1
0
XFORM_NONGCING static int is_eqv(Scheme_Object *obj1, Scheme_Object *obj2)
{
  Scheme_Type t1, t2;

  if (SAME_OBJ(obj1, obj2))
    return 1;

  t1 = SCHEME_TYPE(obj1);
  t2 = SCHEME_TYPE(obj2);

  if (NOT_SAME_TYPE(t1, t2)) {
#ifdef EQUATE_FLOATS_OF_DIFFERENT_PRECISIONS
    /* If one is a float and the other is a double, coerce to double */
    if ((t1 == scheme_float_type) && (t2 == scheme_double_type))
      return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_DBL_VAL(obj2));
    else if ((t2 == scheme_float_type) && (t1 == scheme_double_type))
      return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_FLT_VAL(obj2));
#endif
    return -1;
  } else {
    switch (t1) {
#ifdef MZ_LONG_DOUBLE
    case scheme_long_double_type:
      return mz_long_double_eqv(SCHEME_LONG_DBL_VAL(obj1), SCHEME_LONG_DBL_VAL(obj2));
#endif
#ifdef MZ_USE_SINGLE_FLOATS
    case scheme_float_type:
      return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_FLT_VAL(obj2));
#endif
    case scheme_double_type:
      return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_DBL_VAL(obj2));
    case scheme_bignum_type:
      return scheme_bignum_eq(obj1, obj2);
    case scheme_rational_type:
      return scheme_rational_eq(obj1, obj2);
    case scheme_complex_type:
      {
        Scheme_Complex *c1 = (Scheme_Complex *)obj1;
        Scheme_Complex *c2 = (Scheme_Complex *)obj2;
        return scheme_eqv(c1->r, c2->r) && scheme_eqv(c1->i, c2->i);
      }
    case scheme_char_type:
      return SCHEME_CHAR_VAL(obj1) == SCHEME_CHAR_VAL(obj2);
    case scheme_symbol_type:
    case scheme_keyword_type:
    case scheme_scope_type:
      /* `eqv?` requires `eq?` */
      return 0;
    default:
      return -1;
    }
  }
}
Example #2
0
File: char.c Project: 97jaz/racket
void scheme_init_char_constants(void)
{
  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;
  }
}
Example #3
0
XFORM_NONGCING static int is_eqv(Scheme_Object *obj1, Scheme_Object *obj2)
{
  Scheme_Type t1, t2;

  if (SAME_OBJ(obj1, obj2))
    return 1;

  t1 = SCHEME_TYPE(obj1);
  t2 = SCHEME_TYPE(obj2);

  if (NOT_SAME_TYPE(t1, t2)) {
#ifdef EQUATE_FLOATS_OF_DIFFERENT_PRECISIONS
    /* If one is a float and the other is a double, coerce to double */
    if ((t1 == scheme_float_type) && (t2 == scheme_double_type))
      return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_DBL_VAL(obj2));
    else if ((t2 == scheme_float_type) && (t1 == scheme_double_type))
      return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_FLT_VAL(obj2));
#endif
    return -1;
#ifdef MZ_LONG_DOUBLE
  } else if (t1 == scheme_long_double_type) {
    return long_double_eqv(SCHEME_LONG_DBL_VAL(obj1), SCHEME_LONG_DBL_VAL(obj2));
#endif
#ifdef MZ_USE_SINGLE_FLOATS
  } else if (t1 == scheme_float_type) {
    return double_eqv(SCHEME_FLT_VAL(obj1), SCHEME_FLT_VAL(obj2));
#endif
  } else if (t1 == scheme_double_type) {
    return double_eqv(SCHEME_DBL_VAL(obj1), SCHEME_DBL_VAL(obj2));
  } else if (t1 == scheme_bignum_type)
    return scheme_bignum_eq(obj1, obj2);
  else if (t1 == scheme_rational_type)
    return scheme_rational_eq(obj1, obj2);
  else if (t1 == scheme_complex_type) {
    Scheme_Complex *c1 = (Scheme_Complex *)obj1;
    Scheme_Complex *c2 = (Scheme_Complex *)obj2;
    return scheme_eqv(c1->r, c2->r) && scheme_eqv(c1->i, c2->i);
  } else if (t1 == scheme_char_type)
    return SCHEME_CHAR_VAL(obj1) == SCHEME_CHAR_VAL(obj2);
  else
    return -1;
}
Example #4
0
static Scheme_Object *
char_to_integer (int argc, Scheme_Object *argv[])
{
  mzchar c;

  if (!SCHEME_CHARP(argv[0]))
    scheme_wrong_type("char->integer", "character", 0, argc, argv);

  c = SCHEME_CHAR_VAL(argv[0]);

  return scheme_make_integer_value(c);
}
Example #5
0
File: char.c Project: 97jaz/racket
Scheme_Object *
scheme_checked_char_to_integer (int argc, Scheme_Object *argv[])
{
  mzchar c;

  if (!SCHEME_CHARP(argv[0]))
    scheme_wrong_contract("char->integer", "char?", 0, argc, argv);

  c = SCHEME_CHAR_VAL(argv[0]);

  return scheme_make_integer_value(c);
}
Example #6
0
static Scheme_Object *char_general_category (int argc, Scheme_Object *argv[])
{
  mzchar c;
  int cat;

  if (!SCHEME_CHARP(argv[0]))
    scheme_wrong_type("char-general-category", "character", 0, argc, argv);

  c = SCHEME_CHAR_VAL(argv[0]);
  cat = scheme_general_category(c);

  return general_category_symbols[cat];
}
Example #7
0
Scheme_Object *scheme_make_char(mzchar ch)
{
  Scheme_Object *o;

  if (ch < 256)
    return scheme_char_constants[ch];
  
  o = scheme_malloc_small_atomic_tagged(sizeof(Scheme_Small_Object));
  CLEAR_KEY_FIELD(o);
  o->type = scheme_char_type;
  SCHEME_CHAR_VAL(o) = ch;

  return o;
}
Example #8
0
static Scheme_Object *char_utf8_length (int argc, Scheme_Object *argv[])
{
  mzchar wc;
  if (!SCHEME_CHARP(argv[0]))
    scheme_wrong_type("char-utf-8-length", "character", 0, argc, argv);

  wc = SCHEME_CHAR_VAL(argv[0]);
  if (wc < 0x80) {
    return scheme_make_integer(1);
  } else if (wc < 0x800) {
    return scheme_make_integer(2);
  } else if (wc < 0x10000) {
    return scheme_make_integer(3);
  } else if (wc < 0x200000) {
    return scheme_make_integer(4);
  } else if (wc < 0x4000000) {
    return scheme_make_integer(5);
  } else {
    return scheme_make_integer(6);
  }
}
Example #9
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;
  }

  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);
}
Example #10
0
static Scheme_Object *unsafe_string_set (int argc, Scheme_Object *argv[])
{
    SCHEME_CHAR_STR_VAL(argv[0])[SCHEME_INT_VAL(argv[1])] = SCHEME_CHAR_VAL(argv[2]);
    return scheme_void;
}
Example #11
0
Scheme_Object *scheme_places_deep_copy_worker(Scheme_Object *so, Scheme_Hash_Table *ht)
{
  Scheme_Object *new_so = so;
  if (SCHEME_INTP(so)) {
    return so;
  }
  if (ht) {
    Scheme_Object *r; 
    if ((r = scheme_hash_get(ht, so))) {
      return r;
    }
  }

  switch (so->type) {
    case scheme_true_type:
    case scheme_false_type:
    case scheme_null_type:
    case scheme_void_type:
    /* place_bi_channels are allocated in the master and can be passed along as is */
    case scheme_place_bi_channel_type:
      new_so = so;
      break;
    case scheme_place_type:
      new_so = ((Scheme_Place *) so)->channel;
      break;
    case scheme_char_type:
      new_so = scheme_make_char(SCHEME_CHAR_VAL(so));
      break;
    case scheme_rational_type:
      {
        Scheme_Object *n;
        Scheme_Object *d;
        n = scheme_rational_numerator(so);
        d = scheme_rational_denominator(so);
        n = scheme_places_deep_copy_worker(n, ht);
        d = scheme_places_deep_copy_worker(d, ht);
        new_so = scheme_make_rational(n, d);
      }
      break;
    case scheme_float_type:
      new_so = scheme_make_float(SCHEME_FLT_VAL(so));
      break;
    case scheme_double_type:
      new_so = scheme_make_double(SCHEME_DBL_VAL(so));
      break;
    case scheme_complex_type:
      {
        Scheme_Object *r;
        Scheme_Object *i;
        r = scheme_complex_real_part(so);
        i = scheme_complex_imaginary_part(so);
        r = scheme_places_deep_copy_worker(r, ht);
        i = scheme_places_deep_copy_worker(i, ht);
        new_so = scheme_make_complex(r, i);
      }
      break;
    case scheme_char_string_type:
      new_so = scheme_make_sized_offset_char_string(SCHEME_CHAR_STR_VAL(so), 0, SCHEME_CHAR_STRLEN_VAL(so), 1);
      break;
    case scheme_byte_string_type:
      if (SHARED_ALLOCATEDP(so)) {
        new_so = so;
      }
      else {
        new_so = scheme_make_sized_offset_byte_string(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
      }
      break;
    case scheme_unix_path_type:
      new_so = scheme_make_sized_offset_path(SCHEME_BYTE_STR_VAL(so), 0, SCHEME_BYTE_STRLEN_VAL(so), 1);
      break;
    case scheme_symbol_type:
      if (SCHEME_SYM_UNINTERNEDP(so)) {
        scheme_log_abort("cannot copy uninterned symbol");
        abort();
      } else {
        new_so = scheme_make_sized_offset_byte_string(SCHEME_SYM_VAL(so), 0, SCHEME_SYM_LEN(so), 1);
        new_so->type = scheme_serialized_symbol_type;
      }
      break;
    case scheme_serialized_symbol_type:
        new_so = scheme_intern_exact_symbol(SCHEME_BYTE_STR_VAL(so), SCHEME_BYTE_STRLEN_VAL(so));
      break;
    case scheme_pair_type:
      {
        Scheme_Object *car;
        Scheme_Object *cdr;
        Scheme_Object *pair;
        car = scheme_places_deep_copy_worker(SCHEME_CAR(so), ht);
        cdr = scheme_places_deep_copy_worker(SCHEME_CDR(so), ht);
        pair = scheme_make_pair(car, cdr);
        new_so = pair;
      }
      break;
    case scheme_vector_type:
      {
        Scheme_Object *vec;
        intptr_t i;
        intptr_t size = SCHEME_VEC_SIZE(so);
        vec = scheme_make_vector(size, 0);
        for (i = 0; i <size ; i++) {
          Scheme_Object *tmp;
          tmp = scheme_places_deep_copy_worker(SCHEME_VEC_ELS(so)[i], ht);
          SCHEME_VEC_ELS(vec)[i] = tmp;
        }
        SCHEME_SET_IMMUTABLE(vec);
        new_so = vec;
      }
      break;
    case scheme_fxvector_type:
      if (SHARED_ALLOCATEDP(so)) {
        new_so = so;
      }
      else {
        Scheme_Vector *vec;
        intptr_t i;
        intptr_t size = SCHEME_FXVEC_SIZE(so);
        vec = scheme_alloc_fxvector(size);

        for (i = 0; i < size; i++) {
          SCHEME_FXVEC_ELS(vec)[i] = SCHEME_FXVEC_ELS(so)[i];
        }
        new_so = (Scheme_Object *) vec;
      }
      break;
    case scheme_flvector_type:
      if (SHARED_ALLOCATEDP(so)) {
        new_so = so;
      }
      else {
        Scheme_Double_Vector *vec;
        intptr_t i;
        intptr_t size = SCHEME_FLVEC_SIZE(so);
        vec = scheme_alloc_flvector(size);

        for (i = 0; i < size; i++) {
          SCHEME_FLVEC_ELS(vec)[i] = SCHEME_FLVEC_ELS(so)[i];
        }
        new_so = (Scheme_Object *) vec;
      }
      break;
    case scheme_structure_type:
      {
        Scheme_Structure *st = (Scheme_Structure*)so;
        Scheme_Serialized_Structure *nst;
        Scheme_Struct_Type *stype = st->stype;
        Scheme_Struct_Type *ptype = stype->parent_types[stype->name_pos - 1];
        Scheme_Object *nprefab_key;
        intptr_t size = stype->num_slots;
        int local_slots = stype->num_slots - (ptype ? ptype->num_slots : 0);
        int i = 0;

        if (!stype->prefab_key) {
          scheme_log_abort("cannot copy non prefab structure");
          abort();
        }
        {
          for (i = 0; i < local_slots; i++) {
            if (!stype->immutables || stype->immutables[i] != 1) {
              scheme_log_abort("cannot copy mutable prefab structure");
              abort();
            }
          }
        }
        nprefab_key = scheme_places_deep_copy_worker(stype->prefab_key, ht);
        nst = (Scheme_Serialized_Structure*) scheme_make_serialized_struct_instance(nprefab_key, size);
        for (i = 0; i <size ; i++) {
          Scheme_Object *tmp;
          tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
          nst->slots[i] = tmp;
        }
        new_so = (Scheme_Object*) nst;
      }
      break;

    case scheme_serialized_structure_type:
      {
        Scheme_Serialized_Structure *st = (Scheme_Serialized_Structure*)so;
        Scheme_Struct_Type *stype;
        Scheme_Structure *nst;
        intptr_t size;
        int i = 0;
      
        size = st->num_slots;
        stype = scheme_lookup_prefab_type(SCHEME_CDR(st->prefab_key), size);
        nst = (Scheme_Structure*) scheme_make_blank_prefab_struct_instance(stype);
        for (i = 0; i <size ; i++) {
          Scheme_Object *tmp;
          tmp = scheme_places_deep_copy_worker((Scheme_Object*) st->slots[i], ht);
          nst->slots[i] = tmp;
        }
        new_so = (Scheme_Object*)nst;
      }
      break;

    case scheme_resolved_module_path_type:
    default:
      printf("places deep copy cannot copy object of type %hi at %p\n", so->type, so);
      scheme_log_abort("places deep copy cannot copy object");
      abort();
      break;
  }
  if (ht) {
    scheme_hash_set(ht, so, new_so);
  }
  return new_so;
}
Example #12
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_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);
}
Example #13
0
File: char.c Project: 97jaz/racket
static Scheme_Object *
interned_char_p (int argc, Scheme_Object *argv[])
{
  return (SCHEME_CHARP(argv[0]) && SCHEME_CHAR_VAL(argv[0]) < 256) ? scheme_true : scheme_false;
}