;; User Input Function (define (yorn) (let ((yn (read))) (cond ((eq? yn 'yes) #t) ((eq? yn 'no) #f) (else (display "Please type YES or NO") (yorn))))) ;; Abstract Data Type Definition: (define (make-btree q y n) (list q y n)) (define (make-leaf a) (list a nil nil)) (define (content node) (car node)) (define (yespart node) (cadr node)) (define (nopart node) (caddr node)) (define (leaf? node) (and (null? (yespart node)) (null? (nopart node)))) (define (branch? node) (not (leaf? node))) (define (set-yes! node x) (set-car! (cdr node) x)) (define (set-no! node x) (set-car! (cddr node) x)) ;; Actual program: (define (animal node) (display (content node)) (display " ") (flush) (let ((yn (yorn))) (let ((next (if yn (yespart node) (nopart node)))) (cond ((branch? next) (animal next)) (else (display "Is it a ") (display (content next)) (display "? ") (flush) (let ((correctflag (yorn))) ;; VAR ASSIGN (is it correct?) (cond (correctflag "I win!") (else (newline) (display "I give up, what is it? ") (flush) (let ((correct (read))) ;; VAR ASSIGN (correct answer) (newline) (display "Please tell me a question whose ") (display "answer is YES for a ") (display correct) (newline) (display "and NO for a ") (display (content next)) (display ".") (newline) (display "Enclose the question in ") (display "quotation marks.") (newline) (flush) (let ((newquest (read))) (if yn (set-yes! node (make-btree newquest (make-leaf correct) next)) (set-no! node (make-btree newquest (make-leaf correct) next))) "Thanks. Now I know better.")))))))))) (define animal-list (make-btree "Does it have wings?" (make-leaf 'parrot) (make-leaf 'rabbit))) (define (animal-game) (animal animal-list))