summaryrefslogtreecommitdiff
path: root/Lisp
diff options
context:
space:
mode:
Diffstat (limited to 'Lisp')
-rw-r--r--Lisp/defpackage.lisp6
-rw-r--r--Lisp/tests.lisp20
-rw-r--r--Lisp/utilities.lisp82
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)))