;;; Who's on first? comedy routine by Abbott and Costello.
;;; Adapted to Scheme by M. Eisenberg (Programming in Scheme,
;;; 1988, Scientific Press, chapter 10).
;;; The following is a sample transcript.  (It will be different each time.)

;> (load "whos-on-first.ss")
;
;Hey Lou, I'm taking you to the baseball game today.
;Say Lou, just for kicks, talk to me in parentheses,
;and leave out all punctuation.
;For example, try something like:
;  (Hey abbott Tell me the names of the guys on our team)
;Then ask some more questions.
;To quit, type (well I dont give a darn)
;? (hey abbott now that were at the ballgame tell me the names of the guys on our team)
;(whos on first whats on second i dont know on third)
;? (whos on first)
;(now youve got it)
;? (who)
;(now youve got it)
;? (what is the name of the first baseman)
;(i told you whats on second)
;? (who)
;(whos on first)
;? (what is his name)
;(i told you whats on second)
;? (who)
;(first base)
;? (hey abbott suppose i throw the ball to first)
;(why not)
;? (who gets it)
;(yes)
;? (who)
;(right)
;? (okay whos the second baseman)
;(no whos on first)
;? (what)
;(i told you whats on second)
;? (whos on second)
;(no whos on first)
;? (i dont know)
;(third base)
;? (what is the third basemans name)
;(i told you whats on second)
;? (who)
;(whos on first)
;? (no what)
;(i told you whats on second)
;? (on second)
;(its like im telling you)
;? (what plays second base)
;(right)
;? (whos on third i dont know)
;(perfect)
;? (i dont know)
;(hes on third)
;? (who)
;(no whos on first)
;? (well i dont give a darn)
;(oh hes our shortstop)
;(thank you youve been a beautiful audience)

;;; the program proper begins here.  The page numbers are from
;;; Eisenberg's book

; (require 'random)  ; for scm

;PAGE 113
;-------

(define select-any-from-list
  (lambda (lis)
    (let ((length-of-list (length lis)))
      (list-ref lis (random length-of-list)))))

(define fragment-of?
  (lambda (fragment sentence)
    (cond ((null? sentence) #f)		; fragment is not empty but sentence is
	  ((eq? (car fragment)(car sentence))
	   (or (starting-part? fragment sentence)
	       (fragment-of? fragment (cdr sentence))))
	  (else (fragment-of? fragment (cdr sentence))))))

(define starting-part?
  (lambda (fragment sentence)
    (cond ((null? fragment) #t)
	  ((null? sentence) #f)
	  ((eq? (car fragment) (car sentence))
	   (starting-part? (cdr fragment)(cdr sentence)))
	  (else #f))))

;PAGE 114
;--------

(define any-good-fragments?
  (lambda (list-of-fragments sentence)
    (cond ((null? list-of-fragments) #f)
	  ((fragment-of? (car list-of-fragments) sentence)
	   #t)
	  (else (any-good-fragments? (cdr list-of-fragments)
				     sentence)))))

;PAGE 115
;-------

(define whos-on-first-loop
  (lambda (old-context)
    (display "? ")
    (force-output)
    (let ((costello (has-type-trusted (list-of symbol) (read))))
      (if (not (pair? costello))
	  (begin
	    (writeln (error-message))
	    (whos-on-first-loop old-context))
	  (let ((new-context (get-context costello old-context)))
	    (let ((strong (try-strong-cues costello))
		  (weak (try-weak-cues costello new-context)))
	      (cond ((not (null? strong))
		     (writeln strong)
		     (whos-on-first-loop (get-context strong new-context)))
		    ((not (null? weak))
		     (writeln weak)
		     (whos-on-first-loop (get-context weak new-context)))
		    ((wants-to-end? costello) (wrap-it-up))
		    (else (writeln (hedge))
			  (whos-on-first-loop new-context)))))))))

(define *error-messages*
  '(
    (Now Lou didnt I tell you to talk to me in parentheses)
    (Come on Lou talk to me in parentheses)
    (Lou Im losing my patience Talk to me in parentheses please)
    (Lou if Ive told you once Ive told you a thousand times
	 talk to me in parentheses)
    ))

(define error-message
  (lambda ()
    (select-any-from-list *error-messages*)))

(define *hedges*
  '((its like im telling you)
    (now calm down)
    (take it easy)
    (its simple lou)
    (im trying to tell you)
    (but you asked)))


(define hedge
  (lambda ()
    (select-any-from-list *hedges*)))


;PAGE 116
;-------

(define *strong-cues*
  '(
    (((the names) (their names))
     ((whos on first whats on second i dont know on third)))
    (((suppose) (lets say) (say))
     ((okay) (why not) (it could happen)))
    (((i dont know))
     ((third base) (hes on third)))
    (((i do not know))
     ((oh i dont knows on third) (hes our third baseman)))
    ))

(define try-strong-cues
  (lambda (costello)
    (letrec ((strong-helper
	      (lambda (cue-list)
		(cond ((null? cue-list) '())
		      ((any-good-fragments?
			(cue-part (first-element cue-list))
			costello)
		       (select-any-from-list
			(response-part (first-element cue-list))))
		      (else (strong-helper (rest-elements cue-list)))))))
      (strong-helper *strong-cues*))))

;PAGE 117
;-------

(define first-element car)
(define rest-elements cdr)
(define cue-part
  (lambda (strong-cue-list)
    (car strong-cue-list)))
(define response-part
  (lambda (strong-cue-list-element)
    (cadr strong-cue-list-element)))

(define *weak-cues*
  '(
    (((who) (whos) (who is))
     ((first-base)
      ((thats right) (exactly) (yes) (right)
       (perfect) (now youve got it)))
     ((third-base second-base)
      ((no whos on first) (whos on first) (first base))))
    (((whats the name))
     ((first-base third-base)
      ((no whats the name of the guy on second)
       (whats the name of the second baseman)))
     ((second-base)
      ((now youre talking) (you got it))))
    (((what) (whats) (what is))
     ((first-base third-base)
      ((hes on second) ( i told you whats on second)))
     ((second-base)
      ((right) (sure) (you got it lou))))
    ))


;PAGE 118
;-------

(define try-weak-cues
  (lambda (costello context)
    (letrec
	((weak-helper
	  (lambda (weak-list)
	    (cond ((null? weak-list) '())
		  ((any-good-fragments?
		    (cue-part (first-element weak-list))
		    costello)
		   (let ((possible-response
			  (try-to-respond
			   context
			   (context-response-part
			    (first-element weak-list)))))
		     (if (null? possible-response)
			 (weak-helper (rest-elements weak-list))
			 possible-response)))
		  (else (weak-helper (rest-elements weak-list))))))
	 (try-to-respond
	  (lambda (current-context context-response-list)
	    (cond ((null? context-response-list) '())
		  ((memv current-context
			 (context-part
			  (first-element context-response-list)))
		   (select-any-from-list
		    (weak-response-part
		     (first-element context-response-list))))
		  (else (try-to-respond
			 current-context
			 (rest-elements context-response-list)))))))
      (weak-helper *weak-cues*))))


(define context-part
  (lambda (contexts-and-responses)
    (car contexts-and-responses)))
(define weak-response-part
  (lambda (contexts-and-responses)
    (cadr contexts-and-responses)))
(define context-response-part
  (lambda (weak-list-element)
    (cdr weak-list-element)))


;PAGE 119
;-------

(define *context-words*
  '(
    (((first)) . first-base)
    (((second)) . second-base)
    (((third)) . third-base)))

(define get-context
  (lambda (sentence old-context)
    (letrec
	((context-helper
	  (lambda (context-list)
	    (cond ((null? context-list) old-context)
		  ((any-good-fragments?
		    (context-words (first-element context-list))
		    sentence)
		   (apparent-context (first-element context-list)))
		  (else (context-helper (rest-elements context-list)))))))
      (context-helper *context-words*))))
(deftype context-words
  (-> ((pair-of (list-of (list-of symbol)) symbol))
      (list-of (list-of symbol))))
(define context-words car)
(deftype apparent-context
  (-> ((pair-of (list-of (list-of symbol)) symbol)) symbol))
(define apparent-context cdr)

(define wants-to-end?
  (lambda (costello)
    (or (equal? costello '(well i dont give a darn))
	(equal? costello '(exit))
	(equal? costello '(quit)))))
(define wrap-it-up
  (lambda ()
    (writeln '(oh hes our shortstop))
    (writeln '(thank you youve been a beautiful audience))))

(define whos-on-first
  (lambda ()
    (newline)
    (for-each displayln
	      '(
		"Hey Lou, I'm taking you to the baseball game today."
		"Say Lou, just for kicks, talk to me in parentheses,"
		"and leave out all punctuation."
		"For example, try something like:"
		"  (Hey abbott Tell me the names of the guys on our team)"
		"Then ask some more questions."
		"To quit, type (well I dont give a darn)"
		))
    (whos-on-first-loop '())))

(whos-on-first)