Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-23 20:15:05 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

56
scheme/cyclone/cps-optimizations.sld
View file

@ -17,8 +17,8 @@
; can write initial analyze, but can't get too far without being able ; can write initial analyze, but can't get too far without being able
; to uniquely ID each lambda ; to uniquely ID each lambda
;(define-library (cps-optimizations) (define-library (cps-optimizations)
(define-library (scheme cyclone cps-optimizations) ;(define-library (scheme cyclone cps-optimizations)
(import (scheme base) (import (scheme base)
(scheme cyclone util) (scheme cyclone util)
(scheme cyclone ast) (scheme cyclone ast)
@ -504,6 +504,58 @@
(all-prim-calls? (cdr exps))) (all-prim-calls? (cdr exps)))
(else #f))) (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) (define (analyze-cps exp)
(analyze exp -1) ;; Top-level is lambda ID -1 (analyze exp -1) ;; Top-level is lambda ID -1
(analyze2 exp) ;; Second pass (analyze2 exp) ;; Second pass

60
scheme/cyclone/test-cps.scm
View file

@ -132,58 +132,22 @@
;) ;)
(define code (define code
'((define reg-port '((define in-port:read-buf!
#((record-marker) #((record-marker)
#((record-marker) #f (id args body)) #((record-marker) #f (id args body))
#(630 #(621
(k$812 fp$262) (k$807 ptbl$260)
((#((record-marker) ((#((record-marker)
#((record-marker) #f (id args body)) #((record-marker) #f (id args body))
#(629 #(619
(r$813) (result$261)
((#((record-marker) ((in-port:set-buf!
#((record-marker) #f (id args body)) #((record-marker)
#(628 #((record-marker) #f (id args body))
(r$263) #(618 (r$809) ((k$807 result$261))))
((if r$263 ptbl$260
(#((record-marker) #f))))
#((record-marker) #f (id args body)) (cadr ptbl$260)))))))
#(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*)))))))
) )
(pretty-print (pretty-print