Lecture 33: Counting Out Time (Genesis) -- More on Local

1. localizing effects uniformly

   
   ;; counting : (X -> Y) -> ((union X 'count) -> Y)
   ;; Purpose: produce a counting version of f
   (define (counting f)
     (local ((define counter 0)
   	  (define (g x) 
   	    (cond
   	      ((eq? x 'count) counter)
   	      (else 
   	       (begin (set! counter (+ counter 1))
   		      (f x))))))
       g))
   
   ;; ! : N -> N
   (define (! n)
   	    (cond
   	      ((zero? n) 1)
   	      (else (* n (! (sub1 n))))))
   
   ;; c-! : N -> N
   (define c-! (counting !))
   
   (and 
    (= (c-! 3) 6)
    (= (c-! 4) 24)
    (= (c-! 'count) 2))
   
   ;; switch : sym -> sym 
   (define (switch s)
     (cond
       ((eq? s 'count) 'down)
       (else s)))
   
   (define c-switch (counting switch))
   
   (and 
    (eq? (c-switch 's) 's)
    (eq? (c-switch 'count) 'down))
   
   

   
   
   
2. security

   
   ;; counting : (X -> Y) -> ((union X Key) -> Y)
   ;; Purpose: produce a secure counting version of f plus a key for access 
   (define (counting f)
     (local ((define counter 0)
   	  (define-struct key ())
   	  (define my-key (make-key))
   	  (define (g x) 
   	    (cond
   	      ((eq? x my-key) counter)
   	      (else 
   	       (begin (set! counter (+ counter 1))
   		      (f x))))))
       (list my-key g)))
   
   ;; ! : N -> N
   (define d-! (counting !))
   (define c-! (second d-!))
   (define c-!-key (first d-!))
   
   (and 
    (= (c-! 3) 6)
    (= (c-! 4) 24)
    (= (c-! c-!-key) 2))
   
   (define d-switch (counting switch))
   (define c-switch (second d-switch))
   (define c-switch-key (first d-switch))
   
   (and 
    (eq? (c-switch 's) 's)
    (eq? (c-switch 'count) 'down)
    (= (c-switch c-switch-key) 2))
   
   

   
   
   
3. localizing storage

   
   (define-struct entry (name number))
   
   (define phone-book empty)
   
   (define (update-pb! name number)
     (set! phone-book (cons (make-entry name number) phone-book)))
   
   (define (lookup name pb)
     (cond 
       ((empty? pb) #f)
       ((eq? (entry-name (first pb)) name)
        (entry-number (first pb)))
       (else (lookup name (rest pb)))))
   
   (begin
     (update-pb! 'kc 6666666)
     (= (lookup 'kc phone-book) 6666666))
   
   ;; How many phonebooks do we want to manage? Many. Personal. Campus. Off-campus. 
   
   (define (make-phone-book kind)
     (local ((define-struct entry (name number))
   	  
   	  (define phone-book empty)
   	  
   	  (define (update-pb! name number)
   	    (set! phone-book (cons (make-entry name number) phone-book)))
   	  
   	  (define (lookup name pb)
   	    (cond 
   	      ((empty? pb) #f)
   	      ((eq? (entry-name (first pb)) name)
   	       (entry-number (first pb)))
   	      (else (lookup name (rest pb)))))
   	  
   	  (define (manage msg name)
   	    (cond
   	      ((eq? msg 'lookup) (lookup name phone-book))
   	      ((eq? msg 'add) (lambda (number) (update-pb! name number)))
   	      ((eq? msg 'print) (cons kind phone-book))
   	      (else (error 'phone-book-class "message not understood")))))
       manage))
   
   (define p1 (make-phone-book 'friends))
   (define p2 (make-phone-book 'enemies))
   (define p3 (make-phone-book 'special))
   
   ;; How many phone books do we have? 3
   ;; How many manage functions did we create? 3
   ;; How do we use them? 
   
   (p1 'lookup 'monica)
   ((p1 'add 'monica) 5555555)
   (p1 'lookup 'monica)
   
   ((p2 'add 'monica) 5555555)
   (p2 'lookup 'monica)
   
   ((p1 'add 'monica) 4444444)
   (p2 'lookup 'monica)
   (p1 'lookup 'monica)
   
   ;; (make-phone-book ...) is like 
   (define-struct entry (name number))
   (define-struct phone-book (kind listing))
   ;; A phone-book is (make-phone-book sym (listof entry)). 
   
   (define p4 (make-phone-book 'help (list (make-entry 555 #f))))
   
   ;; This cannot happen in our world: we can ensure once and for all 
   ;; that the phone book contains only entries and nothing else -- 
   ;; because make entry is hidden via local behind a closure