From abecbd70f0fc03bd44e89dfdd7f50499dfc7ee6a Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Wed, 4 Mar 2009 00:21:17 +0900
Subject: [PATCH] fixing offby1 error in closure rep

---
 Makefile    |   8 +-
 eval.c      |  54 ++---
 eval.h      |   6 +
 sexp-orig.c | 594 ----------------------------------------------------
 sexp.c      |   4 +-
 sexp.h      |   2 +-
 6 files changed, 42 insertions(+), 626 deletions(-)
 delete mode 100644 sexp-orig.c

diff --git a/Makefile b/Makefile
index 1c5154e4..65bd0c22 100644
--- a/Makefile
+++ b/Makefile
@@ -3,19 +3,21 @@
 
 all: chibi-scheme
 
+CFLAGS=-g -Os
+
 GC_OBJ=./gc/gc.a
 
 $GC_OBJ: ./gc/alloc.c
 	cd gc && make test
 
 sexp.o: sexp.c sexp.h config.h
-	gcc -c -g -Os -o $@ $<
+	gcc -c $(CFLAGS) -o $@ $<
 
 eval.o: eval.c debug.c eval.h sexp.h config.h
-	gcc -c -g -Os -o $@ $<
+	gcc -c $(CFLAGS) -o $@ $<
 
 chibi-scheme: sexp.o eval.o $(GC_OBJ)
-	gcc -g -Os -o $@ $^
+	gcc $(CFLAGS) -o $@ $^
 
 clean:
 	rm -f *.o
diff --git a/eval.c b/eval.c
index 7f7f4afa..8d39dedb 100644
--- a/eval.c
+++ b/eval.c
@@ -4,7 +4,7 @@
 
 #include "eval.h"
 
-/* ******************************************************************** */
+/************************************************************************/
 
 static struct core_form core_forms[] = {
   {SEXP_CORE, "define", CORE_DEFINE},
@@ -19,17 +19,19 @@ static struct core_form core_forms[] = {
 };
 
 static struct opcode opcodes[] = {
-{SEXP_OPCODE, OPC_TYPE_PREDICATE, OP_CAR, 1, 0, SEXP_PAIR, 0, "car", 0, NULL},
-{SEXP_OPCODE, OPC_TYPE_PREDICATE, OP_CDR, 1, 0, SEXP_PAIR, 0, "cdr", 0, NULL},
-{SEXP_OPCODE, OPC_ARITHMETIC,     OP_ADD, 0, 1, SEXP_FIXNUM, 0, "+", 0, NULL},
-{SEXP_OPCODE, OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, "-", OP_NEG, NULL},
-{SEXP_OPCODE, OPC_ARITHMETIC,     OP_MUL, 0, 1, SEXP_FIXNUM, 0, "*", 0, NULL},
-{SEXP_OPCODE, OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, "/", OP_INV, 0},
-{SEXP_OPCODE, OPC_ARITHMETIC,     OP_MOD, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, "%", 0, NULL},
-{SEXP_OPCODE, OPC_ARITHMETIC_CMP, OP_LT,  0, 1, SEXP_FIXNUM, 0, "<", 0, NULL},
-{SEXP_OPCODE, OPC_CONSTRUCTOR,    OP_CONS, 2, 0, 0, 0, "cons", 0, NULL},
-{SEXP_OPCODE, OPC_CONSTRUCTOR,    OP_MAKE_VECTOR, 2, 0, SEXP_FIXNUM, 0, "make-vector", 0, NULL},
-{SEXP_OPCODE, OPC_CONSTRUCTOR,    OP_MAKE_PROCEDURE, 2, 0, 0, 0, "make-procedure", 0, NULL},
+#define _OP(c,o,n,m,t,u,s,i) {SEXP_OPCODE, c, o, n, m, t, u, s, i, NULL}
+_OP(OPC_TYPE_PREDICATE, OP_CAR, 1, 0, SEXP_PAIR, 0, "car", 0),
+_OP(OPC_TYPE_PREDICATE, OP_CDR, 1, 0, SEXP_PAIR, 0, "cdr", 0),
+_OP(OPC_ARITHMETIC,     OP_ADD, 0, 1, SEXP_FIXNUM, 0, "+", 0),
+_OP(OPC_ARITHMETIC_INV, OP_SUB, 0, 1, SEXP_FIXNUM, 0, "-", OP_NEG),
+_OP(OPC_ARITHMETIC,     OP_MUL, 0, 1, SEXP_FIXNUM, 0, "*", 0),
+_OP(OPC_ARITHMETIC_INV, OP_DIV, 0, 1, SEXP_FIXNUM, 0, "/", OP_INV),
+_OP(OPC_ARITHMETIC,     OP_MOD, 2, 0, SEXP_FIXNUM, SEXP_FIXNUM, "%", 0),
+_OP(OPC_ARITHMETIC_CMP, OP_LT,  0, 1, SEXP_FIXNUM, 0, "<", 0),
+_OP(OPC_CONSTRUCTOR,    OP_CONS, 2, 0, 0, 0, "cons", 0),
+_OP(OPC_CONSTRUCTOR,    OP_MAKE_VECTOR, 2, 0, SEXP_FIXNUM, 0, "make-vector", 0),
+_OP(OPC_CONSTRUCTOR,    OP_MAKE_PROCEDURE, 2, 0, 0, 0, "make-procedure", 0),
+#undef _OP
 };
 
 #ifdef USE_DEBUG
@@ -145,6 +147,8 @@ void emit_word(bytecode *bc, unsigned int *i, unsigned long val)  {
   *i += sizeof(unsigned long);
 }
 
+#define emit_push(bc,i,obj) (emit(bc,i,OP_PUSH), emit_word(bc,i,(unsigned long)obj))
+
 sexp make_procedure(sexp bc, sexp vars) {
   sexp proc = SEXP_NEW();
   if (! proc) return SEXP_ERROR;
@@ -409,8 +413,7 @@ sexp set_vars (env e, sexp formals, sexp obj, sexp sv) {
 void analyze_lambda (sexp name, sexp formals, sexp body,
                      bytecode *bc, unsigned int *i, env e,
                      sexp params, sexp fv, sexp sv, unsigned int *d) {
-  sexp obj;
-  sexp fv2 = free_vars(e, formals, body, SEXP_NULL), ls;
+  sexp obj, ls, fv2 = free_vars(e, formals, body, SEXP_NULL);
   env e2 = extend_env_closure(e, formals);
   int k;
   fprintf(stderr, "%d free-vars\n", length(fv2));
@@ -452,7 +455,7 @@ bytecode compile(sexp params, sexp obj, env e, sexp fv, sexp sv, int done_p) {
       emit(&bc, &i, OP_PUSH);
       emit_word(&bc, &i, (unsigned long) SEXP_NULL);
       emit(&bc, &i, OP_STACK_REF);
-      emit_word(&bc, &i, j+3);
+      emit_word(&bc, &i, j+4);
       emit(&bc, &i, OP_CONS);
       emit(&bc, &i, OP_STACK_SET);
       emit_word(&bc, &i, j+4);
@@ -466,7 +469,6 @@ bytecode compile(sexp params, sexp obj, env e, sexp fv, sexp sv, int done_p) {
     if (SEXP_PAIRP(SEXP_CDR(obj))) emit(&bc, &i, OP_DROP);
   }
   emit(&bc, &i, done_p ? OP_DONE : OP_RET);
-  /* fprintf(stderr, "shrinking\n"); */
   shrink_bcode(&bc, i);
   fprintf(stderr, "done compiling:\n");
   print_bytecode(bc);
@@ -482,7 +484,7 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
   int i;
 
  loop:
-  /* fprintf(stderr, "opcode: %d, ip: %d\n", *ip, ip); */
+  /* fprintf(stderr, "opcode: %s (%d), ip: %d\n", reverse_opcode_names[*ip], *ip, ip); */
   /* print_bytecode(bc); */
   switch (*ip++) {
   case OP_NOOP:
@@ -617,17 +619,19 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
     if (! SEXP_PROCEDUREP(tmp))
       errx(2, "non-procedure application: %p", tmp);
     stack[top-1] = (sexp) i;
-    stack[top] = (sexp) (ip+4);
+    stack[top] = make_integer(ip+4);
     stack[top+1] = cp;
     top+=2;
     bc = procedure_code(tmp);
     print_bytecode(bc);
+    disasm(bc);
     ip = bc->data;
     cp = procedure_vars(tmp);
     fprintf(stderr, "... calling procedure at %p\ncp: ", ip);
     write_sexp(stderr, cp);
     fprintf(stderr, "\n");
-    /* print_stack(stack, top); */
+    fprintf(stderr, "stack at %d\n", top);
+    print_stack(stack, top);
     break;
   case OP_JUMP_UNLESS:
     fprintf(stderr, "JUMP UNLESS, stack top is %d\n", stack[top-1]);
@@ -652,13 +656,9 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
     /*                      top-1  */
     /* stack: args ... n ip result */
     cp = stack[top-2];
-    fprintf(stderr, "1\n");
-    ip = (unsigned char*) stack[top-3];
-    fprintf(stderr, "2\n");
+    ip = (unsigned char*) unbox_integer(stack[top-3]);
     i = unbox_integer(stack[top-4]);
-    fprintf(stderr, "3 (i=%d)\n", i);
     stack[top-i-4] = stack[top-1];
-    fprintf(stderr, "4\n");
     top = top-i-3;
     fprintf(stderr, "... done returning\n");
     break;
@@ -673,7 +673,7 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
     stack[top] = SEXP_ERROR;
     goto end_loop;
   }
-  fprintf(stderr, "looping\n");
+  /* print_stack(stack, top); */
   goto loop;
 
  end_loop:
@@ -683,8 +683,8 @@ sexp vm(bytecode bc, env e, sexp* stack, unsigned int top) {
 /************************** eval interface ****************************/
 
 sexp eval_in_stack(sexp obj, env e, sexp* stack, unsigned int top) {
-  bytecode bc = compile(SEXP_NULL, cons(obj, SEXP_NULL), e, SEXP_NULL, SEXP_NULL, 1);
-  fprintf(stderr, "evaling\n");
+  bytecode bc;
+  bc = compile(SEXP_NULL, cons(obj, SEXP_NULL), e, SEXP_NULL, SEXP_NULL, 1);
   return vm(bc, e, stack, top);
 }
 
diff --git a/eval.h b/eval.h
index f8c806e6..a1596c9d 100644
--- a/eval.h
+++ b/eval.h
@@ -107,6 +107,7 @@ enum opcode_names {
 /**************************** prototypes ******************************/
 
 bytecode compile(sexp params, sexp obj, env e, sexp fv, sexp sv, int done_p);
+
 void analyze_app (sexp obj, bytecode *bc, unsigned int *i,
                   env e, sexp params, sexp fv, sexp sv, unsigned int *d);
 void analyze_lambda (sexp name, sexp formals, sexp body,
@@ -115,5 +116,10 @@ void analyze_lambda (sexp name, sexp formals, sexp body,
 void analyze_var_ref (sexp name, bytecode *bc, unsigned int *i, env e,
                       sexp params, sexp fv, sexp sv, unsigned int *d);
 
+sexp vm(bytecode bc, env e, sexp* stack, unsigned int top);
+
+sexp eval_in_stack(sexp obj, env e, sexp* stack, unsigned int top);
+sexp eval(sexp obj, env e);
+
 #endif /* ! SCM_EVAL_H */
 
diff --git a/sexp-orig.c b/sexp-orig.c
deleted file mode 100644
index 1da4500a..00000000
--- a/sexp-orig.c
+++ /dev/null
@@ -1,594 +0,0 @@
-
-/* #include <ctype.h> */
-#include <stdio.h>
-#include <stdlib.h>
-#include <string.h>
-#include <stdarg.h>
-
-/* simple tagging
- *   ends in  00:  pointer
- *             1:  fixnum
- *           010:  symbol
- *          0110:  char
- *          1110:  other immediate object (NULL, TRUE, FALSE)
- */
-
-enum sexp_tags {
-  SEXP_PAIR,
-  SEXP_SYMBOL,
-  SEXP_STRING,
-  SEXP_VECTOR,
-};
-
-/* would need a proper header for GC */
-typedef struct sexp_struct {
-  char tag;
-  void *data1;
-  void *data2;
-} *sexp;
-
-#define MAKE_IMMEDIATE(n)  ((sexp) ((n<<3) + 6))
-#define SEXP_NULL   MAKE_IMMEDIATE(0)
-#define SEXP_FALSE  MAKE_IMMEDIATE(1)
-#define SEXP_TRUE   MAKE_IMMEDIATE(2)
-#define SEXP_EOF    MAKE_IMMEDIATE(3)
-#define SEXP_UNDEF  MAKE_IMMEDIATE(4)
-#define SEXP_CLOSE  MAKE_IMMEDIATE(5) /* internal use */
-#define SEXP_ERROR  MAKE_IMMEDIATE(6)
-
-#define SEXP_NULLP(x)    ((x) == SEXP_NULL)
-#define SEXP_POINTERP(x) (((int) x & 3) == 0)
-#define SEXP_INTEGERP(x) (((int) x & 3) == 1)
-#define SEXP_CHARP(x)    (((int) x & 7) == 2)
-
-#define SEXP_PAIRP(x)    (SEXP_POINTERP(x) && (x)->tag == SEXP_PAIR)
-#define SEXP_SYMBOLP(x)  (SEXP_POINTERP(x) && (x)->tag == SEXP_SYMBOL)
-#define SEXP_STRINGP(x)  (SEXP_POINTERP(x) && (x)->tag == SEXP_STRING)
-
-#define SEXP_ALLOC(size) (malloc(size))
-#define SEXP_FREE        free
-#define SEXP_NEW()       ((sexp) SEXP_ALLOC(sizeof(sexp)))
-
-#define make_integer(n)    ((sexp) (((int) n<<2) + 1))
-#define unbox_integer(n)   ((int) n>>2)
-#define make_character(n)  ((sexp) (((int) n<<3) + 2))
-#define unbox_character(n) ((int) n>>3)
-
-#define vector_length(x) ((int) x->data1)
-#define vector_data(x)   ((sexp*) x->data2)
-
-#define string_length(x) ((int) x->data1)
-#define string_data(x)   ((char*) x->data2)
-
-sexp cons(sexp head, sexp tail) {
-  sexp pair = SEXP_NEW();
-  if (! pair) return SEXP_ERROR;
-  pair->tag = SEXP_PAIR;
-  pair->data1 = (void*) head;
-  pair->data2 = (void*) tail;
-  return pair;
-}
-
-sexp car(sexp obj) {
-  return (SEXP_PAIRP(obj)) ? obj->data1 : SEXP_ERROR;
-}
-
-sexp cdr(sexp obj) {
-  return (SEXP_PAIRP(obj)) ? obj->data2 : SEXP_ERROR;
-}
-
-sexp set_car(sexp obj, sexp val) {
-  if (SEXP_PAIRP(obj)) {
-    return obj->data1 = val;
-  } else {
-    return SEXP_ERROR;
-  }
-}
-
-sexp set_cdr(sexp obj, sexp val) {
-  if (SEXP_PAIRP(obj)) {
-    return obj->data2 = val;
-  } else {
-    return SEXP_ERROR;
-  }
-}
-
-sexp nreverse(sexp ls) {
-  sexp a;
-  sexp b;
-  sexp tmp;
-
-  if (ls == SEXP_NULL) {
-    return ls;
-  } else if (! SEXP_PAIRP(ls)) {
-    return SEXP_ERROR;
-  } else {
-    b = ls;
-    a=cdr(ls);
-    set_cdr(b, SEXP_NULL);
-    for ( ; SEXP_PAIRP(a); ) {
-      tmp = cdr(a);
-      set_cdr(a, b);
-      b = a;
-      a = tmp;
-    }
-    return b;
-  }
-}
-
-sexp list(int count, ...) {
-  sexp res = SEXP_NULL;
-  sexp elt;
-  int i;
-  va_list ap;
-
-  va_start(ap, count);
-  for (i=0; i<count; i++) {
-    res = cons(va_arg(ap, sexp), res);
-  }
-  va_end(ap);
-  return nreverse(res);
-}
-
-int length(sexp ls) {
-  sexp x;
-  int res;
-  for (res=0, x=ls; SEXP_PAIRP(x); res++, x=cdr(x))
-    ;
-  return res;
-}
-
-sexp make_string(char *str) {
-  sexp s = SEXP_NEW();
-  if (! s) return SEXP_ERROR;
-  int len = strlen(str);
-  char *mystr = SEXP_ALLOC(len+1);
-  if (! mystr) { SEXP_FREE(s); return SEXP_ERROR; }
-  strncpy(mystr, str, len+1);
-  s->tag = SEXP_STRING;
-  s->data1 = (void*) len;
-  s->data2 = (void*) mystr;
-  return s;
-}
-
-sexp intern(char *str) {
-  sexp sym = SEXP_NEW();
-  if (! sym) return SEXP_ERROR;
-  int len = strlen(str);
-  char *mystr = SEXP_ALLOC(len+1);
-  if (! mystr) { SEXP_FREE(sym); return SEXP_ERROR; }
-  strncpy(mystr, str, len+1);
-  sym->tag = SEXP_SYMBOL;
-  sym->data1 = (void*) len;
-  sym->data2 = (void*) mystr;
-  return sym;
-}
-
-sexp make_vector(int len, sexp dflt) {
-  int i;
-  sexp v = SEXP_NEW();
-  if (v == NULL) return SEXP_ERROR;
-  sexp *x = (void*) SEXP_ALLOC(len*sizeof(sexp));
-  if (x == NULL) return SEXP_ERROR;
-  for (i=0; i<len; i++) {
-    x[i] = dflt;
-  }
-  v->tag = SEXP_VECTOR;
-  v->data1 = (void*) len;
-  v->data2 = (void*) x;
-  return v;
-}
-
-sexp list_to_vector(sexp ls) {
-  sexp vec = make_vector(length(ls), SEXP_FALSE);
-  if (vec == SEXP_ERROR) return vec;
-  sexp x;
-  sexp *elts = vector_data(vec);
-  int i;
-  for (i=0, x=ls; SEXP_PAIRP(x); i++, x=cdr(x)) {
-    elts[i] = car(x);
-  }
-  return vec;
-}
-
-sexp vector(int count, ...) {
-  sexp vec = make_vector(count, SEXP_FALSE);
-  if (vec == SEXP_ERROR) return vec;
-  sexp *elts = vector_data(vec);
-  va_list ap;
-  int i;
-
-  va_start(ap, count);
-  for (i=0; i<count; i++) {
-    elts[i] = va_arg(ap, sexp);
-  }
-  va_end(ap);
-  return vec;
-}
-
-void write_sexp (FILE *out, sexp obj) {
-  int len, i;
-  sexp x;
-
-  if (SEXP_POINTERP(obj)) {
-
-    switch (obj->tag) {
-    case SEXP_PAIR:
-      fprintf(out, "(");
-      write_sexp(out, car(obj));
-      for (x=cdr(obj); SEXP_PAIRP(x); x=cdr(x)) {
-        fprintf(out, " ");
-        write_sexp(out, car(x));
-      }
-      if (! SEXP_NULLP(x)) {
-        fprintf(out, " . ");
-        write_sexp(out, x);
-      }
-      fprintf(out, ")");
-      break;
-    case SEXP_VECTOR:
-      len = vector_length(obj);
-      sexp *elts = vector_data(obj);
-      if (len == 0) {
-        fprintf(out, "#()");
-      } else {
-        fprintf(out, "#(");
-        write_sexp(out, elts[0]);
-        for (i=1; i<len; i++) {
-          fprintf(out, " ");
-          write_sexp(out, elts[i]);
-        }
-        fprintf(out, ")");
-      }
-      break;
-    case SEXP_STRING:
-      fprintf(out, "\"");
-      /* FALLTHROUGH */
-    case SEXP_SYMBOL:
-      fprintf(out, "%s", string_data(obj));
-      if (obj->tag == SEXP_STRING) {
-        fprintf(out, "\"");
-      }
-      break;
-    }
-
-  } else if (SEXP_INTEGERP(obj)) {
-
-      fprintf(out, "%d", unbox_integer(obj));
-
-  } else if (SEXP_CHARP(obj)) {
-
-      if (33 <= unbox_character(obj) < 127) {
-        fprintf(out, "#\\%c", unbox_character(obj));
-      } else {
-        fprintf(out, "#\\x%02d", unbox_character(obj));
-      }
-
-  } else {
-
-    switch ((int) obj) {
-    case (int) SEXP_NULL:
-      fprintf(out, "()");
-      break;
-    case (int) SEXP_TRUE:
-      fprintf(out, "#t");
-      break;
-    case (int) SEXP_FALSE:
-      fprintf(out, "#f");
-      break;
-    case (int) SEXP_EOF:
-      fprintf(out, "#<eof>");
-      break;
-    case (int) SEXP_UNDEF:
-      fprintf(out, "#<undef>");
-      break;
-    default:
-      fprintf(out, "#<error>");
-    }
-  }
-}
-
-void* free_sexp (sexp obj) {
-  int len, i;
-  sexp *elts;
-
-  if (SEXP_POINTERP(obj)) {
-    switch (obj->tag) {
-    case SEXP_PAIR:
-      free_sexp(car(obj));
-      free_sexp(cdr(obj));
-      break;
-    case SEXP_VECTOR:
-      len = vector_length(obj);
-      elts = vector_data(obj);
-      for (i=0; i<len; i++) {
-        free_sexp(elts[i]);
-      }
-      SEXP_FREE(elts);
-      break;
-    case SEXP_STRING:
-    case SEXP_SYMBOL:
-      free(string_data(obj));
-      break;
-    }
-
-    SEXP_FREE(obj);
-  }
-}
-
-enum sexp_tokens {
-  TOK_OPEN_LIST,
-  TOK_OPEN_VECTOR,
-  TOK_CLOSE,
-  TOK_START_STRING,
-  TOK_SYMBOL,
-  TOK_NUMBER,
-  TOK_QUOTE,
-  TOK_QUASIQUOTE,
-  TOK_UNQUOTE,
-  TOK_UNQUOTE_SPLICING,
-  TOK_EOF,
-  TOK_TRUE,
-  TOK_FALSE,
-  TOK_ERROR,
-};
-
-char* read_string(FILE *in) {
-  char *buf, *tmp, *res;
-  char c;
-  int len;
-
-  buf = SEXP_ALLOC(128);
-  tmp = buf;
-
-  for (c=fgetc(in); (c != EOF) && (c != '"'); c=fgetc(in)) {
-    if (c == '\\') {
-      c=fgetc(in);
-      switch (c) {
-      case 'n':
-        c = '\n';
-      case 't':
-        c = '\t';
-      }
-      *tmp++ = c;
-    } else {
-      *tmp++ = c;
-    }
-  }
-
-  *tmp++ = '\0';
-  len = tmp - buf;
-  res = SEXP_ALLOC(len);
-  strncpy(res, buf, len);
-  SEXP_FREE(buf);
-  return res;
-}
-
-char* read_symbol(FILE *in) {
-  char *buf, *tmp, *res;
-  char c;
-  int len;
-
-  buf = SEXP_ALLOC(128);
-  tmp = buf;
-
-  while (1) {
-    c=fgetc(in);
-    switch (c) {
-    case '(': case ')': case ';': case ' ': case '\t': case '\r': case '\n':
-    case '\'': case '"': case ',': case EOF:
-      ungetc(c, in);
-      goto done;
-      break;
-    }
-    *tmp++ = c;
-  }
- done:
-
-  *tmp++ = '\0';
-  len = tmp - buf;
-  res = SEXP_ALLOC(len);
-  strncpy(res, buf, len);
-  SEXP_FREE(buf);
-  return res;
-}
-
-int read_number(FILE *in) {
-  int res = 0;
-  int negativep = 0;
-  char c;
-
-  c = fgetc(in);
-  if (c == '-') {
-    negativep = 1;
-  } else if (isdigit(c)) {
-    res = c - '0';
-  }
-
-  for (c=fgetc(in); isdigit(c); c=fgetc(in)) {
-    res = res * 10 + (c - '0');
-  }
-  ungetc(c, in);
-
-  return negativep ? -res : res;
-}
-
-int read_token (FILE *in) {
-  int c;
- scan_loop:
-  while (isspace(c=fgetc(in)))
-    ;
-  if (c == EOF)
-    return TOK_EOF;
-  switch (c) {
-  case ';':
-    while ((c=fgetc(in)) != '\n')
-      ;
-    goto scan_loop;
-    break;
-  case '\'':
-    return TOK_QUOTE;
-  case '`':
-    return TOK_QUASIQUOTE;
-  case '"':
-    return TOK_START_STRING;
-  case '(':
-    return TOK_OPEN_LIST;
-  case ')':
-    return TOK_CLOSE;
-  case ',':
-    c = fgetc(in);
-    if (c == '@') {
-      return TOK_UNQUOTE_SPLICING;
-    } else {
-      ungetc(c, in);
-      return TOK_UNQUOTE;
-    }
-  case '#':
-    c = fgetc(in);
-    switch (c) {
-    case '(':
-      return TOK_OPEN_VECTOR;
-    case 't':
-      return TOK_TRUE;
-    case 'f':
-      return TOK_FALSE;
-/*     case ';': */
-/*       read_sexp(in); */
-/*       goto scan_loop; */
-/*     case 'b': */
-/*       return TOK_BINARY; */
-/*     case 'o': */
-/*       return TOK_OCTAL; */
-/*     case 'o': */
-/*       return TOK_DECIMAL; */
-/*     case 'x': */
-/*       return TOK_HEXADECIMAL; */
-/*     case 'e': */
-/*       return TOK_EXACT; */
-/*     case 'i': */
-/*       return TOK_INEXACT; */
-    default:
-      return TOK_ERROR;
-    }
-/*   case '+': */
-/*   case '-': */
-  default:
-    ungetc(c, in);
-    return (isdigit(c) || c == '+' || c == '-') ? TOK_NUMBER : TOK_SYMBOL;
-  }
-}
-
-sexp read_sexp (FILE *in) {
-  sexp res, tmp, tmp2;
-  char *str;
-  int tok = read_token(in);
-
-  switch (tok) {
-  case TOK_EOF:
-    res = SEXP_EOF;
-    break;
-  case TOK_TRUE:
-    res = SEXP_TRUE;
-    break;
-  case TOK_FALSE:
-    res = SEXP_FALSE;
-    break;
-  case TOK_QUOTE:
-    res = read_sexp(in);
-    res = list(2, intern("quote"), res);
-    break;
-  case TOK_QUASIQUOTE:
-    res = read_sexp(in);
-    res = list(2, intern("quasiquote"), res);
-    break;
-  case TOK_UNQUOTE:
-    res = read_sexp(in);
-    res = list(2, intern("unquote"), res);
-    break;
-  case TOK_UNQUOTE_SPLICING:
-    res = read_sexp(in);
-    res = list(2, intern("unquote-splicing"), res);
-    break;
-  case TOK_OPEN_LIST:
-  case TOK_OPEN_VECTOR:
-    res = SEXP_NULL;
-    tmp = read_sexp(in);
-    while ((tmp != SEXP_ERROR) && (tmp != SEXP_EOF) && (tmp != SEXP_CLOSE)) {
-      if ((tok == TOK_OPEN_LIST) && SEXP_SYMBOLP(tmp)
-          && (strncmp(string_data(tmp), ".", 2) == 0)) {
-        /* dotted list */
-        free_sexp(tmp);
-        tmp = read_sexp(in);
-        if (read_token(in) != TOK_CLOSE) {
-          res = SEXP_ERROR;
-        } else {
-          tmp2 = res;
-          res = nreverse(res);
-          set_cdr(tmp2, tmp);
-          return res;
-        }
-      } else {
-        res = cons(tmp, res);
-        tmp = read_sexp(in);
-      }
-    }
-    if (tmp != SEXP_CLOSE) {
-      free_sexp(res);
-      res = SEXP_ERROR;
-    }
-    res = nreverse(res);
-    if (tok == TOK_OPEN_VECTOR) {
-      tmp = res;
-      res = list_to_vector(tmp);
-      free_sexp(tmp);
-    }
-    break;
-  case TOK_START_STRING:
-    str = read_string(in);
-    res = make_string(str);
-    free(str);
-    break;
-  case TOK_SYMBOL:
-    str = read_symbol(in);
-    res = intern(str);
-    free(str);
-    break;
-  case TOK_NUMBER:
-    res = make_integer(read_number(in));
-    break;
-  case TOK_CLOSE:
-    res = SEXP_CLOSE;
-    break;
-  case TOK_ERROR:
-  default:
-    res = SEXP_ERROR;
-    break;
-  }
-  return res;
-}
-
-int main (int argc, char **argv) {
-  sexp obj;
-
-  /* sample object */
-/*   write_sexp(stdout, list(6, */
-/*                           intern("foo"), */
-/*                           make_integer(2), */
-/*                           make_string("bar"), */
-/*                           make_character('d'), */
-/*                           vector(2, intern("baz"), intern("qux")), */
-/*                           SEXP_TRUE)); */
-/*   fprintf(stdout, "\n"); */
-
-  /* rpl (repl without the eval) */
-  fprintf(stdout, "> ");
-  fflush(stdout);
-  while ((obj = read_sexp(stdin)) != SEXP_EOF) {
-    write_sexp(stdout, obj);
-    fprintf(stdout, "\n> ");
-    fflush(stdout);
-  }
-  fprintf(stdout, "\n");
-  return 0;
-}
diff --git a/sexp.c b/sexp.c
index 5a24b841..8e4b5535 100644
--- a/sexp.c
+++ b/sexp.c
@@ -102,8 +102,10 @@ sexp cdr(sexp obj) {
 sexp set_car(sexp obj, sexp val) {
   if (SEXP_PAIRP(obj))
     return SEXP_CAR(obj) = val;
-  else
+  else {
+    sexp_debug("error: set-car! not a pair: ", obj);
     return SEXP_ERROR;
+  }
 }
 
 sexp set_cdr(sexp obj, sexp val) {
diff --git a/sexp.h b/sexp.h
index abd26c7a..e2b88fa4 100644
--- a/sexp.h
+++ b/sexp.h
@@ -19,7 +19,7 @@
 #define errx(code, msg, ...) (fprintf(stderr,msg"\n",__VA_ARGS__), exit(code))
 #endif
 
-#define sexp_debug(msg, obj, ...) (fprintf(stderr,msg,__VA_ARGS__), fflush(stderr), write_sexp(stderr, obj), fprintf(stderr,"\n"))
+#define sexp_debug(msg, obj) (fprintf(stderr,msg), fflush(stderr), write_sexp(stderr, obj), fprintf(stderr,"\n"))
 
 #ifdef USE_BOEHM
 #include "gc/include/gc.h"