From 74012f8c579e630e7e7f16e3f5621fff14963cf7 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 22 Jun 2018 09:37:55 -0600 Subject: [PATCH] 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 | 6 +- racket/src/cs/schemify.sls | 1 + racket/src/schemify/left-to-right.rkt | 3 + racket/src/schemify/main.rkt | 3 + racket/src/schemify/schemify.rkt | 12 ++- racket/src/schemify/xify.rkt | 134 ++++++++++++++++++++++++++ 6 files changed, 155 insertions(+), 4 deletions(-) create mode 100644 racket/src/schemify/xify.rkt diff --git a/racket/src/cs/linklet.sls b/racket/src/cs/linklet.sls index 454d93b6be..3663dc5428 100644 --- a/racket/src/cs/linklet.sls +++ b/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) @@ -1197,7 +1199,7 @@ s (cons a d)))] [else s])) - + ;; -------------------------------------------------- (define compile-enforce-module-constants diff --git a/racket/src/cs/schemify.sls b/racket/src/cs/schemify.sls index 6758675837..fa52f9f1c1 100644 --- a/racket/src/cs/schemify.sls +++ b/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? diff --git a/racket/src/schemify/left-to-right.rkt b/racket/src/schemify/left-to-right.rkt index 24c7a6a856..12b5ea53eb 100644 --- a/racket/src/schemify/left-to-right.rkt +++ b/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 diff --git a/racket/src/schemify/main.rkt b/racket/src/schemify/main.rkt index 5316b8fda7..1717306c9d 100644 --- a/racket/src/schemify/main.rkt +++ b/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 diff --git a/racket/src/schemify/schemify.rkt b/racket/src/schemify/schemify.rkt index f6f2526698..57ffb71512 100644 --- a/racket/src/schemify/schemify.rkt +++ b/racket/src/schemify/schemify.rkt @@ -389,8 +389,16 @@ (if k (hash-set knowns (unwrap id) k) knowns))) - (left-to-right/let ids - (for/list ([rhs (in-list rhss)]) + (define (merely-a-copy? id) + (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)) diff --git a/racket/src/schemify/xify.rkt b/racket/src/schemify/xify.rkt new file mode 100644 index 0000000000..34de2562a1 --- /dev/null +++ b/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 for the smallest number 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))))