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

WIP: (inlinable-top-level-function? expr)

Browse source
This commit is contained in:
Justin Ethier 2017-04-18 19:03:31 -04:00
parent fc8b09ed34
commit b607f9a420
2 changed files with 49 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
cyclone.scm
View file

@ -225,6 +225,13 @@
(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: ")
;(for-each
; (lambda (e)
; (if (inlinable-top-level-function? e)
; (trace:info (define->var e))))
; input-program)
(let ((cps (map (let ((cps (map
(lambda (expr) (lambda (expr)
(cps-convert expr)) (cps-convert expr))

58
scheme/cyclone/transforms.sld
View file

@ -1234,26 +1234,52 @@
;; 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)
;; TODO: (define (scan expr) (define (scan expr fail)
;; TODO: (cond (cond
;; TODO: ((string? expr) #f) ((string? expr) (fail))
;; TODO: ((bytevectors? expr) #f) ((bytevector? expr) (fail))
;; TODO: ((const? expr) #t) ;; Good enough? what about large vectors or anything requiring alloca (strings, bytevectors, what else?) ((const? expr) #t) ;; Good enough? what about large vectors or anything requiring alloca (strings, bytevectors, what else?)
;; TODO: ((ref? expr) #t) ((ref? expr) #t)
;; TODO: ;; if - ok by itself, check clauses ((if? expr)
;; TODO: ;; prim-app - OK only if prim does not require CPS. (scan (if->condition expr) fail)
;; TODO: ;; still need to check all its args (scan (if->then expr) fail)
;; TODO: ;; app - same as prim, only OK if function does not require CPS. (scan (if->else expr) fail))
;; TODO: ;; probably safe to return #t if calling self, since if no ((app? expr)
;; TODO: ;; CPS it will be rejected anyway (let ((fnc (car expr)))
;; TODO: ;; define, set - reject ;(inline-fnc (prim:func->prim (car expr) (- (length expr) 1))))
;; TODO: ;; lambda of all forms - reject ;; If function needs CPS, fail right away
;; TODO: (else #f))) (if (or (not (prim? fnc)) ;; Eventually need to handle user functions, too
(prim:cont? fnc) ;; Needs CPS
;(equal? fnc inline-fnc) ;; No inline version
)
(fail))
;; Otherwise, check for valid args
(for-each
(lambda (e)
(scan e fail))
(cdr expr))))
;; prim-app - OK only if prim does not require CPS.
;; still need to check all its args
;; app - same as prim, only OK if function does not require CPS.
;; probably safe to return #t if calling self, since if no
;; CPS it will be rejected anyway
;; 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.
;;
;; define, set - reject
;; lambda of all forms - reject
(else (fail))))
(cond (cond
((and (define? expr) ((and (define? expr)
(lambda? (car (define->exp expr))) (lambda? (car (define->exp expr)))
(equal? 'args:fixed (lambda-formals-type (car (define->exp expr))))) (equal? 'args:fixed (lambda-formals-type (car (define->exp expr)))))
#t) ;; TODO: no, scan lambda body (call/cc
(lambda (k)
(scan
(car (lambda->exp
(car (define->exp expr))))
(lambda () (k #f))) ;; Fail with #f
(k #t)))) ;; Scanned fine, return #t
(else #f))) (else #f)))
;; ;;
;; Helpers to syntax check primitive calls ;; Helpers to syntax check primitive calls