unification.scm

;;; Unification
;;; Mike Wilson, cmikewilson@gmail.com
;;; Created 202002

(define (unify g1 g2)
  (cond ((eq? g1 g2) g1)
        ((null? g1) g2)
        ((null? g2) g1)
        ((and (pair? g1) (pair? g2))
         (and-map unify g1 g2))
        (else #f)))

(define (and-map f . args)
  (let loop ((args args) (results '()))
    (if (null? args)
        (reverse results)
        (let ((arg (apply f (map car args))))
          (and arg
               (loop (map cdr args) (cons arg results)))))))

(define-unit-tests 'unify
  (check (unify '() '()) => '())
  (check (unify '() '((cat np))) => '((cat np)))
  (check (unify '((cat np)) '((cat np)))) => '((cat np))
  (check (unify '((cat np) (number s)) '((cat np) (person 3)))
	 => '((cat np) (number s) (person 3))))