summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2008-09-30 23:41:16 +0200
committerAndy Wingo <wingo@pobox.com>2008-09-30 23:41:16 +0200
commit2bd859c81ac55b8f229778b0fff23a35b0d6e904 (patch)
tree74f7bd1ba7b7470b6e56fc5e20e1d49bc3c7e093
parent887ce75ae828fabd9a76d8e719bd3070c334eb44 (diff)
downloadguile-2bd859c81ac55b8f229778b0fff23a35b0d6e904.tar.gz
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.
-rw-r--r--libguile/vm-engine.h13
-rw-r--r--libguile/vm-i-system.c6
-rw-r--r--module/system/il/compile.scm13
-rw-r--r--testsuite/t-quasiquote.scm5
4 files changed, 31 insertions, 6 deletions
diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index 0d0c03d8a..936bbb48b 100644
--- 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)
+
/*
* Instruction operation
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 46075c017..db6d0a722 100644
--- 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 838926f7a..51c418143 100644
--- 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 6c482b8d8..08e306c39 100644
--- 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)))