fix compilation of quasiquote with splicing and improper lists

* libguile/vm-engine.h (POP_CONS_MARK): New macro, analagous to
  POP_LIST_MARK; used in quasiquote on improper lists.

* libguile/vm-i-system.c (cons-mark): New instruction. You know the
  drill, remove all your .go files please.

* module/system/il/compile.scm (codegen): Compile quasiquoted improper
  lists with splices correctly. Additionally check that we don't have
  slices in the CDR of an improper list.

* testsuite/t-quasiquote.scm: Add a test for unquote-splicing in improper
  lists.

diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 0d0c03d..936bbb4 100644 (file)
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -356,6 +356,19 @@ do {                                               \
   PUSH (l);                                    \
 } while (0)
 
+#define POP_CONS_MARK()                                \
+do {                                           \
+  SCM o, l;                                    \
+  POP (l);                                      \
+  POP (o);                                     \
+  while (!SCM_UNBNDP (o))                      \
+    {                                          \
+      CONS (l, o, l);                          \
+      POP (o);                                 \
+    }                                          \
+  PUSH (l);                                    \
+} while (0)
+
 \f
 /*
  * Instruction operation

diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 46075c0..db6d0a7 100644 (file)
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -198,6 +198,12 @@ VM_DEFINE_INSTRUCTION (list_mark, "list-mark", 0, 0, 0)
   NEXT;
 }
 
+VM_DEFINE_INSTRUCTION (cons_mark, "cons-mark", 0, 0, 0)
+{
+  POP_CONS_MARK ();
+  NEXT;
+}
+
 VM_DEFINE_INSTRUCTION (vector_mark, "vector-mark", 0, 0, 0)
 {
   POP_LIST_MARK ();

diff --git a/module/system/il/compile.scm b/module/system/il/compile.scm
index 838926f..51c4181 100644 (file)
--- a/module/system/il/compile.scm
+++ b/module/system/il/compile.scm
@@ -188,21 +188,24 @@
         (return-object! loc obj))
 
        ((<ghil-quasiquote> env loc exp)
-        (let loop ((x exp))
+        (let loop ((x exp) (in-car? #f))
            (cond
             ((list? x)
              (push-call! #f 'mark '())
-             (for-each loop x)
+             (for-each (lambda (x) (loop x #t)) x)
              (push-call! #f 'list-mark '()))
             ((pair? x)
-             (loop (car x))
-             (loop (cdr x))
-             (push-code! #f (make-glil-call 'cons 2)))
+             (push-call! #f 'mark '())
+             (loop (car x) #t)
+             (loop (cdr x) #f)
+             (push-call! #f 'cons-mark '()))
             ((record? x)
              (record-case x
               ((<ghil-unquote> env loc exp)
                (comp-push exp))
               ((<ghil-unquote-splicing> env loc exp)
+               (if (not in-car?)
+                   (error "unquote-splicing in the cdr of a pair" exp))
                (comp-push exp)
                (push-call! #f 'list-break '()))))
             ((constant? x)

diff --git a/testsuite/t-quasiquote.scm b/testsuite/t-quasiquote.scm
index 6c482b8..08e306c 100644 (file)
--- a/testsuite/t-quasiquote.scm
+++ b/testsuite/t-quasiquote.scm
@@ -6,4 +6,7 @@
   `(1 2)
   (let ((x 1)) `,x)
   (let ((x 1)) `(,x))
-  (let ((x 1)) ``(,x)))
+  (let ((x 1)) ``(,x))
+  (let ((head '(a b))
+        (tail 'c))
+    `(,@head . ,tail)))