Implement till 4.49 - finally progress again

This commit is contained in:
2021-02-22 14:04:41 -05:00
parent 2228572872
commit 320e620a30
2 changed files with 90 additions and 28 deletions

View File

@@ -23,16 +23,8 @@
(define nouns '(noun student professor cat class)) (define nouns '(noun student professor cat class))
(define verbs '(verb studies lectures eats sleeps)) (define verbs '(verb studies lectures eats sleeps))
(define articles '(article the a)) (define articles '(article the a))
(define prepositions '(prep for to in by with))
(define (parse-sentence) (define adjectives '(adjective pretty kind mean bad))
(list 'sentence
(parse-noun-phrase)
(parse-word verbs)))
(define (parse-noun-phrase)
(list 'noun-phrase
(parse-word articles)
(parse-word nouns)))
(define (parse-word word-list) (define (parse-word word-list)
(require (not (null? *unparsed*))) (require (not (null? *unparsed*)))
@@ -41,15 +33,6 @@
(set! *unparsed* (cdr *unparsed*)) (set! *unparsed* (cdr *unparsed*))
(list (car word-list) found-word))) (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) (define (parse-prepositional-phrase)
(list 'prep-phrase (list 'prep-phrase
(parse-word prepositions) (parse-word prepositions)
@@ -60,6 +43,14 @@
(parse-noun-phrase) (parse-noun-phrase)
(parse-verb-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 (parse-verb-phrase)
(define (maybe-extend verb-phrase) (define (maybe-extend verb-phrase)
(amb verb-phrase (amb verb-phrase
@@ -73,13 +64,12 @@
(parse-word articles) (parse-word articles)
(parse-word nouns))) (parse-word nouns)))
(define (parse-noun-phrase) (define *unparsed* '())
(define (maybe-extend noun-phrase) (define (parse input)
(amb noun-phrase (set! *unparsed* input)
(maybe-extend (list 'noun-phrase (let ((sent (parse-sentence)))
noun-phrase (require (null? *unparsed*))
(parse-prepositional-phrase))))) sent))
(maybe-extend (parse-simple-noun-phrase)))
(parse '(the professor lectures to the student with the cat)) (parse '(the professor lectures to the student with the cat))
)) ))
@@ -129,7 +119,7 @@
(prep in) (simple-noun-phrase (article the) (noun class)))) (prep in) (simple-noun-phrase (article the) (noun class))))
(prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))) (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 '(sentence
(simple-noun-phrase (article the) (noun professor)) (simple-noun-phrase (article the) (noun professor))
@@ -144,7 +134,7 @@
(prep-phrase (prep with) (prep-phrase (prep with)
(simple-noun-phrase (article the) (noun cat))))))) (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 '(sentence
(simple-noun-phrase (article the) (noun professor)) (simple-noun-phrase (article the) (noun professor))
@@ -194,3 +184,74 @@
(display "[answered]\n") (display "[answered]\n")
(display "\nex-4.46 - evaluation-order\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")

View File

@@ -621,6 +621,7 @@
(list 'integer? integer?) (list 'integer? integer?)
(list 'sqrt sqrt) (list 'sqrt sqrt)
(list 'eq? eq?) (list 'eq? eq?)
(list 'newline newline)
;; more primitives ;; more primitives
)) ))