Skip to content
Snippets Groups Projects
Commit 89cf3b64 authored by toy's avatar toy
Browse files

Patch stolen from SBCL bug 81.

Loop doesn't handle loops like

(loop with (a b) = '(1 2)
      and (c d) = '(3 4)
      return (list a b c d))

correctly because it fails to destructure the variables correctly.
parent 1fe4bc46
No related branches found
No related tags found
No related merge requests found
;;; -*- Mode: LISP; Syntax: Common-lisp; Base: 10; Lowercase:T -*- ;;; -*- Mode: LISP; Package: ANSI-LOOP; Syntax: Common-lisp; Base: 10; Lowercase:T -*-
;;;> ;;;>
;;;> Portions of LOOP are Copyright (c) 1986 by the Massachusetts Institute of Technology. ;;;> Portions of LOOP are Copyright (c) 1986 by the Massachusetts Institute of Technology.
;;;> All Rights Reserved. ;;;> All Rights Reserved.
...@@ -49,7 +49,7 @@ ...@@ -49,7 +49,7 @@
#+cmu #+cmu
(ext:file-comment (ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/loop.lisp,v 1.9 2000/03/10 11:59:37 dtc Exp $") "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/loop.lisp,v 1.10 2001/10/04 13:21:45 toy Exp $")
;;;; LOOP Iteration Macro ;;;; LOOP Iteration Macro
...@@ -985,6 +985,12 @@ collected result will be returned as the value of the LOOP." ...@@ -985,6 +985,12 @@ collected result will be returned as the value of the LOOP."
(defun loop-build-destructuring-bindings (crocks forms)
(if crocks
`((destructuring-bind ,(car crocks) ,(cadr crocks)
,@(loop-build-destructuring-bindings (cddr crocks) forms)))
forms))
(defun loop-translate (*loop-source-code* *loop-macro-environment* *loop-universe*) (defun loop-translate (*loop-source-code* *loop-macro-environment* *loop-universe*)
(let ((*loop-original-source-code* *loop-source-code*) (let ((*loop-original-source-code* *loop-source-code*)
(*loop-source-context* nil) (*loop-source-context* nil)
...@@ -1035,10 +1041,7 @@ collected result will be returned as the value of the LOOP." ...@@ -1035,10 +1041,7 @@ collected result will be returned as the value of the LOOP."
(*loop-destructuring-hooks* (first *loop-destructuring-hooks*)) (*loop-destructuring-hooks* (first *loop-destructuring-hooks*))
(t 'let)) (t 'let))
,vars ,vars
,@(if crocks ,@(loop-build-destructuring-bindings crocks forms)))))))
`((destructuring-bind ,@crocks
,@forms))
forms)))))))
answer))) answer)))
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment