tail returns and complex stuff

main.rkt

@@ -123,6 +123,15 @@
     (define s2 (regexp-replace* #rx"[^A-Za-z0-9_$]" s1 "_"))
     (if (regexp-match? #rx"^[A-Za-z_$]" s2) s2 (string-append "_" s2)))
 
+  (define (dot-prop-symbol? x)
+    (and (symbol? x)
+         (let ([s (symbol->string x)])
+           (and (> (string-length s) 1)
+                (char=? (string-ref s 0) #\.)))))
+
+  (define (dot-prop->js x)
+    (prop->js (string->symbol (substring (symbol->string x) 1))))
+
   (define (compile-assignment-target target)
     (match target
       [(? symbol?) (id->js target)]
@@ -398,6 +407,14 @@
        (format "if (~a) ~a\nreturn undefined;" (compile-expr c) (block (compile-body body)))]
       [(list 'unless c body ...)
        (format "if (!(~a)) ~a\nreturn undefined;" (compile-expr c) (block (compile-body body)))]
+      [(list 'set! _ ...)
+       (join-lines (list (compile-stmt d) "return undefined;"))]
+      [(list 'vector-set! _ ...)
+       (join-lines (list (compile-stmt d) "return undefined;"))]
+      [(list 'set-prop! _ ...)
+       (join-lines (list (compile-stmt d) "return undefined;"))]
+      [(list 'delete-prop! _ ...)
+       (join-lines (list (compile-stmt d) "return undefined;"))]
       [_ (format "return ~a;" (compile-expr d))]))
 
   (define (compile-stmt d)
@@ -414,6 +431,8 @@
        (format "let ~a = ~a;" (id->js id) (compile-expr rhs))]
       [(list 'define-values ids rhs)
        (format "let [~a] = ~a;" (compile-arg-list ids) (compile-expr rhs))]
+      [(list 'set! obj (? dot-prop-symbol? prop) rhs)
+       (format "~a.~a = ~a;" (compile-expr obj) (dot-prop->js prop) (compile-expr rhs))]
       [(list 'set! target rhs)
        (format "~a = ~a;" (compile-assignment-target target) (compile-expr rhs))]
       [(list 'return)
@@ -1383,6 +1402,8 @@ if (~a !== false) return ~a;" tmp (compile-expr arg) tmp tmp)))
        (parens (compile-delete-target obj key))]
       [(list 'set-prop! obj key val)
        (format "(~a[~a] = ~a)" (compile-expr obj) (compile-expr key) (compile-expr val))]
+      [(list 'set! obj (? dot-prop-symbol? prop) rhs)
+       (format "(~a.~a = ~a)" (compile-expr obj) (dot-prop->js prop) (compile-expr rhs))]
       [(list 'set! target rhs)
        (format "(~a = ~a)" (compile-assignment-target target) (compile-expr rhs))]
       [(list 'return) "undefined"]
@@ -1392,8 +1413,26 @@ if (~a !== false) return ~a;" tmp (compile-expr arg) tmp tmp)))
       [(list f args ...) (compile-call f args)]
       [_ (literal->js d)]))
 
+  (define (top-tail-returnable? d)
+    (match d
+      [(list 'define _ ...) #f]
+      [(list 'define-values _ ...) #f]
+      [(list 'define-class _ ...) #f]
+      [(list 'set! _ ...) #f]
+      [(list 'vector-set! _ ...) #f]
+      [(list 'set-prop! _ ...) #f]
+      [(list 'delete-prop! _ ...) #f]
+      [(list 'while _ ...) #f]
+      [(list 'for _ ...) #f]
+      [_ #t]))
+
   (define (compile-top forms)
-    (compile-body forms #:return-last? #f)))
+    (cond
+      [(null? forms) ""]
+      [(top-tail-returnable? (last forms))
+       (compile-body forms #:return-last? #t)]
+      [else
+       (compile-body forms #:return-last? #f)])))
 
 (define-syntax (js stx)
   (syntax-case stx ()