summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Lisp/constant-data.lisp1
-rw-r--r--Lisp/init.lisp9
-rw-r--r--Lisp/libobjcl.lisp3
-rw-r--r--Lisp/method-invocation.lisp36
-rw-r--r--Lisp/utilities.lisp6
-rw-r--r--Objective-C/libobjcl.h8
-rw-r--r--Objective-C/libobjcl.m18
-rw-r--r--objective-cl.asd3
8 files changed, 56 insertions, 28 deletions
diff --git a/Lisp/constant-data.lisp b/Lisp/constant-data.lisp
index f936908..7922c4f 100644
--- a/Lisp/constant-data.lisp
+++ b/Lisp/constant-data.lisp
@@ -17,6 +17,7 @@
(defconstant +pessimistic-allocation-size+
(cffi:foreign-type-size +pessimistic-allocation-type+))
+
;;;; (@* "The constant data")
;;; Copied from objc-api.h
;;; Probably ought to be generated by C code at initialisation time.
diff --git a/Lisp/init.lisp b/Lisp/init.lisp
index 84ae511..72d616f 100644
--- a/Lisp/init.lisp
+++ b/Lisp/init.lisp
@@ -1,3 +1,12 @@
(in-package #:mulk.objective-cl)
(initialise-runtime)
+
+(eval-when (:load-toplevel)
+ (unless (boundp '+nil+)
+ (defconstant +nil+
+ (make-instance 'id :pointer (objcl-get-nil))))
+ (unless (boundp '+yes+)
+ (defconstant +yes+ (objcl-get-yes)))
+ (unless (boundp '+no+)
+ (defconstant +no+ (objcl-get-no))))
diff --git a/Lisp/libobjcl.lisp b/Lisp/libobjcl.lisp
index 9849392..85dfc45 100644
--- a/Lisp/libobjcl.lisp
+++ b/Lisp/libobjcl.lisp
@@ -72,7 +72,8 @@
(obj :pointer))
(defcfun objcl-get-nil :pointer)
-
+(defcfun objcl-get-yes :long)
+(defcfun objcl-get-no :long)
(defun initialise-runtime ()
"Initialise the Objective C runtime.
diff --git a/Lisp/method-invocation.lisp b/Lisp/method-invocation.lisp
index 9f9e056..dbf6f33 100644
--- a/Lisp/method-invocation.lisp
+++ b/Lisp/method-invocation.lisp
@@ -1,12 +1,6 @@
(in-package #:mulk.objective-cl)
-(eval-when (:execute)
- (unless (boundp '+nil+)
- (defconstant +nil+
- (make-instance 'id :pointer (objcl-get-nil)))))
-
-
;;; (@* "Method invocation")
(defun invoke (receiver message-start &rest message-components)
"Send a message to an Objective C instance.
@@ -539,7 +533,7 @@ Returns: *result* --- the return value of the method invocation.
(defcoercion id ((x id))
x)
-(defcoercion id ((x class))
+(defcoercion id ((x objc-class))
x)
(defcoercion id ((x exception))
@@ -551,15 +545,13 @@ Returns: *result* --- the return value of the method invocation.
'id
x))
-(defcoercion id ((x double-float))
- (primitive-invoke (find-objc-class 'ns-number)
- :number-with-double
- 'id
- x))
-
-(defcoercion id ((x single-float))
+(defcoercion id ((x float))
(primitive-invoke (find-objc-class 'ns-number)
- :number-with-float
+ (etypecase x
+ (long-float :number-with-double)
+ (double-float :number-with-double)
+ (short-float :number-with-float)
+ (single-float :number-with-float))
'id
x))
@@ -589,7 +581,7 @@ Returns: *result* --- the return value of the method invocation.
(defcoercion class ((x exception))
(object-get-class x))
-(defcoercion class ((x class))
+(defcoercion class ((x objc-class))
x)
(defcoercion class ((x string))
@@ -649,15 +641,13 @@ Returns: *result* --- the return value of the method invocation.
(float x))
+;; Note that this refers to the Objective-C BOOL type, not the Lisp
+;; BOOLEAN type.
(defcoercion bool ((x null))
- x)
+ +no+)
-(defcoercion bool ((x symbol))
- (assert (eq 't x))
- x)
-
-(defcoercion bool ((x integer))
- x)
+(defcoercion bool (x)
+ +yes+)
(defcoercion string ((x string))
diff --git a/Lisp/utilities.lisp b/Lisp/utilities.lisp
index b44c05d..a5c1723 100644
--- a/Lisp/utilities.lisp
+++ b/Lisp/utilities.lisp
@@ -8,7 +8,7 @@
(defun truep (b)
(or (eq b t)
(and (numberp b)
- (not (zerop b)))))
+ (not (eql b +no+)))))
(defun id-eql (x y)
@@ -17,10 +17,10 @@
(defun id-equal (x y)
(truep (if (typep x '(or id objc-class exception))
- (primitive-invoke x :is-equal :boolean y)
+ (primitive-invoke x :is-equal :char y)
(progn
(assert (typep y '(or id objc-class exception)))
- (primitive-invoke y :is-equal :boolean x)))))
+ (primitive-invoke y :is-equal :char x)))))
(defun objc-typep (x class-designator)
diff --git a/Objective-C/libobjcl.h b/Objective-C/libobjcl.h
index a912748..8b37609 100644
--- a/Objective-C/libobjcl.h
+++ b/Objective-C/libobjcl.h
@@ -94,3 +94,11 @@ objcl_object_get_meta_class (id obj);
id
objcl_get_nil (void);
+
+/* In principle, we do not know whether a BOOL fits into a long. In
+ practise, it is very likely. */
+long
+objcl_get_yes ();
+
+long
+objcl_get_no ();
diff --git a/Objective-C/libobjcl.m b/Objective-C/libobjcl.m
index eaffb8c..15855ed 100644
--- a/Objective-C/libobjcl.m
+++ b/Objective-C/libobjcl.m
@@ -457,3 +457,21 @@ objcl_get_nil (void)
{
return nil;
}
+
+
+long
+objcl_get_yes ()
+{
+ if (sizeof (YES) > sizeof (long))
+ fprintf (stderr, "WARNING: objcl_get_yes: YES might not fit into a long.\n");
+ return YES;
+}
+
+
+long
+objcl_get_no ()
+{
+ if (sizeof (NO) > sizeof (long))
+ fprintf (stderr, "WARNING: objcl_get_no: NO might not fit into a long.\n");
+ return NO;
+}
diff --git a/objective-cl.asd b/objective-cl.asd
index c936614..25de346 100644
--- a/objective-cl.asd
+++ b/objective-cl.asd
@@ -25,7 +25,8 @@
"data-types"
"libobjcl"
"internal-utilities"
- "parameters"))
+ "parameters"
+ "init"))
(:file "memory-management" :depends-on ("defpackage"
"init"
"weak-hash-tables"