Summary

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

Metadata

Description

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))])))))))

Changes and comments

[2018-07-23 09:48:54 UTC] sjamaan wrote:

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

[2018-07-23 13:56:33 UTC] megane wrote:

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.

[2018-07-23 14:06:15 UTC] sjamaan wrote:

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.