diff options
Diffstat (limited to 'Lisp')
| -rw-r--r-- | Lisp/defpackage.lisp | 6 | ||||
| -rw-r--r-- | Lisp/tests.lisp | 20 | ||||
| -rw-r--r-- | Lisp/utilities.lisp | 82 |
3 files changed, 101 insertions, 7 deletions
diff --git a/Lisp/defpackage.lisp b/Lisp/defpackage.lisp index c3fcc2e..6fd992a 100644 --- a/Lisp/defpackage.lisp +++ b/Lisp/defpackage.lisp @@ -1,6 +1,8 @@ (defpackage #:mulk.objective-cl (:nicknames #:objcl #:objective-cl #:mulk.objcl) (:use #:cl #:cffi #:split-sequence) + (:shadow #:equal + #:equalp) ;; Functions (:export #:initialise-runtime @@ -11,6 +13,10 @@ #:find-objc-class #:find-selector + ;; Generic functions + #:equal + #:equalp + ;; Special variables #:*trace-method-calls* diff --git a/Lisp/tests.lisp b/Lisp/tests.lisp new file mode 100644 index 0000000..7c2b496 --- /dev/null +++ b/Lisp/tests.lisp @@ -0,0 +1,20 @@ +(defpackage #:mulk.objective-cl.tests + (:use #:cl #:lift #:mulk.objective-cl)) +(in-package #:mulk.objective-cl.tests) + + +(defun run-all-tests () + (run-tests :suite 'objective-cl)) + + +(deftestsuite objective-cl () + ()) + + +(deftestsuite method-invocation (objective-cl) + () + (:equality-test #'equal) + (:tests + ((ensure (functionp (fn #'+ _ 10)))) + ((ensure-same (mapcar (fn (cons _ _)) '(1 2 3)) + '((1 . 1) (2 . 2) (3 . 3)))))) 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))) |