mirror of
https://github.com/justinethier/cyclone.git
synced 2025-05-23 20:15:05 +02:00
WIP
This commit is contained in:
parent
230ecbb65b
commit
d415ccee31
2 changed files with 66 additions and 50 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Reference in a new issue