From 320e620a30ca9cc3503caf1277343b860a819689 Mon Sep 17 00:00:00 2001
From: Felix Martin <mail@felixm.de>
Date: Mon, 22 Feb 2021 14:04:41 -0500
Subject: [PATCH] Implement till 4.49 - finally progress again

---
 ex-4_45-xx.scm        | 117 ++++++++++++++++++++++++++++++++----------
 misc/sicp-ambeval.scm |   1 +
 2 files changed, 90 insertions(+), 28 deletions(-)

diff --git a/ex-4_45-xx.scm b/ex-4_45-xx.scm
index 2ecfdf4..3d735ad 100644
--- a/ex-4_45-xx.scm
+++ b/ex-4_45-xx.scm
@@ -23,16 +23,8 @@
 (define nouns '(noun student professor cat class))
 (define verbs '(verb studies lectures eats sleeps))
 (define articles '(article the a))
-
-(define (parse-sentence)
-  (list 'sentence
-         (parse-noun-phrase)
-         (parse-word verbs)))
-
-(define (parse-noun-phrase)
-  (list 'noun-phrase
-        (parse-word articles)
-        (parse-word nouns)))
+(define prepositions '(prep for to in by with))
+(define adjectives '(adjective pretty kind mean bad))
 
 (define (parse-word word-list)
   (require (not (null? *unparsed*)))
@@ -41,15 +33,6 @@
     (set! *unparsed* (cdr *unparsed*))
     (list (car word-list) found-word)))
 
-(define *unparsed* '())
-(define (parse input)
-  (set! *unparsed* input)
-  (let ((sent (parse-sentence)))
-    (require (null? *unparsed*))
-    sent))
-
-(define prepositions '(prep for to in by with))
-
 (define (parse-prepositional-phrase)
   (list 'prep-phrase
         (parse-word prepositions)
@@ -60,6 +43,14 @@
          (parse-noun-phrase)
          (parse-verb-phrase)))
 
+(define (parse-noun-phrase)
+  (define (maybe-extend noun-phrase)
+    (amb noun-phrase
+         (maybe-extend (list 'noun-phrase
+                             noun-phrase
+                             (parse-prepositional-phrase)))))
+  (maybe-extend (parse-simple-noun-phrase)))
+
 (define (parse-verb-phrase)
   (define (maybe-extend verb-phrase)
     (amb verb-phrase
@@ -73,13 +64,12 @@
         (parse-word articles)
         (parse-word nouns)))
 
-(define (parse-noun-phrase)
-  (define (maybe-extend noun-phrase)
-    (amb noun-phrase
-         (maybe-extend (list 'noun-phrase
-                             noun-phrase
-                             (parse-prepositional-phrase)))))
-  (maybe-extend (parse-simple-noun-phrase)))
+(define *unparsed* '())
+(define (parse input)
+  (set! *unparsed* input)
+  (let ((sent (parse-sentence)))
+    (require (null? *unparsed*))
+    sent))
 
 (parse '(the professor lectures to the student with the cat))
 ))
@@ -129,7 +119,7 @@
          (prep in) (simple-noun-phrase (article the) (noun class))))
      (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))
 
-; The professor lectures (to the student) in the class with the cat.
+; (The professor lectures (to the student) in the class with the cat).
 
 '(sentence
    (simple-noun-phrase (article the) (noun professor))
@@ -144,7 +134,7 @@
          (prep-phrase (prep with)
                       (simple-noun-phrase (article the) (noun cat)))))))
 
-; The professor lectures to the student (in the class with the cat).
+; (The professor lectures to the student (in the class with the cat)).
 
 '(sentence
    (simple-noun-phrase (article the) (noun professor))
@@ -194,3 +184,74 @@
 (display "[answered]\n")
 
 (display "\nex-4.46 - evaluation-order\n")
+
+; Consider the definition of parse sentence. Grammar defines that the
+; noun-phrase comes before the verb-phrase and that is how we ordered the
+; sub-calls to the parser. If the evaluator would read the arguments from right
+; to left it would attempt to parse a verb-phrase first and fail for most
+; sentences (maybe it would work for questions). We could force the correct
+; order by using nested let-expressions to make the code
+; interpreter-independent.
+
+; (define (parse-sentence)
+;   (list 'sentence
+;          (parse-noun-phrase)
+;          (parse-word verbs)))
+
+(display "[answered]\n")
+
+(display "\nex-4.47 - alternative-parse-verb-phrase\n")
+
+; Louis's code results in an endless-loop. The reason is that amb evaluates its
+; arguments in applicative order. That means (parse-verb-phrase) executes
+; recursively.  By parsing the verb-phrase first we avoid this issue. Changing
+; the order of the arguments does not resolve this issue.
+
+; (amball '(begin
+; (define (parse-verb-phrase)
+;   (display *unparsed*) (display "\n")
+;   (amb (parse-word verbs)
+;        (list 'verb-phrase
+;              (parse-verb-phrase)
+;              (parse-prepositional-phrase))))
+; (parse '(the cat eats) ; endless-loop
+; )))
+
+(display "[answered]\n")
+
+(display "\nex-4.48 - parse-other-phrases\n")
+
+ ; Exercise 4.48.  Extend the grammar given above to handle more complex
+ ; sentences. For example, you could extend noun phrases and verb phrases to
+ ; include adjectives and adverbs, or you could handle compound sentences.53
+
+(amball '(begin
+
+(define (parse-simple-noun-phrase)
+  (list 'simple-noun-phrase
+        (parse-word articles)
+        (parse-word nouns)))
+
+(define (parse-adjective-noun-phrase adjective)
+  (amb (list 'adjective-phrase  adjective (parse-word nouns))
+       (list
+         'adjective-phrase
+         adjective
+         (parse-adjective-noun-phrase (parse-word adjectives)))))
+
+(define (parse-simple-noun-phrase)
+  (let ((article (parse-word articles)))
+    (amb (list 'simple-noun-phrase article (parse-word nouns))
+         (list 'adjective-noun-phrase article
+               (parse-adjective-noun-phrase (parse-word adjectives))))))
+
+(parse '(the bad cat eats))))
+
+(assert  (first result)
+         '(sentence (adjective-noun-phrase (article the) (adjective-phrase (adjective bad) (noun cat))) (verb eats)))
+
+(display "\nex-4.49 - generate-sentence\n")
+
+
+(display "\nex-4.50\n")
+
diff --git a/misc/sicp-ambeval.scm b/misc/sicp-ambeval.scm
index 3fd53da..6f695ff 100644
--- a/misc/sicp-ambeval.scm
+++ b/misc/sicp-ambeval.scm
@@ -621,6 +621,7 @@
         (list 'integer? integer?)
         (list 'sqrt sqrt)
         (list 'eq? eq?)
+        (list 'newline newline)
 ;;      more primitives
         ))