Opened 14 months ago

Last modified 14 months ago

#1491 new defect

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

Reported by: megane Owned by:
Priority: minor Milestone: someday
Component: expander Version: 5.0.0
Keywords: Cc:
Estimated difficulty: medium

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

Change History (3)

comment:1 Changed 14 months ago by sjamaan

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

comment:2 Changed 14 months ago by 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.

comment:3 Changed 14 months ago by 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.

Note: See TracTickets for help on using tickets.