##sys#expand-multiple-values-assignment works for some reason

[megane]

Replace the original with this. I have only added the print and the import.

(import chicken.type)
(define (##sys#expand-multiple-values-assignment formals expr)
  (##sys#decompose-lambda-list
   formals
   (lambda (vars argc rest)
     (let ((aliases    (if (symbol? formals) '() (map gensym formals)))
           (rest-alias (if (not rest) '() (gensym rest))))
       (print "formals: " formals
              " list?: "(list? (the * formals))
              " aliases: " aliases
              " rest " rest-alias)
       `(##sys#call-with-values
         (##core#lambda () ,expr)
         (##core#lambda
          ,(append aliases rest-alias)
          ,@(map (lambda (v a) `(##core#set! ,v ,a)) vars aliases)
          ,@(cond
              ((null? formals) '((##core#undefined)))
              ((null? rest-alias) '())
              (else `((##core#set! ,rest ,rest-alias))))))))))

Now check the output of this. Pay attention to the (d . e) case. It's not a list, but somehow the (map gensym formals) expression runs without errors.

(let ([e '(0 1 2 3 (4) (5 6))]
      [r (letrec-values ((() (values))
                         ((a) (values 0))
                         ((b c) (values 1 2))
                         ((d . e) (values 3 4))
                         (f (values 5 6)))
                        (list a b c d e f))])
  (print e)
  (print r)
  (assert (equal? e r)))

-->
$ csc ../letrecvalues.scm && ../letrecvalues
formals: () list?: #t aliases: () rest ()
formals: (a) list?: #t aliases: (a11) rest ()
formals: (b c) list?: #t aliases: (b12 c13) rest ()
formals: (d . e) list?: #f aliases: (d14) rest e15
formals: f list?: #f aliases: () rest f16
(0 1 2 3 (4) (5 6))
(0 1 2 3 (4) (5 6))

I think the correct implementation is something more like this:

(define (##sys#expand-multiple-values-assignment formals expr)
  (##sys#decompose-lambda-list
   formals
   (lambda (vars argc rest)
     (let* ((aliases    (if (symbol? formals) '() (map gensym vars)))
	    (rest-alias (and rest (gensym rest))))
       `(##sys#call-with-values
	 (##core#lambda () ,expr)
	 (##core#lambda
	  ,(cond
	    [(symbol? formals) rest-alias]
	    [(and rest (null? (cdr vars))) rest-alias]
	    [(null? aliases) aliases]
	    [rest (let lp ([vs aliases])
		    (if (null? (cdr vs))
			(car vs)
			(cons (car vs) (lp (cdr vs)))))]
	    [else aliases])
	  ,@(map (lambda (v a) `(##core#set! ,v ,a)) vars aliases)
	  ,@(cond
	     [(symbol? formals) `((##core#set! ,rest ,rest-alias))]
	     [else '((begin))])))))))

[sjamaan]

This is probably because the compiler syntax for "map" optimization which loops until it sees a non-pair. See compiler-syntax.scm

[megane]

Indeed that was the reason. I was compiling the compiler with -optimize-level 0. Maybe a comment about relying on compiler syntax here would be a good idea.

[sjamaan]

I don't think it's correct to rely on compiler syntax, is it?

If for whatever reason the code is recompiled without compiler syntax (which should happen if we ever do another module rearrangement) it might suddenly break.