diff options
author | Andy Wingo <wingo@pobox.com> | 2008-09-30 23:41:16 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2008-09-30 23:41:16 +0200 |
commit | 2bd859c81ac55b8f229778b0fff23a35b0d6e904 (patch) | |
tree | 74f7bd1ba7b7470b6e56fc5e20e1d49bc3c7e093 | |
parent | 887ce75ae828fabd9a76d8e719bd3070c334eb44 (diff) | |
download | guile-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.h | 13 | ||||
-rw-r--r-- | libguile/vm-i-system.c | 6 | ||||
-rw-r--r-- | module/system/il/compile.scm | 13 | ||||
-rw-r--r-- | testsuite/t-quasiquote.scm | 5 |
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))) |