Lab 13

Implement a binary tree with insert and contains? operations in a store-passing style.

Here are some data definitions:

; a memory location is either false or a number
(define memloc? (or/c false? number?))

; for our purposes, the only thing in memory is
; nodes:
(define-type Node
  [node (val number?)
        (left memloc?)
        (right memloc?)])

; a store maps locations (numbers) to nodes:
(define store? (hash/c number? Node?))

; represent anything and a store paired
(define-type Any*Store
  [a*s (val any/c) (store any/c)])

; utility functions for the store monad

; in these definitions, the contract ('a computation) is short for
; the contract (Store? -> Any*Store?), where the 'val' in the Any*Store is
; 'a, whatever 'a might happen to be.

; bind : ('a computation) ('a -> ('b computation)) -> ('b computation)
; connect an ('a computation) and a function from an 'a to a ('b computation)
; to form a new ('b computation)
(define (bind a b) (lambda (store)
                     (type-case Any*Store (a store)
                       [a*s (x newstore) ((b x) newstore)])))

; lift : 'a -> ('a computation)
(define (lift a) (lambda (store) (a*s a store)))

; getstore : (Store computation)
(define getstore (lambda (store) (a*s store store)))

; setstore : Store? -> (Store computation)
(define (setstore newstore) (lambda (dc) (a*s #f newstore)))

; run : ('a computation) Store? -> (a*s 'a Store?)
; actually run the computation, produce the result
(define (run comp sto)
  (comp sto))

; sdo: convenience syntax for the Store monad. Imitating
; Haskell's 'do':
(define-syntax sdo
  (syntax-rules (<-)
    ; base cases:
    [(_ (name <- comp)) comp]
    [(_ comp)           comp]
    ; non-base-cases:
    [(_ (name <- comp1) clause ...)
     (bind comp1 (lambda (name) (sdo clause ...)))]
    [(_ comp1 clause ...)
     (bind comp1 (lambda (bogusname) (sdo clause ...)))]))

; two versions of the same test case: one uses bind, one uses sdo.
(test
(run
  (bind getstore (lambda (s)
  (bind (lift (cons (+ 1 (list-ref s 2)) s)) (lambda (p)
  (bind (setstore p) (lambda (dc)
  (lift 41234)))))))
  (list 3 4 5))
(a*s 41234 (list 6 3 4 5)))

(test
(run
  (sdo (s <- getstore)
       (p <- (lift (cons (+ 1 (list-ref s 2)) s)))
       (setstore p)
       (lift 41234))
  (list 3 4 5))
(a*s 41234 (list 6 3 4 5)))
(print-only-errors false)

(define starting-memory
  (hash 0 (node 0 #f #f)))

The first location in memory, location zero, is special; its left and right pointers are always #f, and its value field indicates the last-allocated address. In order to allocate a new address, increment this counter by one and return it.

Implement the insert method, that accepts a memloc and a new value, and returns a memloc computation with the updated tree. containing the updated tree and a new store in which the given tree now contains the given key. If the given tree is #f, it returns the newly allocated memory location along with the new store. If the given tree is non-#f, it returns the given tree along with the new store.
Implement the contains? method, that accepts a memloc and a value, and returns a boolean computation indicating whether the given value occurs in the tree.

Don’t use any form of mutation—mutable hash tables, boxes, etc.—for this lab.