dyoo / whalesong

Whalesong: Racket to JavaScript compiler
http://hashcollision.org/whalesong
250 stars 30 forks source link

soundness error with values #48

Closed dyoo closed 13 years ago

dyoo commented 13 years ago

There's something about the following macro that is being miscompiled. This is a high-priority thing to fix!

Context: trying to compile the signature implementation in the cs019 language. For some reason, the constructor name gets bound to the first selector name. It's like I'm off by one somewhere, which is very bad.

(define-syntax (define-struct: stx) (syntax-case stx (:) [(_ sn ([f : S] ...)) (with-syntax ([(names ...) (build-struct-names #'sn (syntax->list #'(f ...))

f #f)]

               [term-srcloc (syntax-srcloc stx)]
               [(S ...) (parse-sigs #'(S ...))])
   (with-syntax ([(S-srcloc ...) (map syntax-srcloc (syntax->list #'(S ...)))]
                 [sig-name (datum->syntax #'sn
                                          (string->symbol
                                           (string-append
                                            (symbol->string
                                             (syntax->datum #'sn))
                                            "$")))]
                 [cnstr (syntax-case #'(names ...) ()
                          [(struct:name-id constructor misc ...)
                           #'constructor])]
                 [(_sid _ctr _id? setters ...)
                  (build-struct-names #'sn
                                      (syntax->list #'(f ...))
                                      #t #f)]
                 [pred (syntax-case #'(names ...) ()
                         [(struct:name-id const predicate misc ...)
                          #'predicate])])
     #'(begin
         (define-values (names ...)
           (let ()
             (begin
               (define-struct sn (f ...) #:transparent #:mutable)
               (let ([cnstr 
                      (lambda (f ...)
                        (let ([wrapped-args
                               (let loop ([sigs (list S ... )]
                                          [args (list f ...)]
                                          [sig-srclocs (list S-srcloc ...)]
                                          [n 1])
                                 (if (null? sigs)
                                     '()
                                     (cons (wrap (car sigs) 
                                                 (car args)
                                                 (car sig-srclocs))
                                           (loop (cdr sigs) 
                                                 (cdr args)
                                                 (cdr sig-srclocs)
                                                 (add1 n)))))])
                          (apply cnstr wrapped-args)))]
                     [setters
                      (lambda (struct-inst new-val)
                        (setters struct-inst (wrap S new-val S-srcloc)))]
                     ...)
                 (values names ...)))))
         ;; This could be a define below, but it's a define-values
         ;; due to a bug in ISL's local.  See users@racket-lang.org
         ;; thread, 2011-09-03, "splicing into local".  Should not
         ;; be necessary with next release.
         (define-values (sig-name) 
           (first-order-sig pred term-srcloc)))))]))
dyoo commented 13 years ago

Isolated. branch tail-call-bug (starting at e4f9481bc1736c2c3fca6defff5f8e8e89893374). Fixing now.

dyoo commented 13 years ago

Issue corrected in d2eb1dea77b0e210a48895d45cbfd1c4ce2b6e27. Bug involved let1 not properly routing around values when it is popping its stack space off. Used the same code that letvoid uses; I need to go back later and refactor this code, because it's a copy-and-paste.

However, another bug is showing up with the conform test case. Looking at this now.

dyoo commented 13 years ago

Got it. Closing bug. But I really do need to look at the compiler at some point and clean the code up: I have to admit that I don't completely understand it anymore... :(