From 1dc3e8324da69cb3b88979c12b71b86a76a52a0b Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 31 Jan 2019 13:32:55 -0500
Subject: [PATCH] Initial file

---
 analyze-pure-fncs.scm | 192 ++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 192 insertions(+)
 create mode 100644 analyze-pure-fncs.scm

diff --git a/analyze-pure-fncs.scm b/analyze-pure-fncs.scm
new file mode 100644
index 00000000..cbd5bf5b
--- /dev/null
+++ b/analyze-pure-fncs.scm
@@ -0,0 +1,192 @@
+;;;; 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)))
+;;    ;)
+))