sicp/mceval/amb-natural-language.rkt

(define nouns '(noun student professor cat class))
(define verbs '(verb studies lectures eats sleeps))
(define articles '(article the a))
(define prepositions '(prep for to in by with))

(define (log message level)
  (define (output message level)
    (if (= level 0) message
        (cons '_ (output message (- level 1)))))
  (display (output message level))
  (newline))

(define (parse-word word-list level)
  (log (list 'word-list word-list '*unparsed* *unparsed*) level)
  (require (not (null? *unparsed*)))
  (require (memq (car *unparsed*) (cdr word-list)))
  (let ((found-word (car *unparsed*)))
    (set! *unparsed* (cdr *unparsed*))
    (log (list (car word-list) found-word) level)
    (list (car word-list) found-word)))

(define *unparsed* '())

(define (parse input)
  (set! *unparsed* input)
  (let ((sent (parse-sentence)))
    (require (null? *unparsed*))
    sent))

(define (parse-sentence)
  (list 'sentence
         ;;(parse-noun-phrase)
         (parse-verb-phrase 1)))

(define (parse-noun-phrase level)
  (define (maybe-extend noun-phrase)
    (log '(maybe-extend-noun) level)
    (amb noun-phrase
         (maybe-extend (list 'noun-phrase
                             noun-phrase
                             (parse-prepositional-phrase level)))))
  (log '(parse-noun-phrase) level)
  (maybe-extend (parse-simple-noun-phrase level)))

;; Note maybe-extend is tail recursive
(define (parse-verb-phrase level)
  (define (maybe-extend verb-phrase)
    (log '(maybe-extend-verb-phrase) level)
    (amb verb-phrase
         (maybe-extend (list 'verb-phrase
                             verb-phrase
                             (parse-prepositional-phrase level)))))
  (log '(parse-verb-phrase) level)
  (maybe-extend (parse-word verbs level)))

(define (parse-simple-noun-phrase level)
  (log '(parse-simple-noun) level)
  (list 'simple-noun-phrase
        (parse-word articles level)
        (parse-word nouns level)))

(define (parse-prepositional-phrase level)
  (log '(parse-prep) level)
  (list 'prep-phrase
        (parse-word prepositions level)
        (parse-noun-phrase level)))



;; Note: not tail recursive
(define (parse-verb-phrase level)
  (log '(parse-verb-phrase) level)
  (amb (parse-word verbs level)
       (list 'verb-phrase
             (parse-verb-phrase (+ level 1))
             (parse-prepositional-phrase level))))










;; Exercise 4.45: Output of (parse '(the professor lectures to the student in the class with the cat))

(sentence
 (simple-noun-phrase (article the) (noun professor))
 (verb-phrase
  (verb-phrase
   (verb-phrase (verb lectures)
                (prep-phrase (prep to)
                             (simple-noun-phrase (article the) (noun student))))
   (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class))))
  (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))

;; The cat is with the professor.  The professor is in the class
;; lecturing the student.  The student may be elsewhere.


(sentence
 (simple-noun-phrase (article the) (noun professor))
 (verb-phrase
  (verb-phrase
   (verb lectures)
   (prep-phrase (prep to)
                (simple-noun-phrase (article the) (noun student))))
  (prep-phrase (prep in)
               (noun-phrase (simple-noun-phrase (article the) (noun class))
                            (prep-phrase (prep with)
                                         (simple-noun-phrase (article the) (noun cat)))))))

;; The cat is in the class in which the professor is lecturing the student


(sentence
 (simple-noun-phrase (article the) (noun professor))
 (verb-phrase
  (verb-phrase
   (verb lectures)
   (prep-phrase (prep to)
                (noun-phrase (simple-noun-phrase (article the) (noun student))
                             (prep-phrase (prep in)
                                          (simple-noun-phrase (article the)
                                                              (noun class))))))
  (prep-phrase (prep with)
               (simple-noun-phrase (article the) (noun cat)))))

;; The student is in the class.  The professor is with the cat and is
;; lecturing to the student.  The professor and cat may or may not be
;; in the class.


(sentence
 (simple-noun-phrase (article the) (noun professor))
 (verb-phrase
  (verb lectures)
  (prep-phrase (prep to)
               (noun-phrase
                (noun-phrase (simple-noun-phrase (article the) (noun student))
                             (prep-phrase (prep in)
                                          (simple-noun-phrase (article the) (noun class))))
                (prep-phrase (prep with)
                             (simple-noun-phrase (article the) (noun cat)))))))

;; The professor is lecturing the student.  The student is in the
;; class with the cat.


(sentence
 (simple-noun-phrase (article the) (noun professor))
 (verb-phrase
  (verb lectures)
  (prep-phrase (prep to)
               (noun-phrase (simple-noun-phrase (article the) (noun student))
                            (prep-phrase (prep in)
                                         (noun-phrase
                                          (simple-noun-phrase (article the)
                                                              (noun class))
                                          (prep-phrase (prep with)
                                                       (simple-noun-phrase
                                                        (article the)
                                                        (noun cat)))))))))
;; The professor lectures to the student, who is in the class with the cat


;; Exercise 4.46

;; If amb evaluated its arguments in any order other than
;; left-to-right, then the recursive maybe-extend rules would never
;; terminate, as the second argument is a recursive call to the
;; procedure.  We rely on the recursion stopping at each decision
;; point.
;;
;; Also, since parse has side-effects (namely, it removes a word from
;; the input), it is important that we parse the different parts of
;; the sentence in the correct order.

;; Exercise 4.47

(define (parse-verb-phrase level)
  (log (list 'parse-verb-phrase level))
  (amb (parse-word verbs)
       (list 'verb-phrase
             (parse-verb-phrase (+ level 1))
             (parse-prepositional-phrase (+ level 1)))))

;; In this case, if (parse-word verbs) fails, then we evaluate the 2nd
;; argument, which calls parse-verb-phrase recursively, creating a new
;; amb, which tries (parse-word verbs), which still fails.  In the
;; orinal procedure, we evaluate (parse-word verbs) once and bind it
;; to verb-phrase.  We then keep extending the phrase until it either
;; succeeds or fails.  If it fails, the whole amb call fails.  The
;; version here never fails because it keeps calling parse-verb-phrase.

;; If we swap the order of the clauses in the amb, then we get an
;; infinite loop, as the first clause immediately calls
;; parse-verb-phrase recursively.  There is nothing to limit this
;; recursion.