From 741a01da093aca044cd9816e924d121566bc9398 Mon Sep 17 00:00:00 2001
From: Marius Gerbershagen <marius.gerbershagen@gmail.com>
Date: Sun, 26 Aug 2018 18:32:13 +0200
Subject: [PATCH] reader: fix reading of bclosures

    The syntax had been changed in commit
    991bc3ab7827acb0ec932ec90f5edbcbbd311865, but the reader macro
    became broken in the process and commit
    835e85bc992e5031ecfeed288a6b6f9a239339f6 removed the broken
    parts. Since the reason for the change in the syntax is unclear,
    go back to the old syntax.
---
 src/c/printer/write_code.d | 46 +++++++++++++++++++++-----------------
 src/c/read.d               | 10 ++++++++-
 2 files changed, 35 insertions(+), 21 deletions(-)

diff --git a/src/c/printer/write_code.d b/src/c/printer/write_code.d
index 122af7770..c937a4450 100644
--- a/src/c/printer/write_code.d
+++ b/src/c/printer/write_code.d
@@ -16,22 +16,35 @@
 #include <ecl/internal.h>
 #include <ecl/bytecodes.h>
 
+void
+_ecl_write_bytecodes_readably(cl_object x, cl_object stream, cl_object lex)
+{
+  cl_index i;
+  cl_object code_l = ECL_NIL;
+  /* INV: We don't write the definition of the closure, hence we don't
+   * need to write the macros it closes over either */
+  for (; !Null(lex); lex = ECL_CONS_CDR(lex)) {
+    cl_object record = ECL_CONS_CAR(lex);
+    if (!ECL_CONSP(record) || (ECL_CONS_CAR(record) != @'si::macro' &&
+                               ECL_CONS_CAR(record) != @'si::symbol-macro'))
+      break;
+  }
+  for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
+    code_l = ecl_cons(ecl_make_fixnum(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
+  writestr_stream("#Y", stream);
+  si_write_ugly_object(cl_list(7, x->bytecodes.name, lex,
+                               ECL_NIL /* x->bytecodes.definition */,
+                               code_l, x->bytecodes.data,
+                               x->bytecodes.file,
+                               x->bytecodes.file_position),
+                       stream);
+}
+
 void
 _ecl_write_bytecodes(cl_object x, cl_object stream)
 {
   if (ecl_print_readably()) {
-    cl_index i;
-    cl_object lex = ECL_NIL;
-    cl_object code_l=ECL_NIL;
-    for ( i=x->bytecodes.code_size-1 ; i<(cl_index)(-1l) ; i-- )
-      code_l = ecl_cons(ecl_make_fixnum(((cl_opcode*)(x->bytecodes.code))[i]), code_l);
-    writestr_stream("#Y", stream);
-    si_write_ugly_object(cl_list(7, x->bytecodes.name, lex,
-                                 ECL_NIL /* x->bytecodes.definition */,
-                                 code_l, x->bytecodes.data,
-                                 x->bytecodes.file,
-                                 x->bytecodes.file_position),
-                         stream);
+    _ecl_write_bytecodes_readably(x, stream, ECL_NIL);
   } else {
     _ecl_write_unreadable(x, "bytecompiled-function", x->bytecodes.name, stream);
   }
@@ -41,14 +54,7 @@ void
 _ecl_write_bclosure(cl_object x, cl_object stream)
 {
   if (ecl_print_readably()) {
-    cl_object lex = x->bclosure.lex;
-    if (Null(lex)) {
-      _ecl_write_bytecodes(x->bclosure.code, stream);
-    } else {
-      writestr_stream("#Y", stream);
-      si_write_ugly_object(cl_list(2, x->bclosure.code, lex),
-                           stream);
-    }
+    _ecl_write_bytecodes_readably(x->bclosure.code, stream, x->bclosure.lex);
   } else {
     cl_object name = x->bytecodes.name;
     writestr_stream("#<bytecompiled-closure ", stream);
diff --git a/src/c/read.d b/src/c/read.d
index 21391d77f..b8d667613 100644
--- a/src/c/read.d
+++ b/src/c/read.d
@@ -729,7 +729,7 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d)
   cl_object x, rv, nth, lex;
 
   if (d != ECL_NIL && !read_suppress)
-    extra_argument('C', in, d);
+    extra_argument('Y', in, d);
   x = ecl_read_object(in);
   unlikely_if (x == OBJNULL) {
     FEend_of_file(in);
@@ -780,6 +780,14 @@ sharp_Y_reader(cl_object in, cl_object c, cl_object d)
   rv->bytecodes.file_position = nth;
 
   rv->bytecodes.entry = _ecl_bytecodes_dispatch_vararg;
+
+  if (lex != ECL_NIL) {
+    cl_object x = ecl_alloc_object(t_bclosure);
+    x->bclosure.code = rv;
+    x->bclosure.lex = lex;
+    x->bclosure.entry = _ecl_bclosure_dispatch_vararg;
+    rv = x;
+  }
   @(return rv);
 }