diff options
author | Mark H Weaver <mhw@netris.org> | 2012-01-14 04:28:16 -0500 |
---|---|---|
committer | Mark H Weaver <mhw@netris.org> | 2012-01-14 04:39:00 -0500 |
commit | c5f6c2e47fab220fd090d911efc2a71a563b7c1d (patch) | |
tree | 5f9e3b295f74eb484fd190768544015d18181aba | |
parent | 39eb0b7297a0e5baad5d3dc34068c854fa4c0c8b (diff) | |
download | guile-c5f6c2e47fab220fd090d911efc2a71a563b7c1d.tar.gz |
Don't diverge when serializing cyclic lists during compilation
* module/language/glil/compile-assembly.scm (scheme-list?): Don't
diverge when serializing cyclic lists.
-rw-r--r-- | module/language/glil/compile-assembly.scm | 8 |
1 files changed, 5 insertions, 3 deletions
diff --git a/module/language/glil/compile-assembly.scm b/module/language/glil/compile-assembly.scm index 997f7c78d..a51fd580a 100644 --- a/module/language/glil/compile-assembly.scm +++ b/module/language/glil/compile-assembly.scm @@ -106,9 +106,11 @@ ;; This tests for a proper scheme list whose last cdr is '(), not #nil. ;; (define (scheme-list? x) - (or (eq? x '()) - (and (pair? x) - (scheme-list? (cdr x))))) + (and (list? x) + (or (eq? x '()) + (let ((p (last-pair x))) + (and (pair? p) + (eq? (cdr p) '())))))) ;; Note: in all of these procedures that build up constant tables, the ;; first (zeroth) index is reserved. At runtime it is replaced with the |