Build context graph using cc.

.gitignore

@@ -1,3 +1,8 @@
 *.pyc
 *.out
 *.tmp
+*~
+\#*
+*.gen
+\.\#*
+*mail.txt

amb.ss

@@ -0,0 +1,42 @@
+#!r6rs
+
+(import (rnrs)
+        (scheme-tools)
+        (transforms)
+        (rhash))
+
+(define to-explore '())
+(define vals '())
+
+(define (flip)
+  ((call/cc
+    (lambda (k)
+      (k (lambda ()
+           (begin
+             (set! to-explore (cons (lambda (t v) (k (lambda () (begin (set! to-explore t) (set! vals v) #f)))) to-explore))
+             #t)))))))
+
+(define (enumerate proc)
+  (set! vals (list (proc)))
+  (let loop ()
+    (if (null? to-explore)
+        vals
+        (let* ([proc (car to-explore)]
+               [val (proc to-explore vals)])
+          (set! to-explore (cdr to-explore))
+          (set! vals (cons val vals))
+          (loop)))))
+
+(define (my-and a b)
+  (and a b))
+
+(define (my-or a b)
+  (or a b))
+
+(define (recurse n)
+  (if (= n 0)
+      (flip)
+      ((if (= (mod n 2) 0) my-and my-or)
+       (recurse (- n 1)) (recurse (- n 1)))))
+
+(pretty-print (enumerate (lambda () (recurse 2))))

cc-wrapper.ss

@@ -0,0 +1,19 @@
+#!r6rs
+
+(import (rnrs)
+        (scheme-tools)
+        (transforms))
+
+(define (transform expr reserved-words)
+  (cc-transform
+   (cps-transform
+    (assignment-transform
+     (letrec-to-set
+      expr))
+    reserved-words)
+   reserved-words))
+
+(pretty-print
+ (transform
+  '%(expr)s
+  '(flip)))

count-wrapper.ss

@@ -0,0 +1,82 @@
+#!r6rs
+
+;; Shortcutting enumeration based on continuation hashing
+
+(import (rnrs)
+        (scheme-tools)
+        (transforms)
+        (rhash))
+
+(define (transform expr reserved-words)
+  (cc-transform
+   (cps-transform
+    (assignment-transform
+     (letrec-to-set
+      expr))
+    reserved-words)
+   reserved-words))
+
+(define (wrap e)
+  `(begin
+     (define search-stack '())
+     (define history '())
+     (define future '())
+     (define (raw-flip)
+       (if (null? future)
+           (begin
+             (set! search-stack
+                   (append (list (cons #f history))
+                           search-stack))
+             (set! history (cons #t history))
+             #t)
+           (begin
+             (let ([v (car future)])
+               (set! future (cdr future))
+               (set! history (cons v history))
+               v))))
+     (define count-table (make-hash-table))
+     (define value-table (make-hash-table))
+     (define (ht-inc! ht k)
+       (let ([count (hash-table-ref/default ht k 0)])
+         (hash-table-set! ht k (+ count 1))))
+     (define (enumerate proc)
+       (set! count-table (make-hash-table))
+       (set! search-stack '())
+       (set! history '())
+       (set! future '())
+       (let ([v1 (proc)]
+             [h1 history])
+         (set! history '())
+         (let loop ([vals (list (list v1 (reverse h1)))])
+           (if (null? search-stack)
+               vals
+               (begin
+                 (set! history '())
+                 (set! future (reverse (car search-stack)))
+                 (set! search-stack (cdr search-stack))
+                 (let ([v (proc)])
+                   (loop (cons (list v (reverse history)) vals))))))))
+     (define flip
+       (vector
+        (lambda (self k)
+          (let ([flip-val (raw-flip)])
+            (ht-inc! count-table (cons flip-val k))
+            ((vector-ref k 0)
+             k
+             flip-val)))))
+     (define (my-and a b)
+       (and a b))
+     (define (my-or a b)
+       (or a b))
+     (define print-future pretty-print)
+     (pretty-print (enumerate (lambda () (begin ,@(cdr e)))))
+     (pretty-print (map cdr (hash-table->alist count-table)))))
+
+(define prog
+  '%(expr)s)
+
+(define te
+  (transform prog
+             '(flip)))
+
+(pretty-print (wrap te))

count.py

@@ -0,0 +1,28 @@
+#!/usr/bin/python
+from subprocess import Popen
+from external import optfunc
+
+# enumerate dumbly & print out state counts
+
+@optfunc.main
+def main(fn):
+    """Usage: %prog <file> [options]"""
+    # read fn
+    expr = open(fn).read()
+    # write temporary file that will pretty-print cc-converted file
+    count_generator = open("count-wrapper.ss").read() % { "expr" : expr }
+    f = open("count.gen", "w")
+    f.write(count_generator)
+    f.close()
+    # run temporary file, get output    
+    p = Popen("ikarus --r6rs-script ./count.gen > ./count.tmp", shell=True)
+    p.communicate()
+    code = open("count.tmp").read()
+    # read wrapper template & fill in cc-converted code & write to file        
+    wrapper = open("wrapper.ss").read()
+    out = open("count.out", "w")
+    out.write(wrapper % { "code" : code })
+    out.close()
+    # run
+    p = Popen("ikarus --r6rs-script ./count.out", shell=True)
+    p.communicate()

enumerate-me-2.ss

@@ -0,0 +1,8 @@
+(begin
+  (define recurse
+    (lambda (n)
+      (if (= n 0)
+          (flip)
+          ((if (= (mod n 2) 0) my-and my-or)
+           (recurse (- n 1)) (recurse (- n 1))))))
+  (recurse 2))

enumerate-me.ss

@@ -0,0 +1 @@
+(list (flip) (flip))

graph-test.ss

@@ -0,0 +1,32 @@
+#!r6rs
+
+(import (graph)
+        (rnrs)
+        (scheme-tools))
+
+(define (test)
+  (begin
+    (define flip
+      (vector
+       (lambda (self k) k)
+       'flip-code))
+    (define top
+      (vector
+       (lambda (self v)
+         (begin
+           (display "result: ")
+           (pretty-print v)        
+           v))
+       'top-code))
+    (define (thunk)
+      ((vector-ref flip 0)
+       flip
+       (vector (lambda (self x) ((vector-ref flip 0)
+                            flip
+                            (vector (lambda (self y) ((vector-ref top 0) top (list (vector-ref self 2) y)))
+                                    'l2-code
+                                    x)))
+               'l1-code)))
+    (print-graph thunk)))
+
+(test)

graph-wrapper.ss

@@ -0,0 +1,33 @@
+#!r6rs
+
+(import (graph)
+        (rnrs)
+        (rnrs mutable-pairs)
+        (scheme-tools))
+
+(define (my-and a b)
+  (and a b))
+
+(define (my-or a b)
+  (or a b))
+
+(define (thunk)
+  (begin
+    (define flip
+      (vector
+       (lambda (self k) k)
+       'flip-code))
+    (define top
+      (vector
+       (lambda (self v)
+         (begin
+           (display "result: ")
+           (pretty-print v)        
+           v))
+       'top-code))
+    ;; cc code goes here
+    %(cc_code)s
+    ))
+
+(print-graph thunk)
+

graph.py

@@ -0,0 +1,28 @@
+#!/usr/bin/python
+from subprocess import Popen
+from external import optfunc
+
+# enumerate smartly & print out context graph
+
+@optfunc.main
+def main(fn):
+    """Usage: %prog <file>"""
+    # read fn
+    expr = open(fn).read()
+    # write temporary file that will pretty-print cc-converted file
+    cc_generator = open("cc-wrapper.ss").read() % { "expr" : expr }
+    f = open("cc.gen", "w")
+    f.write(cc_generator)
+    f.close()
+    # run temporary file, get output
+    p = Popen("ikarus --r6rs-script ./cc.gen > ./cc.tmp", shell=True)
+    p.communicate()
+    cc_code = open("cc.tmp").read()
+    # read wrapper template & fill in cc-converted code & write to file    
+    graph_generator = open("graph-wrapper.ss").read() % { "cc_code" : cc_code }
+    f = open("cc.out", "w")
+    f.write(graph_generator)
+    f.close()
+    # run
+    p = Popen("ikarus --r6rs-script ./cc.out", shell=True)
+    p.communicate()