diff --git a/cyclone.scm b/cyclone.scm index 22668807..dcf5aaef 100644 --- a/cyclone.scm +++ b/cyclone.scm @@ -224,6 +224,13 @@ input-program)) (trace:info "---------------- after func->primitive conversion:") (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 (lambda (expr) diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld index 9326bcc4..dbdc7d6d 100644 --- a/scheme/cyclone/transforms.sld +++ b/scheme/cyclone/transforms.sld @@ -1234,26 +1234,52 @@ ;; 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. (define (inlinable-top-level-function? expr) -;; TODO: (define (scan expr) -;; TODO: (cond -;; TODO: ((string? expr) #f) -;; TODO: ((bytevectors? expr) #f) -;; TODO: ((const? expr) #t) ;; Good enough? what about large vectors or anything requiring alloca (strings, bytevectors, what else?) -;; TODO: ((ref? expr) #t) -;; TODO: ;; if - ok by itself, check clauses -;; TODO: ;; prim-app - OK only if prim does not require CPS. -;; TODO: ;; still need to check all its args -;; TODO: ;; app - same as prim, only OK if function does not require CPS. -;; TODO: ;; probably safe to return #t if calling self, since if no -;; TODO: ;; CPS it will be rejected anyway -;; TODO: ;; define, set - reject -;; TODO: ;; lambda of all forms - reject -;; TODO: (else #f))) + (define (scan expr fail) + (cond + ((string? expr) (fail)) + ((bytevector? expr) (fail)) + ((const? expr) #t) ;; Good enough? what about large vectors or anything requiring alloca (strings, bytevectors, what else?) + ((ref? expr) #t) + ((if? expr) + (scan (if->condition expr) fail) + (scan (if->then expr) fail) + (scan (if->else expr) fail)) + ((app? expr) + (let ((fnc (car expr))) + ;(inline-fnc (prim:func->prim (car expr) (- (length expr) 1)))) + ;; If function needs CPS, fail right away + (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 ((and (define? expr) (lambda? (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))) ;; ;; Helpers to syntax check primitive calls