suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

cs: add xify pass for JIT mode

Browse Source 
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.
This commit is contained in:
Matthew Flatt 2018-06-22 09:37:55 -06:00
parent d8832723e9
commit 74012f8c57
6 changed files with 155 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/src/cs/linklet.sls
View File

@ -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)

1
racket/src/cs/schemify.sls
View File

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

3
racket/src/schemify/left-to-right.rkt
View File

@ -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

3
racket/src/schemify/main.rkt
View File

@ -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

12
racket/src/schemify/schemify.rkt
View File

@ -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))

134
racket/src/schemify/xify.rkt Normal file
View File

@ -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))))