#+Title: Forward Chaining Inference with Common Lisp
#+AUTHOR: Sam Flint
#+EMAIL: swflint@flintfam.org
#+DATE: \today
#+INFOJS_OPT: view:info toc:nil path:http://flintfam.org/org-info.js
#+OPTIONS: toc:nil H:5 ':t *:t
#+PROPERTY: noweb no-export
#+PROPERTY: comments noweb
#+LATEX_HEADER: \usepackage[color]{showkeys}
#+LATEX_HEADER: \parskip=5pt
#+LATEX_HEADER: \lstset{texcl=true,breaklines=true,columns=fullflexible,frame=lines,literate={lambda}{$\lambda$}{1} {set}{$\gets$}1 {setq}{$\gets$}1 {setf}{$\gets$}1 {<=}{$\leq$}1 {>=}{$\geq$}1}

#+BEGIN_abstract
Just for kicks, I'm going to build a forward chaining inference system
using Common Lisp.  This is going to be a challenge, but I'd like to
do it in part to expand my knowledge, and also to build a
free-software knowledge representation system that works well and is
adaptable for various purposes.
#+END_abstract

#+TOC: headlines 3
#+TOC: listings

* Requirements and Package Definition
  :PROPERTIES:
  :ID:       2873e421-71c4-45fb-997c-0759918b72ea
  :END:

  This system requires very little in the way of outside packages,
  only one, in fact, ~optima~, a very high-power pattern matching
  library, used to implement the matching portion of the system.

#+Caption: Requirements and Package Definition
#+Name: package-definition
#+BEGIN_SRC lisp
  (defpackage #:forward-chainer
    (:use #:cl
          #:optima
          #:fare-quasiquote-optima
          #:fare-quasiquote-readtable)
    (:export #:assert-knowledge
             #:assert-rule
             #:query-knowledge))

  (in-package #:forward-chainer)
  (named-readtables:in-readtable :fare-quasiquote)
#+END_SRC

* Knowledge Database
  :PROPERTIES:
  :ID:       5ce85cf4-4d51-4cae-a179-22cfd10fefcb
  :END:

  Two of the most important parts of the forward-chainer are the
  knowledge and rules database.  Both of these are lists of lists,
  used to provide knowledge management.

#+Caption: Knowledge Database
#+Name: knowledge-database
#+BEGIN_SRC lisp
  (defvar *knowledge-database* '()
    "Knowledge Database, a list of lists.")

  (defvar *rules* '()
    "Rules list, each rule is a cons of a name and a rule object.")
#+END_SRC

* The ~assert-knowledge~ Macro
  :PROPERTIES:
  :ID:       93803225-516c-4162-a7b8-2ee5c8c0c28e
  :END:

#+Caption: The Assert Knowledge Macro
#+Name: assert-knowledge
#+BEGIN_SRC lisp
  (defmacro assert-knowledge ((name &rest arguments))
    (let ((knowledge `'(,name ,@arguments)))
      `(pushnew ,knowledge *knowledge-database* :test #'equalp)))
#+END_SRC

* The ~remove-knowledge~ Macro
  :PROPERTIES:
  :ID:       a5f67bbb-5639-4e6e-8260-bd84840acd76
  :END:

#+Caption: The Remove Knowledge Macro
#+Name: remove-knowledge
#+BEGIN_SRC lisp
  (defmacro remove-knowledge ((name &rest arguments))
    (let ((knowledge `'(,name ,@arguments)))
      `(delete ,knowledge *knowledge-database* :test #'equalp)))
#+END_SRC

* The ~assert-rule~ Macro
  :PROPERTIES:
  :ID:       13715783-de22-4fb5-be95-a2bd106fb2b3
  :END:

#+Caption: The Assert Rule macro
#+Name: assert-rule
#+BEGIN_SRC lisp
  (defmacro assert-rule ((name &rest arguments) matcher &rest actions)
    (declare (ignorable name arguments matcher actions))
    )
#+END_SRC

* The ~query-knowledge~ Macro
  :PROPERTIES:
  :ID:       8172a253-0115-4bc1-9ec8-fff8873c29b5
  :END:

#+Caption: The Query Knowledge Macro
#+Name: query-knowledge
#+BEGIN_SRC lisp
  (defmacro query-knowledge ((name &rest arguments))
    (let* ((match-variables (remove-if (lambda (var)
                                         (not (and (typep var 'symbol) (string= "?" (subseq (format nil "~a" var) 0 1)))))
                                       arguments))
           (matcher `'(,name ,@arguments)))
      `(map 'list #'(lambda (knowledge)
                      (match knowledge ',matcher))
            ,*knowledge-database*)))
#+END_SRC

* Putting it together

#+Caption: Putting things together
#+Name: put-together
#+BEGIN_SRC lisp :tangle "forward-chainer.lisp"
  ;;; forward-chainer.lisp

  <<package-definition>>

  ;; Begin main forward-chainer

  <<assert-knowledge>>

  <<remove-knowledge>>

  <<assert-rule>>

  <<query-knowledge>>

  <<knowledge-database>>

  ;;; End of "forward-chainer.lisp"
#+END_SRC

#+RESULTS: put-together
: *RULES*