logc · June 6, 2017 16:57 · Jun 6, 2017
diff --git a/typed-trees.rkt b/typed-trees.rkt
@@ -0,0 +1,70 @@
+#lang typed/racket/base
+(require racket/future)
+(require racket/performance-hint)
+(require racket/cmdline)
+(require (only-in racket/unsafe/ops
+                  unsafe-car
+                  unsafe-cdr))
+(require (rename-in racket/unsafe/ops
+                    [unsafe-fx+ +]
+                    [unsafe-fx- -]
+                    [unsafe-fx= =]))
+
+(define-type BinaryTree (U BinaryTreeLeaf BinaryTreeNode))
+(define-type BinaryTreeLeaf Boolean)
+(define-type BinaryTreeNode (Pair BinaryTree BinaryTree))
+
+(define node cons)
+
+(: make (-> Fixnum BinaryTree))
+(define (make d)
+  (cond [(= d 0) (node #f #f)]
+        [else (node (make (- d 1)) (make (- d 1)))]))
+
+(: node-left (case-> (BinaryTree -> BinaryTree)
+                     (BinaryTreeLeaf -> BinaryTreeLeaf)))
+(define (node-left t)
+  (cond [(pair? t) (unsafe-car t)]
+        [else t]))
+
+(: node-right (case-> (BinaryTree -> BinaryTree)
+                      (BinaryTreeLeaf -> BinaryTreeLeaf)))
+(define (node-right t)
+  (cond [(pair? t) (unsafe-cdr t)]
+        [else t]))
+
+(begin-encourage-inline 
+(: check (case-> (BinaryTree Fixnum -> Fixnum)
+                 (BinaryTreeLeaf Fixnum -> Fixnum)))
+(define (check t acc)
+    (cond [(node-left t) (check (node-right t) (check (node-left t) (+ acc 1)))]
+          [else (+ acc 1)]))
+)
+
+(: main (-> Fixnum Void))
+(define (main n)
+  (define min-depth : Fixnum 4)
+  (define max-depth : Fixnum (max (+ min-depth 2) n))
+  (define stretch-depth : Fixnum (+ max-depth 1))
+  (printf "stretch tree of depth ~a\t check: ~a\n" stretch-depth (check (make stretch-depth) 0))
+  (define long-lived-tree : BinaryTree (make max-depth))
+
+
+  (: generate-trees-and-check (-> Integer Void))
+  (define (generate-trees-and-check d)
+    (define iterations (arithmetic-shift 1 (+ (- max-depth d) min-depth)))
+    (printf "~a\t trees of depth ~a\t check: ~a\n"
+            iterations
+            d
+            (for/sum ([_ (in-range iterations)])
+              (check (make d) 0))))
+
+  (let ([futures : (Listof (Futureof Void)) (for/list ([d (in-range 4 (add1 max-depth) 2)])
+                   (future (lambda () (generate-trees-and-check d))))])
+    (for ([f futures]) (touch f)))
+
+  (printf "long lived tee of depth ~a\t check: ~a\n" max-depth (check long-lived-tree 0)))
+
+
+(command-line #:args (#{n : String})
+              (main (assert (string->number n) fixnum?)))