This commit is contained in:
Justin Ethier 2016-06-07 22:52:02 -04:00
parent 230ecbb65b
commit d415ccee31
2 changed files with 66 additions and 50 deletions

View file

@ -17,8 +17,8 @@
; can write initial analyze, but can't get too far without being able
; to uniquely ID each lambda
;(define-library (cps-optimizations)
(define-library (scheme cyclone cps-optimizations)
(define-library (cps-optimizations)
;(define-library (scheme cyclone cps-optimizations)
(import (scheme base)
(scheme cyclone util)
(scheme cyclone ast)
@ -504,6 +504,58 @@
(all-prim-calls? (cdr exps)))
(else #f)))
;; Find variables passed to a primitive
(define (prim-call->arg-variables exp)
(filter symbol? (cdr exp)))
;; Helper for the next function
(define (inline-prim-call? exp ivars args)
(call/cc
(lambda (return)
(inline-ok? exp ivars args (list #f) return)
(return #t))))
;; Make sure inlining a primitive call will not cause out-of-order execution
;; exp - expression to search
;; ivars - vars to be inlined
;; args - list of variable args (should be small)
;; arg-used - has a variable been used? if this is true and we find an ivar,
;; it cannot be optimized-out and we have to bail.
;; This is a cons "box" so it can be mutated.
;; return - call into this continuation to return early
(define (inline-ok? exp ivars args arg-used return)
(cond
((ref? exp)
'TODO)
((ast:lambda? exp)
(for-each
(lambda (e)
(inline-ok? e ivars args arg-used return))
(ast:lambda-formals->list exp))
(for-each
(lambda (e)
(inline-ok? e ivars args arg-used return))
(ast:lambda-body exp)))
((const? exp) #t)
((quote? exp) #t)
((define? exp)
(inline-ok? (define->var exp) ivars args arg-used return)
(inline-ok? (define->exp exp) ivars args arg-used return))
((set!? exp)
(inline-ok? (set!->var exp) ivars args arg-used return)
(inline-ok? (set!->exp exp) ivars args arg-used return))
((if? exp)
(inline-ok? (if->condition exp) ivars args arg-used return)
(inline-ok? (if->then exp) ivars args arg-used return)
(inline-ok? (if->else exp) ivars args arg-used return))
((app? exp)
(for-each
(lambda (e)
(inline-ok? e ivars args arg-used return))
(reverse exp))) ;; Ensure args are examined before function
(else
(error `(Unexpected expression passed to inline prim check ,exp)))))
(define (analyze-cps exp)
(analyze exp -1) ;; Top-level is lambda ID -1
(analyze2 exp) ;; Second pass

View file

@ -132,58 +132,22 @@
;)
(define code
'((define reg-port
'((define in-port:read-buf!
#((record-marker)
#((record-marker) #f (id args body))
#(630
(k$812 fp$262)
#(621
(k$807 ptbl$260)
((#((record-marker)
#((record-marker) #f (id args body))
#(629
(r$813)
((#((record-marker)
#((record-marker) #f (id args body))
#(628
(r$263)
((if r$263
(#((record-marker)
#((record-marker) #f (id args body))
#(622 () ((k$812 r$263)))))
(#((record-marker)
#((record-marker) #f (id args body))
#(627
()
((list #((record-marker)
#((record-marker) #f (id args body))
#(626
(r$817)
((#((record-marker)
#((record-marker) #f (id args body))
#(625
(r$814)
((#((record-marker)
#((record-marker)
#f
(id args body))
#(624
(r$816)
((#((record-marker)
#((record-marker)
#f
(id args body))
#(623
(r$815)
((k$812 r$263))))
(set! *in-port-table*
r$816)))))
(cons r$263 *in-port-table*)))))
(set! r$263 r$817)))))
fp$262
#f
1
0)))))))))
r$813))))
(assoc fp$262 *in-port-table*)))))))
#(619
(result$261)
((in-port:set-buf!
#((record-marker)
#((record-marker) #f (id args body))
#(618 (r$809) ((k$807 result$261))))
ptbl$260
#f))))
(cadr ptbl$260)))))))
)
(pretty-print