picrin/src/port.c

#include <stdio.h>
#include <stdlib.h>

#include "picrin.h"
#include "picrin/proc.h"

static void
write(pic_state *pic, pic_value obj)
{
  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(pic, pic_car(pic, obj));
    printf(" . ");
    write(pic, pic_cdr(pic, obj));
    printf(")");
    break;
  case PIC_TT_SYMBOL:
    printf("%s", pic_symbol_ptr(obj)->name);
    break;
  case PIC_TT_FLOAT:
    printf("%g", pic_float(obj));
    break;
  case PIC_TT_UNDEF:
    printf("#<undef>");
    break;
  case PIC_TT_PROC:
    printf("#<proc %p>", pic_proc_ptr(obj));
    break;
  }
}

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

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

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

static pic_value
pic_port_newline(pic_state *pic)
{
  puts("");
  return pic_false_value();
}

void
pic_init_port(pic_state *pic)
{
  pic_defun(pic, "write", pic_port_write);
  pic_defun(pic, "newline", pic_port_newline);
}