~ chicken-core (chicken-5) 32067934f3dbe6da17ae018187dfeb8a81567d7e

commit 32067934f3dbe6da17ae018187dfeb8a81567d7e
Author:     Peter Bex <peter@more-magic.net>
AuthorDate: Wed Dec 11 13:24:48 2019 +0100
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Thu Dec 12 12:50:12 2019 +0100

    Fix restoration of rest operations inside closures
    
    When a rest operation would have to be undone due to no longer having
    access to the original procedure's argvector and converted to a
    closure, the call would now need to access the variable from the
    closure.
    
    Bug found by Kon Lovett
    
    Signed-off-by: felix <felix@call-with-current-continuation.org>

diff --git a/core.scm b/core.scm
index 4623122b..39d0a8d1 100644
--- a/core.scm
+++ b/core.scm
@@ -2636,9 +2636,10 @@
 		 val) ) )
 
 	  ((##core#rest-cdr ##core#rest-car ##core#rest-null? ##core#rest-length)
-	   (let* ((rest-var (first params))
-		  (val (ref-var n here closure)))
-	     (unless (eq? val n)
+	   (let* ((val (ref-var n here closure))
+		  (rest-var (if (eq? val n) (varnode (first params)) val)))
+	     (unless (or (eq? val n)
+			 (match-node val `(##core#ref (i) (##core#variable (,here))) '(i)))
 	       ;; If it's captured, replacement in optimizer was incorrect
 	       (bomb "Saw rest op for captured variable.  This should not happen!" class) )
 	     ;; If rest-cdrs have not all been eliminated, restore
@@ -2647,30 +2648,37 @@
 	     ;; many more cdr calls than necessary.
 	     (cond ((eq? class '##core#rest-cdr)
 		    (let lp ((cdr-calls (add1 (second params)))
-			     (var (varnode rest-var)))
+			     (var rest-var))
 		      (if (zero? cdr-calls)
 			  (transform var here closure)
 			  (lp (sub1 cdr-calls)
 			      (make-node '##core#inline (list "C_i_cdr") (list var))))))
+
 		   ;; If customizable, the list is consed up at the
 		   ;; call site and there is no argvector.  So convert
 		   ;; back to list-ref/list-tail calls.
-		   ((and (eq? class '##core#rest-car)
-			 (test here 'customizable))
-		    (transform (make-node '##core#inline
-					  (list "C_i_list_ref")
-					  (list (varnode rest-var) (second params))) here closure))
-		   ((and (eq? class '##core#rest-null)
-			 (test here 'customizable))
-		    (transform (make-node '##core#inline
-					  (list "C_i_greater_or_equal_p")
-					  (list (qnode (second params))
-						(make-node '##core#inline (list "C_i_length") (list (varnode rest-var))))) here closure))
-		   ((and (eq? class '##core#rest-length)
-			 (test here 'customizable))
-		    (transform (make-node '##core#inline
-					  (list "C_i_length")
-					  (list (varnode rest-var) (second params))) here closure))
+		   ;;
+		   ;; Alternatively, if n isn't val, this node was
+		   ;; processed and the variable got replaced by a
+		   ;; closure access.
+		   ((or (test here 'customizable)
+			(not (eq? val n)))
+		    (case class
+		      ((##core#rest-car)
+		       (transform (make-node '##core#inline
+					     (list "C_i_list_ref")
+					     (list rest-var (qnode (second params)))) here closure))
+		      ((##core#rest-null)
+		       (transform (make-node '##core#inline
+					     (list "C_i_greater_or_equal_p")
+					     (list (qnode (second params))
+						   (make-node '##core#inline (list "C_i_length") (list rest-var)))) here closure))
+		      ((##core#rest-length)
+		       (transform (make-node '##core#inline
+					     (list "C_i_length")
+					     (list rest-var (qnode (second params)))) here closure))
+		      (else (bomb "Unknown rest op node class in while converting to closure. This shouldn't happen!" class))))
+
 		   (else val)) ) )
 
 	  ((if ##core#call ##core#inline ##core#inline_allocate ##core#callunit
@@ -2799,6 +2807,8 @@
 		      (list (qnode (##sys#make-lambda-info (car params))))
 		      '() ) ) ) )
 
+	  ((##core#ref) n)
+
 	  (else (bomb "bad node (closure2)")) ) ) )
 
     (define (maptransform xs here closure)