cyclone/analyze-pure-fncs.scm

;;;; Cyclone Scheme
;;;; https://github.com/justinethier/cyclone
;;;;
;;;; Copyright (c) 2014-2019, Justin Ethier
;;;; All rights reserved.
;;;;
;;;; This file is part of the cps-optimizations module.
;;;;

(cond-expand 
  (program
    (import (scheme base) 
            (scheme write) 
            (scheme cyclone ast) 
            (scheme cyclone primitives)
            (scheme cyclone transforms)
            (scheme cyclone cps-optimizations)
            (scheme cyclone util) 
            (scheme cyclone pretty-print)
            (srfi 2)
            (srfi 69)
            )
    ))


(define (analyze:memoize-pure-fncs sexp)
;;  ;; Add new entry for each var as it is found...
;;  (define lookup-tbl (make-hash-table))
;;
;;  ;; Pass over the sexp
;;  ;; exp - S-expression to scan
;;  ;; vars - alist of current set of variables
;;  (define (scan exp vars)
;;    ;(trace:error `(DEBUG scan ,(ast:ast->pp-sexp exp)))
;;    (cond
;;     ((ast:lambda? exp)
;;      (for-each
;;        (lambda (a)
;;          (scan a vars))
;;        (ast:lambda-formals->list exp))
;;      (for-each
;;        (lambda (e)
;;          (scan e vars))
;;        (ast:lambda-body exp))
;;     )
;;     ((quote? exp) #f)
;;     ((const? exp) #f)
;;     ((ref? exp) 
;;      (hash-table-set! lookup-tbl exp vars)
;;     )
;;     ((define? exp) 
;;      (scan (define->exp exp) '()))
;;     ((set!? exp)
;;      ;; TODO: probably need to keep track of var here
;;      (scan (set!->var exp) vars)
;;      (scan (set!->exp exp) vars))
;;     ((if? exp)       
;;      (scan (if->condition exp) vars)
;;      (scan (if->then exp) vars)
;;      (scan (if->else exp) vars))
;;     ((app? exp)
;;      (cond
;;       ((ast:lambda? (car exp))
;;        ;; Track deps on lambda var(s)
;;        (for-each
;;          (lambda (e)
;;            (scan e vars))
;;          (ast:lambda-formals->list (car exp)))
;;        ;; Scan body, with reset vars (??)
;;        (for-each
;;          (lambda (e)
;;            (scan e '()))
;;          (ast:lambda-body (car exp)))
;;        ;; Scan lambda arg(s), again also with reset vars
;;        (for-each
;;          (lambda (e)
;;            (scan e '()))
;;          (cdr exp))
;;       )
;;       ((and (ref? (car exp))
;;             (list? exp) 
;;             (> (length exp) 1))
;;         (let* ((cont (cadr exp))
;;                ;; TODO: what if arg is not a ref? Is that possible after cps (probably, with inlining)?
;;                (args (filter ref? (cddr exp)))
;;                (vars* (append args vars))
;;              )
;;         (scan cont vars*)
;;         ;(for-each
;;         ; (lambda (e)
;;         ;   (scan e vars*))
;;         ; (cdr exp))
;;       ))
;;       (else
;;        (for-each
;;          (lambda (e)
;;            (scan e vars))
;;          exp))))
;;     (else (error "unknown expression type: " exp))
;;  ))
;;  (scan sexp '())
;;  lookup-tbl
)


(cond-expand
  (program
    (define (trace:error exp)
      (write exp)
      (newline))
    (define sexp
'(

 (define fnc
   (lambda
     (k$41 x$5$21 y$6$22)
     (k$41 (Cyc-fast-plus x$5$21 y$6$22))))
 (define mfnc #f)
 (define ack
   (lambda
     (k$46 m$7$23 n$8$24)
     ((lambda
        (r$47)
        (if r$47
          ((lambda () (k$46 (Cyc-fast-plus n$8$24 1))))
          ((lambda
             (r$48)
             (if r$48
               ((lambda
                  ()
                  ((lambda (r$49) (ack k$46 r$49 1))
                   (Cyc-fast-sub m$7$23 1))))
               ((lambda
                  ()
                  ((lambda
                     (r$50)
                     ((lambda
                        (r$52)
                        (ack (lambda (r$51) (ack k$46 r$50 r$51))
                             m$7$23
                             r$52))
                      (Cyc-fast-sub n$8$24 1)))
                   (Cyc-fast-sub m$7$23 1))))))
           (Cyc-fast-eq n$8$24 0))))
      (Cyc-fast-eq m$7$23 0))))
 (define fib
   (lambda
     (k$55 n$16$25)
     ((lambda
        (r$56)
        (if r$56
          (k$55 n$16$25)
          ((lambda
             (r$60)
             (fib (lambda
                    (r$57)
                    ((lambda
                       (r$59)
                       (fib (lambda
                              (r$58)
                              (k$55 (Cyc-fast-plus r$57 r$58)))
                            r$59))
                     (Cyc-fast-sub n$16$25 2)))
                  r$60))
           (Cyc-fast-sub n$16$25 1))))
      (Cyc-fast-lt n$16$25 2))))

))

;;    (pretty-print
;;      (ast:ast->pp-sexp
;;        (ast:sexp->ast sexp)))
;;    
;;    (newline)
;;    (newline)
;;
;;    (let ((ht (analyze:build-call-graph (ast:sexp->ast sexp))))
;;      (pretty-print (hash-table->alist ht))
;;      (newline)
;;;; TODO: store table and call these to test various vars:
;;(analyze:find-inlinable-vars (ast:sexp->ast sexp) '()) ;; Identify variables safe to inline
;;(pretty-print (inline-ok-from-call-graph? 'm$30$47 ht))
;;(newline)
;;(pretty-print (inline-ok-from-call-graph? 'zzz ht))
;;(newline)
;;    )
;;
;;    ;(pretty-print
;;    ;  (ast:ast->pp-sexp
;;    ;    (opt:local-var-reduction (ast:sexp->ast sexp)))
;;    ;)
))