From 5ea3cf283fffbc4a2ef9460b94f5c0c16e703d58 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonygarnockjones@gmail.com>
Date: Sat, 25 Apr 2015 14:51:12 -0400
Subject: [PATCH] Non-working backward-chaining experiment; observe one
 specific ancestry relationship.

---
 prospect/examples/forward-chaining.rkt | 42 ++++++++++++++++++++++++++
 1 file changed, 42 insertions(+)

diff --git a/prospect/examples/forward-chaining.rkt b/prospect/examples/forward-chaining.rkt
index bcc0768..7dc3cc1 100644
--- a/prospect/examples/forward-chaining.rkt
+++ b/prospect/examples/forward-chaining.rkt
@@ -97,6 +97,48 @@
        (void)
        (sub `(parent ,? ,?)))
 
+;;;; Backward-chaining, below, doesn't quite work as formulated with
+;;;; this code snippet: the demand-matcher gets confused by wildcard
+;;;; demand from the recursive step. One way out of this might be to
+;;;; avoid patterns quantifying over more than one place at once: to
+;;;; have a process for *all* potential ancestor-queries for a given
+;;;; person, rather than one for each *specific* ancestor-query.
+;;
+;; (spawn-demand-matcher (observe `(ancestor ,(?!) ,(?!)))
+;;                       (advertise `(ancestor ,(?!) ,(?!)))
+;;                       (lambda (A B)
+;;                         (spawn (lambda (e old-facts)
+;;                                  (match e
+;;                                    [(? patch/removed?) (quit)]
+;;                                    [(? patch?)
+;;                                     (define new-facts (matcher-union old-facts (patch-added e)))
+;;                                     (define triples (matcher-project/set new-facts
+;;                                                                          (compile-projection
+;;                                                                           `(,(?!) ,(?!) ,(?!)))))
+;;                                     (printf "Learned new facts: ~v\n" triples)
+;;                                     (transition new-facts
+;;                                                 (when (or (set-member? triples `(parent ,A ,B))
+;;                                                           (for/or ((triple triples))
+;;                                                             (match triple
+;;                                                               [`(ancestor ,C ,(== B))
+;;                                                                (set-member? triples `(parent ,A ,C))]
+;;                                                               [_ #f])))
+;;                                                   (printf "... and as a result, asserting ~v\n"
+;;                                                           `(ancestor ,A ,B))
+;;                                                   (assert `(ancestor ,A ,B))))]
+;;                                    [_ #f]))
+;;                                (matcher-empty)
+;;                                (sub `(parent ,A ,B))
+;;                                (sub `(parent ,A ,?))
+;;                                (sub `(ancestor ,? ,B))
+;;                                (pub `(ancestor ,A ,B)))))
+
+(spawn (lambda (e s)
+         (when (patch? e) (pretty-print-patch e))
+         #f)
+       (void)
+       (sub `(ancestor ebbon douglas)))
+
 (define (after msec thunk)
   (define id (gensym 'after))
   (if (zero? msec)