From cf0b38aee9107f39a0ee1bee4a6d45951e603336 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 22 Jun 2018 11:04:00 -0600
Subject: [PATCH] cs: drop unused correlation early

The improvements reported in 74012f8c57 were actually due to a broken
experiment that dropped source locations on application forms, instead
of preserving them in marshaled code. Adjust the expansion pipeline
to do that earlier and intentionally.

The xify pas doesn't help all that much after all, but it's still more
comfortable to be independent of local-variable names.
---
 racket/src/cs/expander.sls                |  3 ++-
 racket/src/cs/linklet.sls                 |  3 ++-
 racket/src/cs/main.sps                    |  6 +++++-
 racket/src/expander/compile/correlate.rkt | 12 ++++++++++--
 racket/src/expander/main.rkt              |  6 +++++-
 racket/src/schemify/xify.rkt              |  6 +-----
 6 files changed, 25 insertions(+), 11 deletions(-)

diff --git a/racket/src/cs/expander.sls b/racket/src/cs/expander.sls
index ffa07ca153..f38079df98 100644
--- a/racket/src/cs/expander.sls
+++ b/racket/src/cs/expander.sls
@@ -4,7 +4,8 @@
           load-on-demand-enabled
           call-in-main-thread
           version
-          exit)
+          exit
+          compile-keep-source-locations!)
   (import (except (chezpart)
                   syntax->datum
                   datum->syntax)
diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls
index 3663dc5428..8efb00a489 100644
--- a/racket/src/cs/linklet.sls
+++ b/racket/src/cs/linklet.sls
@@ -43,6 +43,7 @@
           compiled-position->primitive
           primitive-in-category?
 
+          omit-debugging?             ; not exported to racket
           platform-independent-zo-mode? ; not exported to racket
           linklet-performance-init!   ; not exported to racket
           linklet-performance-report! ; not exported to racket
@@ -276,7 +277,7 @@
                (wrapped-code-content-set! wc f)
                f)]
             [else
-             (let* ([f (compile* (wrapped-code-content wc))])
+             (let ([f (compile* f)])
                (when jit-demand-on?
                  (show "JIT demand" (strip-nested-annotations (wrapped-code-content wc))))
                (wrapped-code-content-set! wc f)
diff --git a/racket/src/cs/main.sps b/racket/src/cs/main.sps
index 74d77bff2a..2421139124 100644
--- a/racket/src/cs/main.sps
+++ b/racket/src/cs/main.sps
@@ -25,16 +25,20 @@
                module->language-info
                module-path-index-join
                version
-               exit)
+               exit
+               compile-keep-source-locations!)
          (regexp)
          (io)
          (thread)
          (only (linklet)
+               omit-debugging?
                platform-independent-zo-mode?
                linklet-performance-init!
                linklet-performance-report!))
 
  (linklet-performance-init!)
+ (unless omit-debugging?
+   (compile-keep-source-locations! #t))
 
  (define the-command-line-arguments
    (or (and (top-level-bound? 'bytes-command-line-arguments)
diff --git a/racket/src/expander/compile/correlate.rkt b/racket/src/expander/compile/correlate.rkt
index 8e146a6d1c..483b7c9f42 100644
--- a/racket/src/expander/compile/correlate.rkt
+++ b/racket/src/expander/compile/correlate.rkt
@@ -12,7 +12,11 @@
 (provide correlate*
          correlate~
          correlate/app
-         ->correlated)
+         ->correlated
+
+         compile-keep-source-locations!)
+
+(define keep-source-locations? #f)
 
 (define (correlate* stx s-exp)
   (if (syntax-srcloc stx)
@@ -26,9 +30,13 @@
   s-exp)
 
 (define (correlate/app stx s-exp)
-  (if (eq? (system-type 'vm) 'chez-scheme)
+  (if keep-source-locations?
       (correlate* stx s-exp)
       (correlate~ stx s-exp)))
 
 (define (->correlated s)
   (datum->correlated s #f))
+
+
+(define (compile-keep-source-locations! on?)
+  (set! keep-source-locations? on?))
diff --git a/racket/src/expander/main.rkt b/racket/src/expander/main.rkt
index 99cba313db..db57947b31 100644
--- a/racket/src/expander/main.rkt
+++ b/racket/src/expander/main.rkt
@@ -18,6 +18,8 @@
          "namespace/core.rkt"
          "namespace/primitive-module.rkt"
          "expand/missing-module.rkt"
+         (only-in "compile/correlate.rkt"
+                  compile-keep-source-locations!)
          "boot/kernel.rkt"
          "boot/read-primitive.rkt"
          "boot/main-primitive.rkt"
@@ -104,7 +106,9 @@
          declare-primitive-module! ; to support "extensions"
 
          embedded-load ; for -k
-         
+
+         compile-keep-source-locations! ; to enable if the back end wants them
+
          ;; This functions are provided for basic testing
          ;; (such as "demo.rkt")
          syntax? syntax-e
diff --git a/racket/src/schemify/xify.rkt b/racket/src/schemify/xify.rkt
index 34de2562a1..c2dbe444dc 100644
--- a/racket/src/schemify/xify.rkt
+++ b/racket/src/schemify/xify.rkt
@@ -65,11 +65,7 @@
        (define u-id (unwrap (car ids)))
        (define x (or (hash-ref env u-id #f)
                      (string->symbol (string-append "x" (number->string (hash-count env))))))
-       (define-values (rest-xs rest-env) (xify-ids (cdr ids)
-                                                   (if (and (eq? x u-id)
-                                                            (not (hash-ref env u-id #f)))
-                                                       env
-                                                       (hash-set env u-id x))))
+       (define-values (rest-xs rest-env) (xify-ids (cdr ids) (hash-set env u-id x)))
        (values (cons x rest-xs) rest-env)]
       [(null? ids) (values '() env)]
       [else