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

schemify: remove reannotate arguments

Browse Source 
Passing them in instead of direct access to `datum->correlated` was a
holdover from the old setup that schemified directly to annotations.
This commit is contained in:
Matthew Flatt 2018-06-22 16:32:12 -06:00
parent 5bb837661c
commit ec036a0f5f
9 changed files with 69 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
racket/src/cs/convert.rkt
View File

@ -124,12 +124,12 @@
(printf "Schemify...\n")
(define body
(time
(schemify-body bodys/constants-lifted (lambda (old-v new-v) new-v) prim-knowns #hasheq() #hasheq() for-cify? unsafe-mode?)))
(schemify-body bodys/constants-lifted prim-knowns #hasheq() #hasheq() for-cify? unsafe-mode?)))
(printf "Lift...\n")
;; Lift functions to aviod closure creation:
(define lifted-body
(time
(lift-in-schemified-body body (lambda (old new) new))))
(lift-in-schemified-body body)))
(append (for/list ([p (in-list lifted-constants)])
(cons 'define p))
lifted-body)))

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

@ -375,7 +375,6 @@
jitify-mode?
(|#%app| compile-allow-set!-undefined)
#f ;; safe mode
recorrelate
prim-knowns
;; Callback to get a specific linklet for a
;; given import:
@ -383,8 +382,7 @@
(lookup-linklet-or-instance get-import key))
import-keys))
(define impl-lam/lifts
(lift-in-schemified-linklet (show pre-lift-on? "pre-lift" impl-lam)
recorrelate))
(lift-in-schemified-linklet (show pre-lift-on? "pre-lift" impl-lam)))
(define impl-lam/jitified
(cond
[(not jitify-mode?) impl-lam/lifts]
@ -404,7 +402,7 @@
[(jit)
;; Preserve annotated `lambda` source for on-demand compilation:
(lambda (expr arity-mask name)
(make-wrapped-code (correlated->annotation (xify expr recorrelate))
(make-wrapped-code (correlated->annotation (xify expr))
arity-mask
name))]
[else
@ -416,8 +414,7 @@
(show lambda-on? "lambda" (correlated->annotation expr)))])
(if serializable?
(make-wrapped-code code arity-mask name)
code))))])
recorrelate)]))
code))))]))]))
(define impl-lam/interpable
(let ([impl-lam (case (and jitify-mode?
linklet-compilation-mode)
@ -1140,13 +1137,6 @@
;; --------------------------------------------------
(define (recorrelate old-term new-term)
(if (correlated? old-term)
(datum->correlated #f new-term old-term)
new-term))
;; --------------------------------------------------
(define (correlated->annotation v)
(let-values ([(e stripped-e) (correlated->annotation* v)])
e))

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

@ -9,11 +9,13 @@
prim-knowns
known-procedure
a-known-constant)
(import (chezpart)
(import (except (chezpart)
datum->syntax)
(rename (rumble)
[correlated? rumble:correlated?]
[correlated-e rumble:correlated-e]
[correlated-property rumble:correlated-property])
[correlated-property rumble:correlated-property]
[datum->correlated rumble:datum->correlated])
(regexp)
(io))
@ -26,13 +28,15 @@
;; directly, instead:
(hash 'syntax? rumble:correlated?
'syntax-e rumble:correlated-e
'syntax-property rumble:correlated-property)]
'syntax-property rumble:correlated-property
'datum->syntax rumble:datum->correlated)]
[else #f]))
;; For direct access by schemified schemify:
(define syntax? rumble:correlated?)
(define syntax-e rumble:correlated-e)
(define syntax-property rumble:correlated-property)
(define datum->syntax rumble:datum->correlated)
(include "include.ss")
(include-generated "schemify.scm")

50
racket/src/schemify/inline.rkt
View File

@ -43,7 +43,7 @@
;; All binding identifiers in a clone must be fresh to stay consistent
;; with the unique-variable invariant of expanded/schemified form.
(define (inline-clone k im add-import! mutated imports reannotate)
(define (inline-clone k im add-import! mutated imports)
(define env (if (known-procedure/can-inline/need-imports? k)
;; The `needed->env` setup can fail if a needed
;; import cannot be made available:
@ -56,12 +56,12 @@
(match (known-procedure/can-inline-expr k)
[`(lambda ,args . ,bodys)
(define-values (new-args new-env) (clone-args args env mutated))
`(lambda ,new-args . ,(clone-body bodys new-env mutated reannotate))]
`(lambda ,new-args . ,(clone-body bodys new-env mutated))]
[`(case-lambda [,argss . ,bodyss] ...)
`(case-lambda ,@(for/list ([args (in-list argss)]
[bodys (in-list bodyss)])
(define-values (new-args new-env) (clone-args args env mutated))
`[,new-args . ,(clone-body bodys new-env mutated reannotate)]))]
`[,new-args . ,(clone-body bodys new-env mutated)]))]
[`,id
;; We expect `id` to refer to an imported variable, where inlining the
;; imported variable will need to pull from there
@ -70,7 +70,7 @@
=> (lambda (im)
(define i-k (import-lookup im))
(and (known-procedure/can-inline? i-k)
(inline-clone i-k im add-import! mutated imports reannotate)))]
(inline-clone i-k im add-import! mutated imports)))]
[else #f])])))
;; Build a mapping from ids in the expr to imports into the current
@ -111,11 +111,11 @@
(cdr (car env))]))
env))
(define (clone-body l env mutated reannotate)
(define (clone-body l env mutated)
(for/list ([e (in-wrap-list l)])
(clone-expr e env mutated reannotate)))
(clone-expr e env mutated)))
(define (clone-let v env mutated reannotate)
(define (clone-let v env mutated)
(match v
[`(,let-id ([,idss ,rhss] ...) ,bodys ...)
(define-values (rev-new-idss new-env)
@ -124,41 +124,41 @@
(values (cons new-ids rev-new-idss) new-env)))
`(,let-id ,(for/list ([ids (in-list (reverse rev-new-idss))]
[rhs (in-list rhss)])
`[,ids ,(clone-expr rhs new-env mutated reannotate)])
. ,(clone-body bodys new-env mutated reannotate))]))
`[,ids ,(clone-expr rhs new-env mutated)])
. ,(clone-body bodys new-env mutated))]))
(define (clone-expr v env mutated reannotate)
(define (clone-expr v env mutated)
(reannotate
v
(match v
[`(lambda ,args . ,bodys)
`(lambda ,args . ,(clone-body bodys env mutated reannotate))]
`(lambda ,args . ,(clone-body bodys env mutated))]
[`(case-lambda [,argss . ,bodyss] ...)
`(case-lambda ,@(for/list ([args (in-list argss)]
[bodys (in-list bodyss)])
`[,args . ,(clone-body bodys env mutated reannotate)]))]
`[,args . ,(clone-body bodys env mutated)]))]
[`(quote ,_) v]
[`(let-values . ,_) (clone-let v env mutated reannotate)]
[`(letrec-values . ,_) (clone-let v env mutated reannotate)]
[`(let-values . ,_) (clone-let v env mutated)]
[`(letrec-values . ,_) (clone-let v env mutated)]
[`(if ,tst ,thn ,els)
`(if ,(clone-expr tst env mutated reannotate)
,(clone-expr thn env mutated reannotate)
,(clone-expr els env mutated reannotate))]
`(if ,(clone-expr tst env mutated)
,(clone-expr thn env mutated)
,(clone-expr els env mutated))]
[`(with-continuation-mark ,key ,val ,body)
`(with-continuation-mark ,(clone-expr key env mutated reannotate)
,(clone-expr val env mutated reannotate)
,(clone-expr body env mutated reannotate))]
`(with-continuation-mark ,(clone-expr key env mutated)
,(clone-expr val env mutated)
,(clone-expr body env mutated))]
[`(begin ,exps ...)
`(begin . ,(clone-body exps env mutated reannotate))]
`(begin . ,(clone-body exps env mutated))]
[`(begin0 ,exps ...)
`(begin0 . ,(clone-body exps env mutated reannotate))]
`(begin0 . ,(clone-body exps env mutated))]
[`(set! ,id ,rhs)
`(set! ,id ,(clone-expr rhs env mutated reannotate))]
`(set! ,id ,(clone-expr rhs env mutated))]
[`(#%variable-reference) v]
[`(#%variable-reference ,id)
`(#%variable-reference ,(clone-expr id env mutated reannotate))]
`(#%variable-reference ,(clone-expr id env mutated))]
[`(,rator . ,_)
(clone-body v env mutated reannotate)]
(clone-body v env mutated)]
[`,_
(let ([u-v (unwrap v)])
(cond

6
racket/src/schemify/jitify.rkt
View File

@ -37,8 +37,7 @@
need-extract?
need-lift?
convert-size-threshold ; #f or a number; see above
extractable-annotation
reannotate)
extractable-annotation)
;; Constucts a closed `lambda` form as wrapped with
;; `extractable-annotaton` and generates an application of
@ -872,5 +871,4 @@
#t
#t ; need-lift?
#f ; size threshold
wrapped
(lambda (v u) u))))
wrapped)))

10
racket/src/schemify/lift.rkt
View File

@ -45,13 +45,13 @@
;; bound-variable sets
(define empty-frees+binds (cons #hasheq() #hasheq()))
(define (lift-in-schemified-linklet v reannotate)
(define (lift-in-schemified-linklet v)
;; Match outer shape of a linklet produced by `schemify-linklet`
;; and lift in the linklet body:
(let loop ([v v])
(match v
[`(lambda ,args . ,body)
(define new-body (lift-in-schemified-body body reannotate))
(define new-body (lift-in-schemified-body body))
(if (for/and ([old (in-list body)]
[new (in-list new-body)])
(eq? old new))
@ -63,11 +63,11 @@
v
`(let* ,bindings ,new-body))])))
(define (lift-in-schemified-body body reannotate)
(define (lift-in-schemified-body body)
(for/list ([v (in-list body)])
(lift-in-schemified v reannotate)))
(lift-in-schemified v)))
(define (lift-in-schemified v reannotate)
(define (lift-in-schemified v)
;; Quick pre-check: do any lifts appear to be possible?
(define (lift-in? v)
(match v

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

@ -62,7 +62,7 @@
;; linklet imports, where #t to means that a value is expected, and #f
;; means that a variable (which boxes a value) is expected
(define (schemify-linklet lk serializable? for-jitify? allow-set!-undefined? unsafe-mode?
reannotate prim-knowns get-import-knowns import-keys)
prim-knowns get-import-knowns import-keys)
(define (im-int-id id) (unwrap (if (pair? id) (cadr id) id)))
(define (im-ext-id id) (unwrap (if (pair? id) (car id) id)))
(define (ex-int-id id) (unwrap (if (pair? id) (car id) id)))
@ -114,7 +114,7 @@
(values bodys null)))
;; Schemify the body, collecting information about defined names:
(define-values (new-body defn-info mutated)
(schemify-body* bodys/constants-lifted reannotate prim-knowns imports exports
(schemify-body* bodys/constants-lifted prim-knowns imports exports
for-jitify? allow-set!-undefined? add-import! #f unsafe-mode?))
(define all-grps (append grps (reverse new-grps)))
(values
@ -160,14 +160,14 @@
;; ----------------------------------------
(define (schemify-body l reannotate prim-knowns imports exports for-cify? unsafe-mode?)
(define (schemify-body l prim-knowns imports exports for-cify? unsafe-mode?)
(define-values (new-body defn-info mutated)
(schemify-body* l reannotate prim-knowns imports exports
(schemify-body* l prim-knowns imports exports
#f #f (lambda (im ext-id index) #f)
for-cify? unsafe-mode?))
new-body)
(define (schemify-body* l reannotate prim-knowns imports exports
(define (schemify-body* l prim-knowns imports exports
for-jitify? allow-set!-undefined? add-import!
for-cify? unsafe-mode?)
;; Various conversion steps need information about mutated variables,
@ -200,7 +200,7 @@
set-vars)])]
[else
(define form (car l))
(define schemified (schemify form reannotate
(define schemified (schemify form
prim-knowns knowns mutated imports exports
allow-set!-undefined?
add-import!
@ -258,7 +258,7 @@
;; Schemify `let-values` to `let`, etc., and
;; reorganize struct bindings.
(define (schemify v reannotate prim-knowns knowns mutated imports exports allow-set!-undefined? add-import!
(define (schemify v prim-knowns knowns mutated imports exports allow-set!-undefined? add-import!
for-cify? unsafe-mode?)
(let schemify/knowns ([knowns knowns] [inline-fuel init-inline-fuel] [v v])
(let schemify ([v v])
@ -564,7 +564,7 @@
(let ([k (find-known u-rator prim-knowns knowns imports mutated)])
(and (known-procedure/can-inline? k)
(left-left-lambda-convert
(inline-clone k (hash-ref imports u-rator #f) add-import! mutated imports reannotate)
(inline-clone k (hash-ref imports u-rator #f) add-import! mutated imports)
(sub1 inline-fuel))))))
(or (left-left-lambda-convert rator inline-fuel)
(and (positive? inline-fuel)

11
racket/src/schemify/wrap.rkt
View File

@ -6,13 +6,15 @@
wrap-pair? wrap-null? wrap-car wrap-cdr wrap-list?
wrap-eq? wrap-equal?
in-wrap-list
wrap-property)
wrap-property
reannotate)
(import-from-primitive-table
#%kernel
[syntax? correlated?]
[syntax-e correlated-e]
[syntax-property correlated-property])
[syntax-property correlated-property]
[datum->syntax datum->correlated])
(define (unwrap v)
(if (correlated? v)
@ -69,6 +71,11 @@
(and (correlated? a)
(correlated-property a key)))
(define (reannotate old-term new-term)
(if (correlated? old-term)
(datum->correlated #f new-term old-term)
new-term))
(define-sequence-syntax in-wrap-list
(lambda (stx) (raise-argument-error "allowed only in `for` forms" stx))
(lambda (stx)

22
racket/src/schemify/xify.rkt
View File

@ -8,7 +8,7 @@
(provide xify)
(define (xify e reannotate)
(define (xify e)
(define (xify e env)
(reannotate
e
@ -75,40 +75,35 @@
(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)
(test (xify '(let ([apple 1]) apple))
'(let ([x0 1]) x0))
(test (xify '(let ([apple 1] [banana 2]) apple) reannotate)
(test (xify '(let ([apple 1] [banana 2]) apple))
'(let ([x0 1] [x1 2]) x0))
(test (xify '(let ([apple 1]
[banana 2])
(let ([apple 1]
[banana 2])
apple))
reannotate)
apple)))
'(let ([x0 1]
[x1 2])
(let ([x0 1]
[x1 2])
x0)))
(test (xify '(+ (let ([apple 1]) apple)
(let ([banana 2]) banana))
reannotate)
(let ([banana 2]) banana)))
'(+ (let ([x0 1]) x0)
(let ([x0 2]) x0)))
(test (xify '(lambda (a b c)
(list c b a))
reannotate)
(list c b a)))
'(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)
[(x . y) (list x y)]))
'(case-lambda
[(x0 x1 x2)
(list x2 x1 x0)]
@ -119,8 +114,7 @@
(with-continuation-mark a b c))
(set! a b)
(list 'a 'b 'c 1 2 3)
(#%app a b c))
reannotate)
(#%app a b c)))
'(lambda (x0 x1 x2)
(if x0
(begin x1 x2)