typed-trees.rkt

#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?)))