Find inlinable scheme functions

This commit is contained in:
Justin Ethier 2017-04-18 05:55:00 +00:00
parent b607f9a420
commit f1d5bb6f83
2 changed files with 8 additions and 10 deletions

View file

@ -225,12 +225,12 @@
(trace:info "---------------- after func->primitive conversion:") (trace:info "---------------- after func->primitive conversion:")
(trace:info input-program) ;pretty-print (trace:info input-program) ;pretty-print
;(trace:info "---------------- results of inlinable-top-level-function analysis: ") (trace:info "---------------- results of inlinable-top-level-function analysis: ")
;(for-each (for-each
; (lambda (e) (lambda (e)
; (if (inlinable-top-level-function? e) (if (inlinable-top-level-function? e)
; (trace:info (define->var e)))) (trace:info (define->var e))))
; input-program) input-program)
(let ((cps (map (let ((cps (map
(lambda (expr) (lambda (expr)

View file

@ -1234,6 +1234,7 @@
;; Determine if the given top-level function can be freed from CPS, due ;; Determine if the given top-level function can be freed from CPS, due
;; to it only containing calls to code that itself can be inlined. ;; to it only containing calls to code that itself can be inlined.
(define (inlinable-top-level-function? expr) (define (inlinable-top-level-function? expr)
(define this-fnc-sym (define->var expr))
(define (scan expr fail) (define (scan expr fail)
(cond (cond
((string? expr) (fail)) ((string? expr) (fail))
@ -1246,11 +1247,9 @@
(scan (if->else expr) fail)) (scan (if->else expr) fail))
((app? expr) ((app? expr)
(let ((fnc (car expr))) (let ((fnc (car expr)))
;(inline-fnc (prim:func->prim (car expr) (- (length expr) 1))))
;; If function needs CPS, fail right away ;; If function needs CPS, fail right away
(if (or (not (prim? fnc)) ;; Eventually need to handle user functions, too (if (or (not (prim? fnc)) ;; Eventually need to handle user functions, too
(prim:cont? fnc) ;; Needs CPS (prim:cont? fnc) ;; Needs CPS
;(equal? fnc inline-fnc) ;; No inline version
) )
(fail)) (fail))
;; Otherwise, check for valid args ;; Otherwise, check for valid args
@ -1266,8 +1265,7 @@
;; NOTE: would not be able to detect all functions in this module immediately. ;; NOTE: would not be able to detect all functions in this module immediately.
;; would probably have to find some, then run this function successively to find others. ;; would probably have to find some, then run this function successively to find others.
;; ;;
;; define, set - reject ;; Reject everything else - define, set, lambda
;; lambda of all forms - reject
(else (fail)))) (else (fail))))
(cond (cond
((and (define? expr) ((and (define? expr)