From 42b2f3d455d6edb445565d9935eae28ab42b9875 Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Mon, 24 Oct 2016 06:09:52 -0700
Subject: Fix non-working quasiquote over struct literals.

Turns out that there is missing support for quasiquoting
over structs. Code analogous to the way vector and hash
literals are handled is missing for structs.

* eval.c (expand_qquote_rec): Handle struct_lit_s forms
specially, like hash_lit_s and vector_lit_s.
commit 1e5bc5708d5763f20a7774f9348e825304a51adc

* struct.c (make_struct_lit_s): New symbol variable.
(struct_init): Store interned sys:make-struct-lit symbol
into make_struct_lit_s, and use that to register the
function.

* struct.h (make_struct_lit_s): Declared.

* tests/012/struct.tl: Update struct literal quasiquote
test cases to reflect fixed behavior.
---
 eval.c              | 4 ++++
 struct.c            | 5 +++--
 struct.h            | 2 +-
 tests/012/struct.tl | 7 +++----
 4 files changed, 11 insertions(+), 7 deletions(-)

diff --git a/eval.c b/eval.c
index c3b59f6d..1a788e6a 100644
--- a/eval.c
+++ b/eval.c
@@ -2742,6 +2742,10 @@ static val expand_qquote_rec(val qquoted_form, val menv,
     } else if (sym == vector_lit_s) {
       val args = expand_qquote(second(qquoted_form), menv, qq, unq, spl);
       return rlcp(list(vec_list_s, args, nao), qquoted_form);
+    } else if (sym == struct_lit_s) {
+      val args = expand_qquote(second(qquoted_form), menv, qq, unq, spl);
+      val pairs = expand_qquote(rest(rest(qquoted_form)), menv, qq, unq, spl);
+      return rlcp(list(make_struct_lit_s, args, pairs, nao), qquoted_form);
     } else {
       val f = sym;
       val r = cdr(qquoted_form);
diff --git a/struct.c b/struct.c
index c3d7293e..fd37dd68 100644
--- a/struct.c
+++ b/struct.c
@@ -88,7 +88,7 @@ struct struct_inst {
   val slot[1];
 };
 
-val struct_type_s, meth_s, print_s;
+val struct_type_s, meth_s, print_s, make_struct_lit_s;
 
 static cnum struct_id_counter;
 static val struct_type_hash;
@@ -111,6 +111,7 @@ void struct_init(void)
   struct_type_s = intern(lit("struct-type"), user_package);
   meth_s = intern(lit("meth"), user_package);
   print_s = intern(lit("print"), user_package);
+  make_struct_lit_s = intern(lit("make-struct-lit"), system_package);
   struct_type_hash = make_hash(nil, nil, nil);
   slot_hash = make_hash(nil, nil, t);
   struct_type_finalize_f = func_n1(struct_type_finalize);
@@ -131,7 +132,7 @@ void struct_init(void)
   reg_fun(intern(lit("make-struct"), user_package), func_n2v(make_struct));
   reg_fun(intern(lit("make-lazy-struct"), user_package),
           func_n2(make_lazy_struct));
-  reg_fun(intern(lit("make-struct-lit"), system_package), func_n2(make_struct_lit));
+  reg_fun(make_struct_lit_s, func_n2(make_struct_lit));
   reg_fun(intern(lit("copy-struct"), user_package), func_n1(copy_struct));
   reg_fun(intern(lit("replace-struct"), user_package), func_n2(replace_struct));
   reg_fun(intern(lit("clear-struct"), user_package), func_n2o(clear_struct, 1));
diff --git a/struct.h b/struct.h
index cf1ef26a..ab3e7037 100644
--- a/struct.h
+++ b/struct.h
@@ -25,7 +25,7 @@
  * OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  */
 
-extern val struct_type_s, meth_s;
+extern val struct_type_s, meth_s, make_struct_lit_s;
 val make_struct_type(val name, val super,
                      val static_slots, val slots,
                      val static_initfun, val initfun, val boactor,
diff --git a/tests/012/struct.tl b/tests/012/struct.tl
index a55e8447..cecdfb15 100644
--- a/tests/012/struct.tl
+++ b/tests/012/struct.tl
@@ -11,11 +11,10 @@
     (b (inc x))))
 
 (test ^#S(bar b ,(+ 2 2))
-      (sys:struct-lit
-        bar b 4))
+      #S(bar a 103 b 4))
 
-(test (sys:expand ^#S(bar b ,(+ 2 2)))
-      (sys:make-struct-lit 'bar '(b 4)))
+(test (sys:expand '^#S(bar b ,(+ 2 2)))
+      (sys:make-struct-lit 'bar (list 'b (+ 2 2))))
 
 (defvar s (eval ^#S(bar b ,(+ 2 2))))
 
-- 
cgit v1.2.3