From 89c02a59d6f2696a5ae1ebc77298fc8137506415 Mon Sep 17 00:00:00 2001 From: Matthias Benkard Date: Tue, 7 Aug 2007 17:05:22 +0200 Subject: Overload EQUAL and EQUALP for Objective C objects. darcs-hash:6548e8584e8dd49cb17f6055c0cedd6927cba7f1 --- Lisp/utilities.lisp | 82 ++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 75 insertions(+), 7 deletions(-) (limited to 'Lisp/utilities.lisp') diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp index f35a4d8..a82e123 100644 --- a/Lisp/utilities.lisp +++ b/Lisp/utilities.lisp @@ -1,10 +1,78 @@ (in-package #:mulk.objective-cl) -(defun apply-macro (macro-name arg &rest args) - "Because FOREIGN-FUNCALL is a macro. Why, oh why is this?" - (funcall - (compile nil - `(lambda () - (,macro-name ,@(butlast (cons arg args)) - ,@(car (last (cons arg args)))))))) \ No newline at end of file +(defgeneric equal (x y)) +(defgeneric equalp (x y)) + + +(defun truep (b) + (not (or (zerop b) + (null b)))) + + +(defun id-equal (x y) + (declare (type (or id objc-class exception) x y)) + (truep (invoke x :is-equal y))) + + +(defmethod equal (x y) + (cl:equal x y)) + +(defmethod equal ((x id) y) + (id-equal x y)) + +(defmethod equal (x (y id)) + (id-equal x y)) + +(defmethod equal ((x objc-class) y) + (id-equal x y)) + +(defmethod equal (x (y objc-class)) + (id-equal x y)) + +(defmethod equal ((x exception) y) + (id-equal x y)) + +(defmethod equal (x (y exception)) + (id-equal x y)) + +(defmethod equal ((x selector) (y selector)) + (equal (selector-name x) (selector-name y))) + +(defmethod equal ((x selector) (y string)) + (equal (selector-name x) y)) + +(defmethod equal ((x string) (y selector)) + (equal x (selector-name y))) + + +(defmethod equalp (x y) + (cl:equalp x y)) + +(defmethod equalp ((x id) y) + (equal x y)) + +(defmethod equalp (x (y id)) + (equal x y)) + +(defmethod equalp ((x objc-class) y) + (equal x y)) + +(defmethod equalp (x (y objc-class)) + (equal x y)) + +(defmethod equalp ((x exception) y) + (equal x y)) + +(defmethod equalp (x (y exception)) + (equal x y)) + +;; FIXME: Does this even make sense? +(defmethod equalp ((x selector) (y selector)) + (equalp (selector-name x) (selector-name y))) + +(defmethod equalp ((x selector) (y string)) + (equalp (selector-name x) y)) + +(defmethod equalp ((x string) (y selector)) + (equalp x (selector-name y))) -- cgit v1.2.3