cs: add xify pass for JIT mode

The xify pass replaces local variable names with `x0`, `x1`, etc.
Using a minimal set of symbols makes the fasled form smaller
and typically take only 60-70% as long to read.

racket/src/cs/linklet.sls

@@ -401,7 +401,9 @@
                                          [(jit)
                                           ;; Preserve annotated `lambda` source for on-demand compilation:
                                           (lambda (expr arity-mask name)
-                                            (make-wrapped-code (correlated->annotation expr) arity-mask name))]
+                                            (make-wrapped-code (correlated->annotation (xify expr recorrelate))
+                                                               arity-mask
+                                                               name))]
                                          [else
                                           ;; Compile an individual `lambda`:
                                            (lambda (expr arity-mask name)

racket/src/cs/schemify.sls

@@ -2,6 +2,7 @@
   (export schemify-linklet
           lift-in-schemified-linklet
           jitify-schemified-linklet
+          xify
           interpretable-jitified-linklet
           interpret-linklet
           linklet-bigger-than?

racket/src/schemify/left-to-right.rkt

@@ -16,6 +16,9 @@
 (define (left-to-right/let ids rhss bodys
                            prim-knowns knowns imports mutated)
   (cond
+   [(null? ids) (if (null? (cdr bodys))
+                    (car bodys)
+                    `(begin . ,bodys))]
    [(null? (cdr ids))
     `(let ([,(car ids) ,(car rhss)]) . ,bodys)]
    [else

racket/src/schemify/main.rkt

@@ -3,6 +3,7 @@
          "known.rkt"
          "lift.rkt"
          "jitify.rkt"
+         "xify.rkt"
          "interpret.rkt"
          "size.rkt")
 
@@ -16,6 +17,8 @@
 
          jitify-schemified-linklet
 
+         xify
+
          interpretable-jitified-linklet
          interpret-linklet
 

racket/src/schemify/schemify.rkt

@@ -389,8 +389,16 @@
                 (if k
                     (hash-set knowns (unwrap id) k)
                     knowns)))
-            (left-to-right/let ids
+            (define (merely-a-copy? id)
-                               (for/list ([rhs (in-list rhss)])
+              (define u-id (unwrap id))
+              (and (known-copy? (hash-ref new-knowns u-id #f))
+                   (simple-mutated-state? (hash-ref mutated u-id #f))))
+            (left-to-right/let (for/list ([id (in-list ids)]
+                                          #:unless (merely-a-copy? id))
+                                 id)
+                               (for/list ([id (in-list ids)]
+                                          [rhs (in-list rhss)]
+                                          #:unless (merely-a-copy? id))
                                  (schemify rhs))
                                (for/list ([body (in-list bodys)])
                                  (schemify/knowns new-knowns inline-fuel body))

racket/src/schemify/xify.rkt

@@ -0,0 +1,134 @@
+#lang racket/base
+(require "wrap.rkt"
+         "match.rkt")
+
+;; Given a closed (except for primitives) `lambda` or
+;; `case-lambda` form `e`, replace every local variable
+;; with x<n> for the smallest number <n> that will work.
+
+(provide xify)
+
+(define (xify e reannotate)
+  (define (xify e env)
+    (reannotate
+     e
+     (match e
+       [`(lambda ,ids . ,body)
+        (define-values (new-ids new-env) (xify-ids ids env))
+        `(lambda ,new-ids . ,(xify-body body new-env))]
+       [`(case-lambda ,clauses ...)
+        `(case-lambda . ,(for/list ([clause (in-list clauses)])
+                           (cdr (xify (cons 'lambda clause) env))))]
+       [`(let ([,ids ,rhss] ...) . ,body)
+        (xify-let 'let ids rhss body env)]
+       [`(letrec ([,ids ,rhss] ...) . ,body)
+        (xify-let 'letrec ids rhss body env)]
+       [`(letrec* ([,ids ,rhss] ...) . ,body)
+        (xify-let 'letrec* ids rhss body env)]
+       [`(quote ,v) e]
+       ;; Although this next group could be covered by `xify-body`,
+       ;; they seem common enough to handle faster as special cases
+       [`(begin . ,body)
+        `(begin . ,(xify-body body env))]
+       [`(if ,tst ,thn ,els)
+        `(if ,(xify tst env) ,(xify thn env) ,(xify els env))]
+       [`(with-continuation-mark ,key ,val ,body)
+        `(with-continuation-mark ,(xify key env) ,(xify val env) ,(xify body env))]
+       [`(set! ,id ,rhs)
+        `(set! ,(xify id env) ,(xify rhs env))]
+       ;; Catch-all for other forms, which we can treat like applications
+       [`(,_ . ,_) (xify-body e env)]
+       [`,v
+        (define u-v (unwrap v))
+        (cond
+          [(symbol? u-v)
+           (define x (hash-ref env u-v #f))
+           (if x
+               (reannotate v x)
+               v)]
+          [else v])])))
+
+  (define (xify-body es env)
+    (for/list ([e (in-wrap-list es)])
+      (xify e env)))
+
+  (define (xify-let form ids rhss body env)
+    (define-values (new-ids new-env) (xify-ids ids env))
+    `(,form ,(for/list ([new-id (in-list new-ids)]
+                        [rhs (in-list rhss)])
+               `[,new-id ,(xify rhs (if (eq? form 'let) env new-env))])
+            . ,(xify-body body new-env)))
+
+  (define (xify-ids ids env)
+    (cond
+      [(pair? ids)
+       (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))))
+       (values (cons x rest-xs) rest-env)]
+      [(null? ids) (values '() env)]
+      [else
+       (define-values (xs new-env) (xify-ids (list ids) env))
+       (values (car xs) new-env)]))
+
+  (xify e #hasheq()))
+
+(module+ test
+  (define (reannotate old new) new)
+  (define-syntax-rule (test a b)
+    (let ([v a])
+      (unless (equal? v b) (error 'test "failed: ~s => ~e" 'a v))))
+  
+  (test (xify '(let ([apple 1]) apple) reannotate)
+        '(let ([x0 1]) x0))
+  (test (xify '(let ([apple 1] [banana 2]) apple) reannotate)
+        '(let ([x0 1] [x1 2]) x0))
+  (test (xify '(let ([apple 1]
+                     [banana 2])
+                 (let ([apple 1]
+                       [banana 2])
+                   apple))
+              reannotate)
+        '(let ([x0 1]
+               [x1 2])
+           (let ([x0 1]
+                 [x1 2])
+             x0)))
+  (test (xify '(+ (let ([apple 1]) apple)
+                  (let ([banana 2]) banana))
+              reannotate)
+        '(+ (let ([x0 1]) x0)
+            (let ([x0 2]) x0)))
+  (test (xify '(lambda (a b c)
+                 (list c b a))
+              reannotate)
+        '(lambda (x0 x1 x2)
+           (list x2 x1 x0)))
+  (test (xify '(case-lambda
+                 [(a b c) (list c b a)]
+                 [(x . y) (list x y)])
+              reannotate)
+        '(case-lambda
+           [(x0 x1 x2)
+            (list x2 x1 x0)]
+           [(x0 . x1) (list x0 x1)]))
+  (test (xify '(lambda (a b c)
+                 (if a
+                     (begin b c)
+                     (with-continuation-mark a b c))
+                 (set! a b)
+                 (list 'a 'b 'c 1 2 3)
+                 (#%app a b c))
+              reannotate)
+        '(lambda (x0 x1 x2)
+           (if x0
+               (begin x1 x2)
+               (with-continuation-mark x0 x1 x2))
+           (set! x0 x1)
+           (list 'a 'b 'c 1 2 3)
+           (#%app x0 x1 x2))))