mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-17 09:10:22 +02:00
fix bug in self-tail-recursion with "external" variables; other sundries
* gdbinit (pp, inst): New commands. * libguile/vm-engine.c (vm_error_not_a_pair): New error case. * libguile/vm-i-scheme.c (VM_VALIDATE_CONS): New macro -- use this instead of SCM_VALIDATE_* because SCM_VALIDATE will exit nonlocally before we have a chance to sync the regs. (car, cdr, set-car, set-cdr): Use VM_VALIDATE_CONS. * libguile/vm-i-system.c (goto/args): Bugfix: when doing a self-tail-recursion, allocate fresh externals. Fixes use of match.go. * module/system/vm/assemble.scm (dump-object!): Add some checks that we aren't dumping out values that the VM can't handle. * module/system/vm/disasm.scm (disassemble-externals): Fix rotten call to `print-info'. * oop/goops/dispatch.scm: Add a FIXME. * testsuite/Makefile.am (vm_test_files): * testsuite/t-closure4.scm (extract-symbols): New test, distilled with much effort out of match.scm. * ice-9/Makefile.am (NOCOMP_SOURCES): Re-enable compilation of match.scm. Yay!
This commit is contained in:
parent
b3b45ac15e
commit
5e390de62f
10 changed files with 66 additions and 12 deletions
|
@ -11,6 +11,7 @@ vm_test_files = \
|
|||
t-closure.scm \
|
||||
t-closure2.scm \
|
||||
t-closure3.scm \
|
||||
t-closure4.scm \
|
||||
t-do-loop.scm \
|
||||
t-macros.scm \
|
||||
t-macros2.scm \
|
||||
|
|
22
testsuite/t-closure4.scm
Normal file
22
testsuite/t-closure4.scm
Normal file
|
@ -0,0 +1,22 @@
|
|||
(define (extract-symbols exp)
|
||||
(define (process x out cont)
|
||||
(cond ((pair? x)
|
||||
(process (car x)
|
||||
out
|
||||
(lambda (car-x out)
|
||||
;; used to have a bug here whereby `x' was
|
||||
;; modified in the self-tail-recursion to (process
|
||||
;; (cdr x) ...), because we didn't allocate fresh
|
||||
;; externals when doing self-tail-recursion.
|
||||
(process (cdr x)
|
||||
out
|
||||
(lambda (cdr-x out)
|
||||
(cont (cons car-x cdr-x)
|
||||
out))))))
|
||||
((symbol? x)
|
||||
(cont x (cons x out)))
|
||||
(else
|
||||
(cont x out))))
|
||||
(process exp '() (lambda (x out) out)))
|
||||
|
||||
(extract-symbols '(a b . c))
|
Loading…
Add table
Add a link
Reference in a new issue