Inference Collection Prototype

I have been working on the prototype of the Inference Collection. It is now working for data-driven (forward chaining) rules. This includes existential (i,e, no, any, not all, all) joins, binding joins, and constraints.
To keep the code simpler, the prototype does not include the syntax elements (e.g. define-rule). Instead, the rule instances are created directly. I have protptyped the syntax elements separately and need to merge them in at some point. I will likely wait until after I get goal-driven (backward chaining) rules working.
The rule network consists of three basic type of nodes:

• Match nodes
• Join nodes
• Rule nodes

The simple data-driven rule set I have been using is for finding ancestors. It only uses binding joins. The rule set, using the define-rule format is:

(define-ruleset ancestors)

(define-rule (initialize ancestors)
  ?start <- (start)  
 -->
  (retract ?start)
  (printf "Please enter the first name of a~n")
  (printf "person whose ancestors you would~n")
  (printf "like to find:~n")
  (assert `(request ,(read))))

(define-rule (print-ancestor ancestors)
  ?request <- (request ?name)  
  (parents ?name ?mother ?father)  
 -->
  (retract ?request)
  (when ?mother
      (printf "~a is an ancestor via ~a~n" ?mother ?name)
      (assert `(request ,?mother)))
  (when ?father
      (printf "~a is an ancestor via ~a~n" ?father ?name)
      (assert `(request ,?father))))

(define-rule (remove-request ancestors)
  ?request <- (request ?) 
 -->
  (remove ?request))

When this rule set is activated, it results in a rule network with 4 match nodes (1 for each precondition clause), 5 join nodes (1 initial join and 1 for each precondition clause), and 3 rule nodes (1 for each rule).

A more complex ruleset that includes existential joins is one that solves the Towers of Hanoi problem.

(define-ruleset towers)

(define-rule (rule-1 towers)
    - (ring ? on left)
    - (ring ? on middle)
  -->
    (printf "Problem solved!~n"))

(define-rule (rule-2 towers)
    - (move)
      (ring ?ring on (?peg (not (eq? ?peg 'right))))
    - (ring (?ring-1 (> ?ring-1 ?ring))
            on (?peg-1 (not (eq? ?peg-1 'right))))
  -->
    (assert `(move ?ring from ?peg to right)))

(define-rule (rule-3 towers)
      ?move-assertion <- (move ?ring from ?from to ?to)
      ?ring-assertion <- (ring ?ring on ?from)
    - (ring (?ring-1 (< ?ring-1 ?ring)) on ?from)
    - (ring (?ring-2 (< ?ring-2 ?ring)) on ?to)
  -->
    (printf "Move ring ~a from ~a to ~a.~n" ?ring ?from ?to)
    (modify ?ring-assertion `(ring ,?ring on ,?to))
    (retract ?move-assertion))

(define (rule-4 towers)
      ?move-assertion <- (move ?ring from ?from to ?to)
      (peg (?other (not (memq ?other (list ?from ?to)))))
      (ring (?ring-1 (< ?ring-1 ?ring))
            on (?peg-1 (not (eq? ?peg-1 ?other))))
    - (ring (?ring-2 (< ?ring-1 ?ring-2 ?ring))
            on (?peg-2 (not (eq? ?peg-2 ?other))))
  -->
    (modify ?move-assertion `(move ,?ring-1 from ,?peg-1 to ,?other)))))

I will post a separate entry explaining this ruleset.