mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-05-17 22:52:25 +02:00
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.
This commit is contained in:
parent
887ce75ae8
commit
2bd859c81a
4 changed files with 31 additions and 6 deletions
|
@ -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
|
||||
|
|
|
@ -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 ();
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue