Better solution for fathers and daughters

Still not right: try-again gives an error.

mceval/amb-fathers-daughters.rkt

@@ -0,0 +1,40 @@
+;; Exercise 4.42
+
+(define (fathers-daughters)
+
+  (define father car)
+  (define yacht cadr)
+  (define daughter caddr)
+  
+  (define (lookup-daughter f fathers)
+    (daughter (assq f fathers)))
+
+  (define (lookup-yacht f fathers)
+    (yacht (assq f fathers)))
+  
+  (define (lookup-father d fathers)
+    (cond ((null? fathers) '())
+          ((eq? d (daughter (car fathers)))
+           (car (car fathers)))
+          (else (lookup-father d (cdr fathers)))))
+
+  ;; Optimisation.  Put everything we already know in a table.  Each
+  ;; row is father, yacht, daughter.
+  (define fathers
+    (list
+     (list 'moore 'lorna 'mary)
+     (list 'hood 'gabrielle 'melissa)
+     (list 'downing 'melissa (amb 'lorna 'gabriella 'rosalind))
+     (list 'hall 'rosalind (amb 'lorna 'gabrielle))
+     (list 'parker 'mary (amb 'lorna 'gabrielle 'rosalind))))
+
+  (require (distinct? (list (lookup-daughter 'moore fathers)
+                            (lookup-daughter 'hood fathers)
+                            (lookup-daughter 'downing fathers)
+                            (lookup-daughter 'hall fathers)
+                            (lookup-daughter 'parker fathers))))
+  ;; Gabrielle's father owns the yacht named after parker's daughter
+  (require (eq? (lookup-yacht (lookup-father 'gabrielle fathers) fathers)
+                (lookup-daughter 'parker fathers)))
+  fathers)
+

mceval/environment.rkt

@@ -1,5 +1,7 @@
 #lang sicp
 
+(#%require racket/trace)
+
 (#%provide lookup-variable-value
            set-variable-value!
            define-variable!
@@ -156,6 +158,8 @@
 (define primitive-procedures
   (list (list 'car car)
         (list 'cdr cdr)
+        (list 'cadr cadr)
+        (list 'caddr caddr)
         (list 'cons cons)
         (list 'null? null?)
         (list 'list list)
@@ -182,6 +186,8 @@
         (list 'integer? integer?)
         (list 'sqrt sqrt)
         (list 'eq? eq?)
+        (list 'assq assq)
+        (list 'equal? equal?)
         (list 'newline newline)
         (list 'display display)
         ))