;;; PROLOG = Programming in LOGic

;;; Prolog program, two views:
;;;  - computer program
;;;  - collection of true facts

;;; Running Prolog program, two views:
;;;  - execute according to rules of the language
;;;  - trying to prove some hypothesis

;;; Proof technique of Prolog is due to Aristotle (-500)

;;; fact that Aristotle is a man, write: (man aristotle)
;;; hypothesis: (mortal aristotle)
;;; fact:  man(X) -> mortal(X)
;;; sexpr syntax: (implied-by (mortal (_ x)) (man (_ x)))
;;; convention: (_ v) means "logic variable" v
;;;   another way to look at fact:
;;;       forall X, (man(X) -> mortal(X))

;;; Resolution theorem proving:
;;;  Rule Base (list of facts)
;;;    (implied-by (man aristotle))
;;;    (implied-by (mortal (_ x)) (man (_ x)))
;;;  i.e., (implied-by CONSEQUENT PREMISES ...)
;;;  or, as below, just (CONSEQUENT PREMISES...)
;;;  try to prove
;;;    (mortal aristotle)
;;;     matches Fact#2, subproof: show (man aristotle)
;;;       matches Fact#1, done

(define a-facts
  '(((man aristotle))
    ((mortal (_ x)) (dead (_ x)))
    ((dead che-guevara))
    ((mortal (_ x)) (man (_ x)))))

(define prove
  (lambda (hyp facts)
    (try-using-each-fact hyp facts facts)))

(define try-using-each-fact
  (lambda (hyp untried-facts facts)
    (cond ((null? untried-facts) #f) ; return #f = failed to prove
          ((prove-using-fact hyp (car untried-facts) facts))
          (else (try-using-each-fact hyp (cdr untried-facts) facts)))))

(define prove-using-fact
  (lambda (hyp fact facts)
    (let ((consequent (car fact))
          (premises (cdr fact)))
      (unify hyp consequent)
      ...)))

(define logic-var?
  (lambda (s) (and (pair? s) (equal? (car s) '_))))

;;; try to unify two sexprs,
;;; if they fail to unify, return #f
;;; on success, return "binding" of "holes" (_ v) to values,
;;; represented as association list (((_ v) val) ((_ w) val2) ...)

(define unify-v1
  (lambda (s1 s2)
    (cond ((logic-var? s2) `((,s2 ,s1)))
          ((logic-var? s1) `((,s1 ,s2)))
          ((and (not (pair? s1)) (not (pair? s2)))
           (and (equal? s1 s2) ()))
          ((or (not (pair? s1)) (not (pair? s2)))
           #f)
          (else
           (let ((u1 (unify-v1 (car s1) (car s2))))
             (and u1
                  (let ((u2 (unify-v1 (cdr s1) (cdr s2))))
                    (and u2
                         (append u1 u2)))))))))

;;; Oops!  Need to modify to also
;;;  - take alist of existing bindings, vars->vals.
;;;  - return #f or AUGMENTED alist of binding

(define unify
  (lambda (s1 s2 bindings)
    (cond ((logic-var? s2)
           (cond ((assoc s2 bindings)
                  => (lambda (c)
                       (unify s1 (cadr c) bindings)))
                 (else `((,s2 ,s1) ,@bindings))))
          ((logic-var? s1) `((,s1 ,s2)))
          ((and (not (pair? s1)) (not (pair? s2))) ; neither s1/s2 a pair
           (and (equal? s1 s2) bindings))
          ((or (not (pair? s1)) (not (pair? s2))) ; only one s1/s2 a pair
           #f)
          (else ; both s1 & s2 are pairs
           (let ((u1 (unify (car s1) (car s2) bindings)))
             (and u1
                  (unify (cdr s1) (cdr s2) u1)))))))

;;; Continued NEXT EPISODE when we finish writing UNIFY!