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.

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)
+
 
 /*
  * Instruction operation

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 ();

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))
+             (push-call! #f 'mark '())
-             (loop (cdr x))
+             (loop (car x) #t)
-             (push-code! #f (make-glil-call 'cons 2)))
+             (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)

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)))