(in-package :mops)

(export 'find-commonalities)

(defun find-commonalities (mop1 mop2)
  (cons
   (find-common-absts mop1 mop2)
   (find-common-slots mop1 mop2)))

(defun find-common-absts (mop1 mop2)
 (remove-redundant-absts
   (intersection (all-absts-of mop1)
                 (all-absts-of mop2))))

(defun find-common-slots (mop1 mop2)
  (loop for role in (union (roles-of mop1) (roles-of mop2))
      for filler1 = (role-filler mop1 role)
      for filler2 = (role-filler mop2 role)
      for absts = (find-common-absts filler1 filler2)
      unless (null absts)
      collect (cons role absts)))

(defun roles-of (mop)
  (mapcar #'slot-role (slots-of mop)))