Compare commits

...

2 Commits

2 changed files with 106 additions and 57 deletions

View File

@ -1,28 +1,22 @@
(define nouns '(noun student professor cat class))
(define verbs '(verb studies lectures eats sleeps))
(define articles '(article the a))
(define prepositions '(prep for to in by with))
;; output of parse
'(sentence (noun-phrase (article the) (noun cat))
(verb eats))
(define (log message level)
(define (output message level)
(if (= level 0) message
(cons '_ (output message (- level 1)))))
(display (output message level))
(newline))
(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 (parse-word word-list)
(define (parse-word word-list level)
(log (list 'word-list word-list '*unparsed* *unparsed*) level)
(require (not (null? *unparsed*)))
(require (memq (car *unparsed*) (cdr word-list)))
(let ((found-word (car *unparsed*)))
(set! *unparsed* (cdr *unparsed*))
(log (list (car word-list) found-word) level)
(list (car word-list) found-word)))
(define *unparsed* '())
@ -33,43 +27,61 @@
(require (null? *unparsed*))
sent))
;: (parse '(the cat eats))
;; output of parse
'(sentence (noun-phrase (article the) (noun cat)) (verb eats))
(define prepositions '(prep for to in by with))
(define (parse-prepositional-phrase)
(list 'prep-phrase
(parse-word prepositions)
(parse-noun-phrase)))
(define (parse-sentence)
(list 'sentence
(parse-noun-phrase)
(parse-verb-phrase)))
;;(parse-noun-phrase)
(parse-verb-phrase 1)))
(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)))
(define (parse-simple-noun-phrase)
(list 'simple-noun-phrase
(parse-word articles)
(parse-word nouns)))
(define (parse-noun-phrase)
(define (parse-noun-phrase level)
(define (maybe-extend noun-phrase)
(log '(maybe-extend-noun) level)
(amb noun-phrase
(maybe-extend (list 'noun-phrase
noun-phrase
(parse-prepositional-phrase)))))
(maybe-extend (parse-simple-noun-phrase)))
(parse-prepositional-phrase level)))))
(log '(parse-noun-phrase) level)
(maybe-extend (parse-simple-noun-phrase level)))
;; Note maybe-extend is tail recursive
(define (parse-verb-phrase level)
(define (maybe-extend verb-phrase)
(log '(maybe-extend-verb-phrase) level)
(amb verb-phrase
(maybe-extend (list 'verb-phrase
verb-phrase
(parse-prepositional-phrase level)))))
(log '(parse-verb-phrase) level)
(maybe-extend (parse-word verbs level)))
(define (parse-simple-noun-phrase level)
(log '(parse-simple-noun) level)
(list 'simple-noun-phrase
(parse-word articles level)
(parse-word nouns level)))
(define (parse-prepositional-phrase level)
(log '(parse-prep) level)
(list 'prep-phrase
(parse-word prepositions level)
(parse-noun-phrase level)))
;; Note: not tail recursive
(define (parse-verb-phrase level)
(log '(parse-verb-phrase) level)
(amb (parse-word verbs level)
(list 'verb-phrase
(parse-verb-phrase (+ level 1))
(parse-prepositional-phrase level))))
;; Exercise 4.45: Output of (parse '(the professor lectures to the student in the class with the cat))
@ -139,15 +151,51 @@
(sentence
(simple-noun-phrase (article the) (noun professor))
(verb-phrase (verb lectures)
(prep-phrase (prep to)
(noun-phrase (simple-noun-phrase (article the) (noun student))
(prep-phrase (prep in)
(noun-phrase
(simple-noun-phrase (article the)
(noun class))
(prep-phrase (prep with)
(simple-noun-phrase
(article the)
(noun cat)))))))))
(verb-phrase
(verb lectures)
(prep-phrase (prep to)
(noun-phrase (simple-noun-phrase (article the) (noun student))
(prep-phrase (prep in)
(noun-phrase
(simple-noun-phrase (article the)
(noun class))
(prep-phrase (prep with)
(simple-noun-phrase
(article the)
(noun cat)))))))))
;; The professor lectures to the student, who is in the class with the cat
;; Exercise 4.46
;; If amb evaluated its arguments in any order other than
;; left-to-right, then the recursive maybe-extend rules would never
;; terminate, as the second argument is a recursive call to the
;; procedure. We rely on the recursion stopping at each decision
;; point.
;;
;; Also, since parse has side-effects (namely, it removes a word from
;; the input), it is important that we parse the different parts of
;; the sentence in the correct order.
;; Exercise 4.47
(define (parse-verb-phrase level)
(log (list 'parse-verb-phrase level))
(amb (parse-word verbs)
(list 'verb-phrase
(parse-verb-phrase (+ level 1))
(parse-prepositional-phrase (+ level 1)))))
;; In this case, if (parse-word verbs) fails, then we evaluate the 2nd
;; argument, which calls parse-verb-phrase recursively, creating a new
;; amb, which tries (parse-word verbs), which still fails. In the
;; orinal procedure, we evaluate (parse-word verbs) once and bind it
;; to verb-phrase. We then keep extending the phrase until it either
;; succeeds or fails. If it fails, the whole amb call fails. The
;; version here never fails because it keeps calling parse-verb-phrase.
;; If we swap the order of the clauses in the amb, then we get an
;; infinite loop, as the first clause immediately calls
;; parse-verb-phrase recursively. There is nothing to limit this
;; recursion.

View File

@ -209,6 +209,7 @@
(begin
(newline)
(display ";;; Starting a new problem ")
(newline)
(set! start-time (current-process-milliseconds))
(ambeval input
env