(define (parse-word word-list)
  (list (car word-list) (an-element-of (cdr word-list))))

; the results
the student studies
the student studies for the student
the student studies for the student for the student
the student studies for the student for the student for the student
......

(define adjectives '(adjective nice tall diligent small white))

(define (parse-simple-noun-phrase)
  (define (parse-adjective-noun)
    (amb (parse-word nouns)
         (list 'adjective-noun
               (parse-word adjectives)
               (parse-adjective-noun))))
  (list 'simple-noun-phrase
        (parse-word articles)
        (parse-adjective-noun)))

;;; Amb-Eval input:
(parse '(the tall professor lectures))

;;; Starting a new problem
;;; Amb-Eval value:
(sentence
 (simple-noun-phrase
  (article the)
  (adjective-noun (adjective tall) (noun professor)))
 (verb lectures))

;;; Amb-Eval input:
try-again

;;; There are no more values of
(parse (quote (the tall professor lectures)))

;;; Amb-Eval input:
(parse '(the nice tall professor lectures))

;;; Starting a new problem
;;; Amb-Eval value:
(sentence
 (simple-noun-phrase
  (article the)
  (adjective-noun (adjective nice)
                  (adjective-noun (adjective tall)
                                  (noun professor))))
 (verb lectures))

;;; Amb-Eval input:
try-again

;;; There are no more values of
(parse (quote (the nice tall professor lectures)))

;;; Amb-Eval input:
(parse '(the nice tall professor lectures
             to the diligent student in the small class
             with the white cat))
; It works.  Output omitted

It does not work correctly even for the most simple sentences such as “the professor lectures”. For the above sentence, the parser can produce the correct result when it runs for the first time. But if one runs try-again, it will be stuck in an infinite loop because the evaluation of (parse-prepositional-phrase) always fails. The failure will cause the evaluation of (list 'verb-phrase (parse-verb-phrase) (parse-prepositional-phrase)), which in turn will cause the the evaluation of (parse-prepositional-phrase) again. Moreover, if the sentence contains a misspelled word, the parser will be stuck too.

Changing the order of expressions in the amb would make things even worse. It would fail for the above simple sentence even in the first round.

The procedure (parse-sentence) contains (list 'sentence (parse-noun-phrase) (parse-verb-phrase)). The evaluator will evaluate (parse-verb-phrase) first, if it evaluates the arguments of list from right to left. This will fail because a sentence starts with a noun phrase, not a verb phrase.

The cat has three possibilities: with the professor, the student, or the class. Either the professor or the student is in the class. So there are 6 possibilities. However, if the cat is with the student, the word “class” must belong to the student because it is between the words “student” and “cat”. Thus there are 5 ways to parse the sentence.

1. With the cat, the professor lectures in the class. This means
   • The cat is with the professor.
   • The professor is in the class.
2. The professor lectures in the class that has the cat. This means
   • The cat is with the class.
   • The professor is in the class.
3. With the cat, the professor lectures to student who is in the class. This means
   • The cat is with the professor.
   • The student is in the class.
4. The professor lectures to the student in the class who has the cat. This means
   • The cat is with the student.
   • The student is in the class.
5. The professor lectures to student who is in the class that has the cat. This means
   • The cat is with the class.
   • The student is in the class.

(define (safe? positions)
  (define (two-queens-safe? q1 q2)
    (let ((row1 (car q1))
          (col1 (cadr q1))
          (row2 (car q2))
          (col2 (cadr q2)))
      (and (not (= row1 row2))
           (not (= (- col2 col1)
                   (abs (- row2 row1)))))))
  (let ((new-queen (list (last positions) (length positions))))
    (define (check col positions)
      (cond ((null? (cdr positions)) true)
            ((two-queens-safe? (list (car positions) col)
                               new-queen)
             (check (+ col 1) (cdr positions)))
            (else false)))
    (check 1 positions)))

(define (eight-queens)
  (let ((q1 (amb 1 2 3 4 5 6 7 8)))
    (let ((q2 (amb 1 2 3 4 5 6 7 8)))
      (require (safe? (list q1 q2)))
      (let ((q3 (amb 1 2 3 4 5 6 7 8)))
        (require (safe? (list q1 q2 q3)))
        (let ((q4 (amb 1 2 3 4 5 6 7 8)))
          (require (safe? (list q1 q2 q3 q4)))
          (let ((q5 (amb 1 2 3 4 5 6 7 8)))
            (require (safe? (list q1 q2 q3 q4 q5)))
            (let ((q6 (amb 1 2 3 4 5 6 7 8)))
              (require (safe? (list q1 q2 q3 q4 q5 q6)))
              (let ((q7 (amb 1 2 3 4 5 6 7 8)))
                (require
                 (safe? (list q1 q2 q3 q4 q5 q6 q7)))
                (let ((q8 (amb 1 2 3 4 5 6 7 8)))
                  (let ((queens (list q1 q2 q3 q4 q5 q6 q7 q8)))
                    (require (safe? queens))
                    queens))))))))))

(define (yacht-puzzle)
; father = (last-name daughter yacht)
  (define (last-name f) (car f))
  (define (daughter f) (cadr f))
  (define (yacht f) (caddr f))
  (define (different? f) (not (eq? (daughter f) (yacht f))))
  (define (father-of d fathers)
    (if (eq? d (daughter (car fathers)))
        (car fathers)
        (father-of d (cdr fathers))))
  (let ((Downing (list 'Downing
                       (amb 'Gabrielle 'Lorna 'Mary 'Rosalind)
                       'Melissa))
        (Hall (list 'Hall
                    (amb 'Gabrielle 'Lorna 'Mary 'Melissa)
                    'Rosalind))
        (Hood (list 'Hood 'Melissa 'Gabrielle))
        (Moore (list 'Moore 'Mary 'Lorna))
        (Parker (list 'Parker
                      (amb 'Gabrielle 'Lorna 'Mary 'Melissa
                           'Rosalind)
                      (amb 'Gabrielle 'Lorna 'Mary 'Melissa
                           'Rosalind))))
    (require (different? Parker))
    (let ((fathers (list Downing Hall Hood Moore Parker)))
      (define (map proc a)
        (if (null? a)
            '()
            (cons (proc (car a)) (map proc (cdr a)))))
      (let ((daughters (map daughter fathers)))
        (require (distinct? daughters))
        (let ((yachts (map yacht fathers)))
          (require (distinct? yachts))
          (require (eq? (daughter Parker)
                        (yacht (father-of 'Gabrielle fathers))))
          fathers)))))

Lorna is a daughter of Downing.

; father  daught    yacht
((downing lorna     melissa)
 (hall    gabrielle rosalind)
 (hood    melissa   gabrielle)
 (moore   mary      lorna)
 (parker  rosalind  mary))

The following code does not assume Mary’s last name is Moore.

(define (yacht-puzzle-2)
  ......
        (Moore (list 'Moore
                     (amb 'Gabrielle 'Mary 'Melissa 'Rosalind)
                     'Lorna))
  ......
)

There are two solutions. The first is the same as before. The second is,

; father  daught   yacht
((downing rosalind  melissa)
 (hall    mary      rosalind)
 (hood    melissa   gabrielle)
 (moore   gabrielle lorna)
 (parker  lorna     mary)))

(define (liars)
  (define (xor a b)
    (or (and a (not b)) (and (not a) b)))
  (let ((betty (amb 1 2 3 4 5))
        (ethel (amb 1 2 3 4 5))
        (joan (amb 1 2 3 4 5))
        (kitty (amb 1 2 3 4 5))
        (mary (amb 1 2 3 4 5)))
    (require
     (distinct? (list betty ethel joan kitty mary)))
    (require (xor (= kitty 2) (= betty 3)))
    (require (xor (= ethel 1) (= joan 2)))
    (require (xor (= joan 3) (= ethel 5)))
    (require (xor (= kitty 2) (= mary 4)))
    (require (xor (= mary 4) (= betty 1)))
    (list (list 'betty betty)
          (list 'ethel ethel)
          (list 'joan joan)
          (list 'kitty kitty)
          (list 'mary mary))))

; the result
((betty 3) (ethel 5) (joan 2) (kitty 1) (mary 4))

The next-permutation procedure below is coded according to a Wikipedia article on permutation.

(define (next-permutation a-list)
  (let ((n (length a-list)))
    (define (index-1)
      (define (find-index-1 k)
        (cond ((< k 0)
               '()) ; no such index exists
              ((< (list-ref a-list k) (list-ref a-list (+ k 1)))
               k)
              (else
               (find-index-1 (- k 1)))))
      (find-index-1 (- n 2)))
    (let ((j (index-1)))
      (define (index-2)
        (define (find-index-2 k)
          (if (< (list-ref a-list j) (list-ref a-list k))
              k
              (find-index-2 (- k 1))))
        (find-index-2 (- n 1)))
      (if (null? j)
          '() ; the last permutation
          (let ((l (index-2)))
            (let ((new-list (list-swap a-list j l)))
              (append (list-head new-list (+ j 1))
                      (reverse (list-tail new-list (+ j 1))))))))))

(define (list-swap a i j)
  (if (= i j)
      a
      (let ((ii (min i j))
            (jj (max i j)))
        (let ((ai (list-ref a ii))
              (aj (list-ref a jj)))
          (append (sublist a 0 ii)
                  (list aj)
                  (sublist a (+ ii 1) jj)
                  (list ai)
                  (list-tail a (+ jj 1)))))))

(define (multiple-dwelling)
  (define (try plan)
    (if (pair? plan) ; valid?
        (begin
          (if (good? plan)
              (begin
                (display (map (lambda (name floor)
                                (list name floor))
                              '(baker cooper fletcher miller smith)
                              plan))
                (newline)))
          (try (next-permutation plan)))))
  (define (good? plan)
    (let ((baker (first plan))
          (cooper (second plan))
          (fletcher (third plan))
          (miller (fourth plan))
          (smith (fifth plan)))
      (and (> miller cooper)
           (not (= (abs (- fletcher cooper)) 1))
           (not (= (abs (- smith fletcher)) 1))
           (not (= baker 5))
           (not (= cooper 1))
           (not (= fletcher 1))
           (not (= fletcher 5)))))
  (try '(1 2 3 4 5)))

The following code is about 20 times faster than the original code.

(define (multiple-dwelling)
  (let ((cooper (amb 2 3 4 5))
        (miller (amb 1 2 3 4 5)))
    (require (> miller cooper))
    (let ((fletcher (amb 2 3 4)))
      (require (not (= (abs (- fletcher cooper)) 1)))
      (let ((smith (amb 1 2 3 4 5)))
        (require (not (= (abs (- smith fletcher)) 1)))
        (let ((baker (amb 1 2 3 4)))
          (require
           (distinct? (list baker cooper fletcher miller smith)))
          (list (list 'baker baker)
                (list 'cooper cooper)
                (list 'fletcher fletcher)
                (list 'miller miller)
                (list 'smith smith)))))))