Ejemplo n.º 1
0
static void sexp_print_simple (sexp ctx, sexp x, sexp out, int depth) {
  int i;
  if ((!sexp_pointerp(x)) || sexp_symbolp(x) || sexp_stringp(x)
      || sexp_flonump(x) || sexp_bignump(x)) {
    sexp_write(ctx, x, out);
  } else if (depth <= 0) {
    goto print_name;
  } else if (sexp_synclop(x)) {
    sexp_write_string(ctx, "#<sc ", out);
    sexp_print_simple(ctx, sexp_synclo_expr(x), out, depth);
    sexp_write_string(ctx, ">", out);
  } else if (sexp_pairp(x)) {
    sexp_write_char(ctx, '(', out);
    sexp_print_simple(ctx, sexp_car(x), out, depth-1);
    sexp_write_string(ctx, " . ", out);
    sexp_print_simple(ctx, sexp_cdr(x), out, depth-1);
    sexp_write_char(ctx, ')', out);
  } else if (sexp_vectorp(x)) {
    sexp_write_string(ctx, "#(", out);
    for (i=0; i<SEXP_HEAP_VECTOR_DEPTH && i<(int)sexp_vector_length(x); i++) {
      if (i>0)
        sexp_write_char(ctx, ' ', out);
      sexp_print_simple(ctx, sexp_vector_ref(x, i), out, depth-1);
    }
    if (i<(int)sexp_vector_length(x))
      sexp_write_string(ctx, " ...", out);
    sexp_write_char(ctx, ')', out);
  } else {
  print_name:
    sexp_write_string(ctx, "#<", out);
    sexp_write(ctx, sexp_object_type_name(ctx, x), out);
    sexp_write_string(ctx, ">", out);
  }
}
Ejemplo n.º 2
0
static sexp sexp_get_env_cell (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp id) {
  sexp cell;
  sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env);
  cell = sexp_env_cell(env, id, 0);
  while ((! cell) && sexp_synclop(id)) {
    env = sexp_synclo_env(id);
    id = sexp_synclo_expr(id);
  }
  return cell ? cell : SEXP_FALSE;
}
Ejemplo n.º 3
0
static sexp sexp_get_env_cell (sexp ctx, sexp self, sexp_sint_t n, sexp env, sexp id, sexp createp) {
  sexp cell;
  sexp_assert_type(ctx, sexp_envp, SEXP_ENV, env);
  cell = sexp_env_cell(ctx, env, id, 0);
  if (! cell) {
    if (sexp_synclop(id)) {
      env = sexp_synclo_env(id);
      id = sexp_synclo_expr(id);
    }
    cell = sexp_env_cell(ctx, env, id, 0);
    if (!cell && createp)
      cell = sexp_env_cell_define(ctx, env, id, SEXP_UNDEF, NULL);
  }
  return cell ? cell : SEXP_FALSE;
}