SICP/ex-4_45-xx.scm

(load "util.scm")
(load "misc/amb.scm")

(define nouns '(noun student professor cat class))
(define verbs '(verb studies lectures eats sleeps))
(define articles '(article the a))

(define *unparsed* '())

; By default mit-scheme evaluates the list elements from last to first element.
; That means with the parse-implementation in the book the later part of a
; phrase is evaluated first which does not yield any results. To force the
; correct order we use a let expression and then built the return list from the
; let variables.

(define (parse-sentence)
  (let* ((noun-phrase (parse-noun-phrase))
         (verb-phrase (parse-word verbs)))
    (list 'sentence noun-phrase verb-phrase)))

(define (parse-noun-phrase)
  (let* ((article-phrase (parse-word articles))
         (noun-phrase (parse-word nouns)))
  (list 'noun-phrase article-phrase noun-phrase)))

(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))

(display "\nex-4.45 - parse-sentence\n")

(my-assert (parse '(the cat eats))
        '(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")