Start to work on 4.45

ex-4_35-44.scm

@@ -331,6 +331,3 @@
 
 (my-assert (queens) '(4 2 7 3 6 8 5 1))
 
-(display "\nex-4.45\n")
-
-

ex-4_45-xx.scm

@@ -0,0 +1,56 @@
+(load "util.scm")
+(load "misc/amb.scm")
+
+(define nouns '(noun cat student professor class))
+(define verbs '(verb eats studies lectures sleeps))
+(define articles '(article the a))
+(define prepositions '(prep for to in by with))
+
+(define *unparsed* '())
+
+(define (parse-noun-phrase)
+  (list 'noun-phrase
+        (parse-word articles)
+        (parse-word nouns)))
+
+(define (parse-word word-list)
+  (require (not (null? *unparsed*)))
+  (require (memq (car *unparsed*) (cdr word-list)))
+  (let ((found-word (car *unparsed*)))
+    (set! *unparsed* (cdr *unparsed*))
+    (list (car word-list) found-word)))
+
+(define (parse input)
+  (set! *unparsed* input)
+  (let ((sent (parse-sentence)))
+    (require (null? *unparsed*))
+    sent))
+
+(define (parse-prepositional-phrase)
+  (list 'prep-phrase
+        (parse-word prepositions)
+        (parse-noun-phrase)))
+
+(define (parse-sentence)
+  (list 'sentence
+         (parse-noun-phrase)
+         (parse-verb-phrase)))
+
+(define (parse-verb-phrase)
+  (define (maybe-extend verb-phrase)
+    (amb verb-phrase
+         (maybe-extend (list 'verb-phrase
+                             verb-phrase
+                             (parse-prepositional-phrase)))))
+  (maybe-extend (parse-word verbs)))
+
+(display "\nex-4.45 - parse-sentence\n")
+
+;(sentence (noun-phrase (article the) (noun cat)) (verb eats))
+
+;'(The professor lectures to the student in the class with the cat)
+
+
+(display "\nex-4.46\n")
+
+

misc/amb.scm

@@ -158,6 +158,8 @@
     (assert (all-different? kitty betty ethel joan mary))
     (map list '(kitty betty ethel joan mary) (list kitty betty ethel joan mary))))
 
+(define (require p)
+  (if (not p) (amb)))
 
 ;;; to show cpu time
 (define-syntax cpu-time/sec