Scheme - 超言語的抽象(Schemeの変形 - 非決定性計算(非決定性プログラムの例(自然言語の構文解析(形容詞の追加))))

計算機プログラムの構造と解釈[第2版]
(翔泳社)
ハロルド エイブルソン (著) ジュリー サスマン (著)
ジェラルド・ジェイ サスマン (著)
Harold Abelson (原著) Julie Sussman (原著)
Gerald Jay Sussman (原著) 和田 英一 (翻訳)

開発環境

• OS X Yosemite - Apple (OS)
• Emacs (CUI)、BBEdit - Bare Bones Software, Inc. (GUI) (Text Editor)
• Scheme (プログラミング言語)
• Gauche (処理系)

計算機プログラムの構造と解釈[第2版](ハロルド エイブルソン (著)、ジュリー サスマン (著)、ジェラルド・ジェイ サスマン (著)、Harold Abelson (原著)、Julie Sussman (原著)、Gerald Jay Sussman (原著)、和田 英一 (翻訳)、翔泳社、原書: Structure and Interpretation of Computer Programs (MIT Electrical Engineering and Computer Science)(SICP))の4(超言語的抽象)、4.3(Schemeの変形 - 非決定性計算)、4.3.3(非決定性プログラムの例)、自然言語の構文解析、問題 4.48.を解いてみる。

その他参考書籍

• Instructor's Manual to Accompany Structure & Interpretation of Computer Programs
• プログラミングGauche (Kahuaプロジェクト (著), 川合 史朗 (監修), オライリージャパン)

問題 4.48.

コード(BBEdit, Emacs)

;; 形容詞を追加
(define nouns '(noun cat))

(define verbs '(verb eats))

(define articles '(article the))

(define prepositions '(prep for to in by with))

(define adjectives '(adj pretty))

(define (parse-sentence)
  (list 'sentence)
  (parse-noun-phrase)
  (parse-verb-phrase))

(define (parse-article-phrase)
  (define (maybe-extend article-phrase)
    (amb article-phrase
         (maybe-extend (list 'article-phrase
                             article-phrase
                             (parse-word adjectives)))))
  (maybe-extend (parse-word articles)))

(define (parse-simple-noun-phrase)
  (list 'simple-noun-phrase
        (parse-article-phrase)
        (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 (simple-noun-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)))

(define (parse-prepositional-phrase)
  (list 'prep-phrase
        (parse-word prepositions)
        (parse-noun-phrase)))
                             
(define *unparsed* '())

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