<commit_before>/**
 * See Copyright Notice in picrin.h
 */

#include "picrin.h"
#include "picrin/port.h"
#include "picrin/pair.h"
#include "picrin/blob.h"
#include "picrin/macro.h"

static void write(pic_state *, pic_value);

static void
write_pair(pic_state *pic, struct pic_pair *pair)
{
  write(pic, pair->car);

  if (pic_nil_p(pair->cdr)) {
    return;
  }
  if (pic_pair_p(pair->cdr)) {
    printf(" ");
    write_pair(pic, pic_pair_ptr(pair->cdr));
    return;
  }
  printf(" . ");
  write(pic, pair->cdr);
}

static void
write_str(pic_state *pic, struct pic_string *str)
{
  size_t i;
  const char *cstr = str->str;

  UNUSED(pic);

  for (i = 0; i < str->len; ++i) {
    if (cstr[i] == '"' || cstr[i] == '\\') {
      putchar('\\');
    }
    putchar(cstr[i]);
  }
}

static void
write(pic_state *pic, pic_value obj)
{
  size_t i;

  switch (pic_type(obj)) {
  case PIC_TT_NIL:
    printf("()");
    break;
  case PIC_TT_BOOL:
    if (pic_true_p(obj))
      printf("#t");
    else
      printf("#f");
    break;
  case PIC_TT_PAIR:
    printf("(");
    write_pair(pic, pic_pair_ptr(obj));
    printf(")");
    break;
  case PIC_TT_SYMBOL:
    printf("%s", pic_symbol_name(pic, pic_sym(obj)));
    break;
  case PIC_TT_CHAR:
    switch (pic_char(obj)) {
    default: printf("#\\%c", pic_char(obj)); break;
    case '\a': printf("#\\alarm"); break;
    case '\b': printf("#\\backspace"); break;
    case 0x7f: printf("#\\delete"); break;
    case 0x1b: printf("#\\escape"); break;
    case '\n': printf("#\\newline"); break;
    case '\r': printf("#\\return"); break;
    case ' ': printf("#\\space"); break;
    case '\t': printf("#\\tab"); break;
    }
    break;
  case PIC_TT_FLOAT:
    printf("%f", pic_float(obj));
    break;
  case PIC_TT_INT:
    printf("%d", pic_int(obj));
    break;
  case PIC_TT_EOF:
    printf("#<eof-object>");
    break;
  case PIC_TT_UNDEF:
    printf("#<undef>");
    break;
  case PIC_TT_PROC:
    printf("#<proc %p>", pic_ptr(obj));
    break;
  case PIC_TT_PORT:
    printf("#<port %p>", pic_ptr(obj));
    break;
  case PIC_TT_STRING:
    printf("\"");
    write_str(pic, pic_str_ptr(obj));
    printf("\"");
    break;
  case PIC_TT_VECTOR:
    printf("#(");
    for (i = 0; i < pic_vec_ptr(obj)->len; ++i) {
      write(pic, pic_vec_ptr(obj)->data[i]);
      if (i + 1 < pic_vec_ptr(obj)->len) {
	printf(" ");
      }
    }
    printf(")");
    break;
  case PIC_TT_BLOB:
    printf("#u8(");
    for (i = 0; i < pic_blob_ptr(obj)->len; ++i) {
      printf("%d", pic_blob_ptr(obj)->data[i]);
      if (i + 1 < pic_blob_ptr(obj)->len) {
	printf(" ");
      }
    }
    printf(")");
    break;
  case PIC_TT_ERROR:
    printf("#<error %p>", pic_ptr(obj));
    break;
  case PIC_TT_ENV:
    printf("#<env %p>", pic_ptr(obj));
    break;
  case PIC_TT_CONT:
    printf("#<cont %p>", pic_ptr(obj));
    break;
  case PIC_TT_SENV:
    printf("#<senv %p>", pic_ptr(obj));
    break;
  case PIC_TT_SYNTAX:
    printf("#<syntax %p>", pic_ptr(obj));
    break;
  case PIC_TT_SC:
    printf("#<sc %p: ", pic_ptr(obj));
    write(pic, pic_sc(obj)->expr);
    printf(">");
    break;
  case PIC_TT_LIB:
    printf("#<lib %p>", pic_ptr(obj));
    break;
  case PIC_TT_VAR:
    printf("#<var %p>", pic_ptr(obj));
    break;
  case PIC_TT_IREP:
    printf("#<irep %p>", pic_ptr(obj));
    break;
  }
}

void
pic_debug(pic_state *pic, pic_value obj)
{
  write(pic, obj);
  fflush(stdout);
}

static pic_value
pic_port_write_simple(pic_state *pic)
{
  pic_value v;

  pic_get_args(pic, "o", &v);
  write(pic, v);
  return pic_none_value();
}

void
pic_init_write(pic_state *pic)
{
  pic_deflibrary ("(scheme write)") {
    pic_defun(pic, "write-simple", pic_port_write_simple);
  }
}<commit_msg>write-simple support optional output port<commit_after>/**
 * See Copyright Notice in picrin.h
 */

#include "picrin.h"
#include "picrin/port.h"
#include "picrin/pair.h"
#include "picrin/blob.h"
#include "picrin/macro.h"

static void write(pic_state *, pic_value, XFILE *file);

static void
write_pair(pic_state *pic, struct pic_pair *pair, XFILE *file)
{
  write(pic, pair->car, file);

  if (pic_nil_p(pair->cdr)) {
    return;
  }
  if (pic_pair_p(pair->cdr)) {
    xfprintf(file, " ");
    write_pair(pic, pic_pair_ptr(pair->cdr), file);
    return;
  }
  xfprintf(file, " . ");
  write(pic, pair->cdr, file);
}

static void
write_str(pic_state *pic, struct pic_string *str, XFILE *file)
{
  size_t i;
  const char *cstr = str->str;

  UNUSED(pic);

  for (i = 0; i < str->len; ++i) {
    if (cstr[i] == '"' || cstr[i] == '\\') {
      xfputc('\\', file);
    }
    xfputc(cstr[i], file);
  }
}

static void
write(pic_state *pic, pic_value obj, XFILE *file)
{
  size_t i;

  switch (pic_type(obj)) {
  case PIC_TT_NIL:
    xfprintf(file, "()");
    break;
  case PIC_TT_BOOL:
    if (pic_true_p(obj))
      xfprintf(file, "#t");
    else
      xfprintf(file, "#f");
    break;
  case PIC_TT_PAIR:
    xfprintf(file, "(");
    write_pair(pic, pic_pair_ptr(obj), file);
    xfprintf(file, ")");
    break;
  case PIC_TT_SYMBOL:
    xfprintf(file, "%s", pic_symbol_name(pic, pic_sym(obj)));
    break;
  case PIC_TT_CHAR:
    switch (pic_char(obj)) {
    default: xfprintf(file, "#\\%c", pic_char(obj)); break;
    case '\a': xfprintf(file, "#\\alarm"); break;
    case '\b': xfprintf(file, "#\\backspace"); break;
    case 0x7f: xfprintf(file, "#\\delete"); break;
    case 0x1b: xfprintf(file, "#\\escape"); break;
    case '\n': xfprintf(file, "#\\newline"); break;
    case '\r': xfprintf(file, "#\\return"); break;
    case ' ': xfprintf(file, "#\\space"); break;
    case '\t': xfprintf(file, "#\\tab"); break;
    }
    break;
  case PIC_TT_FLOAT:
    xfprintf(file, "%f", pic_float(obj));
    break;
  case PIC_TT_INT:
    xfprintf(file, "%d", pic_int(obj));
    break;
  case PIC_TT_EOF:
    xfprintf(file, "#<eof-object>");
    break;
  case PIC_TT_UNDEF:
    xfprintf(file, "#<undef>");
    break;
  case PIC_TT_PROC:
    xfprintf(file, "#<proc %p>", pic_ptr(obj));
    break;
  case PIC_TT_PORT:
    xfprintf(file, "#<port %p>", pic_ptr(obj));
    break;
  case PIC_TT_STRING:
    xfprintf(file, "\"");
    write_str(pic, pic_str_ptr(obj), file);
    xfprintf(file, "\"");
    break;
  case PIC_TT_VECTOR:
    xfprintf(file, "#(");
    for (i = 0; i < pic_vec_ptr(obj)->len; ++i) {
      write(pic, pic_vec_ptr(obj)->data[i], file);
      if (i + 1 < pic_vec_ptr(obj)->len) {
	xfprintf(file, " ");
      }
    }
    xfprintf(file, ")");
    break;
  case PIC_TT_BLOB:
    xfprintf(file, "#u8(");
    for (i = 0; i < pic_blob_ptr(obj)->len; ++i) {
      xfprintf(file, "%d", pic_blob_ptr(obj)->data[i]);
      if (i + 1 < pic_blob_ptr(obj)->len) {
	xfprintf(file, " ");
      }
    }
    xfprintf(file, ")");
    break;
  case PIC_TT_ERROR:
    xfprintf(file, "#<error %p>", pic_ptr(obj));
    break;
  case PIC_TT_ENV:
    xfprintf(file, "#<env %p>", pic_ptr(obj));
    break;
  case PIC_TT_CONT:
    xfprintf(file, "#<cont %p>", pic_ptr(obj));
    break;
  case PIC_TT_SENV:
    xfprintf(file, "#<senv %p>", pic_ptr(obj));
    break;
  case PIC_TT_SYNTAX:
    xfprintf(file, "#<syntax %p>", pic_ptr(obj));
    break;
  case PIC_TT_SC:
    xfprintf(file, "#<sc %p: ", pic_ptr(obj));
    write(pic, pic_sc(obj)->expr, file);
    xfprintf(file, ">");
    break;
  case PIC_TT_LIB:
    xfprintf(file, "#<lib %p>", pic_ptr(obj));
    break;
  case PIC_TT_VAR:
    xfprintf(file, "#<var %p>", pic_ptr(obj));
    break;
  case PIC_TT_IREP:
    xfprintf(file, "#<irep %p>", pic_ptr(obj));
    break;
  }
}

void
pic_debug(pic_state *pic, pic_value obj)
{
  write(pic, obj, xstdout);
  xfflush(xstdout);
}

static pic_value
pic_port_write_simple(pic_state *pic)
{
  pic_value v;
  struct pic_port *port = pic_stdout(pic);

  pic_get_args(pic, "o|p", &v, &port);
  write(pic, v, port->file);
  return pic_none_value();
}

void
pic_init_write(pic_state *pic)
{
  pic_deflibrary ("(scheme write)") {
    pic_defun(pic, "write-simple", pic_port_write_simple);
  }
}
{'fraction_non_alphanumeric': 0.196269871072725, 'fraction_numerical': 0.002503442233070472, 'mean_word_length': 3.304956896551724, 'pattern_counts': {'":': 0, '<': 39, '<?xml version=': 0, '>': 58, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '4347508', 'n_tokens_mistral': 3309, 'n_tokens_neox': 3282, 'n_words': 659}