From 8f263daffc65d339772a558fa8b0d57b09ab7c04 Mon Sep 17 00:00:00 2001
From: Jesse McDonald <nybble41@gmail.com>
Date: Sun, 22 Nov 2009 03:12:17 -0600
Subject: [PATCH] Add a reserved input code for 'self', the current lambda.

Correct an error in the documentation for the condition bytecode(s).
Adjust the printer to limit the depth of non-cyclic object output.
---
 doc/bytecode.txt |  8 +++++---
 gc.c             | 18 ++++++++++++++----
 interp.c         | 16 ++++++++++++----
 3 files changed, 31 insertions(+), 11 deletions(-)

diff --git a/doc/bytecode.txt b/doc/bytecode.txt
index ecf236d..7d9da6a 100644
--- a/doc/bytecode.txt
+++ b/doc/bytecode.txt
@@ -132,8 +132,9 @@ binary-expr: up to 63 (01..3f), 1 out, 2 in
   27 (set! out (nextafter in1 in2))  ; float float
   28 (set! out (remainder in1 in2))  ; float float
   29 (set! out (scalb     in1 in2))  ; float float
-conditional: 1AAAAAAA; 1 out, 2 in + fA
-  AA (set! out (if fA in1 in2))     ; in2 if fA == #f, in1 otherwise
+conditional: 1 out, 3 in
+  ; 0x80 <= AA <= 0xf7 (f0-f119)
+  AA (set! AA (if in1 in2 in3))      ; in3 if in1 == #f, in2 otherwise
 statement: up to 64 (40..7f), 3 in
   ; binary statements
   40 (set-box! in in)  ; box value
@@ -150,7 +151,8 @@ in:
   gN   (00NNNNNN) [global, N < 64]
   iN   (01NNNNNN) [instance, N < 64]
   fN   (1NNNNNNN) [frame, N < 120]
-  --   (11111NNN) [reserved, N < 5]
+  --   (11111NNN) [reserved, N < 4]
+  self (11111100) [current lambda]
   argv (11111101) [argument list]
   k    (11111110) [continuation]
   ctx  (11111111) [dynamic context]
diff --git a/gc.c b/gc.c
index d08b9c1..494da26 100644
--- a/gc.c
+++ b/gc.c
@@ -920,13 +920,23 @@ typedef struct seen_value
 static void _fprint_value(FILE *f, value_t v, seen_value_t *seen)
 {
   seen_value_t new_seen = { v, seen };
+  int depth = 0;
 
-  for (seen_value_t *sv = seen; sv; sv = sv->prev)
+  if (is_object(v) && !(is_float(v) || is_byte_string(v) || is_builtin_fn(v)))
   {
-    if (v == sv->value)
+    for (seen_value_t *sv = seen; sv; sv = sv->prev)
     {
-      fputs("#<cycle>", f);
-      return;
+      if (v == sv->value)
+      {
+        fputs("#<cycle>", f);
+        return;
+      }
+
+      if (++depth >= 3)
+      {
+        fputs("...", f);
+        return;
+      }
     }
   }
 
diff --git a/interp.c b/interp.c
index d858b6b..6492b06 100644
--- a/interp.c
+++ b/interp.c
@@ -10,6 +10,7 @@
 #include <stdbool.h>
 #include <stdlib.h>
 #include <string.h>
+#include <stdio.h>
 
 #include "gc.h"
 #include "builtin.h"
@@ -86,6 +87,12 @@ value_t run_interpreter(value_t lambda, value_t argv)
      * Now 'lambda' really is a lambda structure instance (or builtin).
      */
 
+#if 0
+    fprint_value(stderr, state.lambda.value); fputc('\n', stderr);
+    fprint_value(stderr, state.argv.value); fputc('\n', stderr);
+    fputc('\n', stderr);
+#endif
+
     if (is_builtin_fn(state.lambda.value))
     {
       /* Builtin functions replace the byte-code and tail-call
@@ -214,10 +221,9 @@ static value_t make_lambda(interp_state_t *state, value_t templ)
   byte_string_t *t_inst;
   value_t temp;
 
-  if (struct_is_a(templ, lambda_type_root.value))
+  /* If it's not a template object, just return as-is. */
+  if (!struct_is_a(templ, template_type_root.value))
     return templ;
-
-  release_assert(struct_is_a(templ, template_type_root.value));
   
   register_gc_root(&templ_root, templ);
   register_gc_root(&lambda_root, make_struct(lambda_type_root.value, LAMBDA_SLOTS));
@@ -518,7 +524,9 @@ static value_t get_input(const interp_state_t *state, fixnum_t var)
       release_assert(var < state->nframe);
       return vec->elements[var];
     }
-  /* 248 ... 252 are reserved */
+  /* 248 ... 251 are reserved */
+  case 252:
+    return state->lambda.value;
   case 253:
     return state->argv.value;
   case 254: