Skip to content

Commit

Permalink
Use <raw-c-pointer> instead of <raw-machine-word>.
Browse files Browse the repository at this point in the history 
This makes usage of <raw-c-pointer> and primitive-unwrap-c-pointer
consistent and reduces the number of problems with LLVM builds.
  • Loading branch information
@waywardmonkeys
waywardmonkeys committed Jan 9, 2016
1 parent 1014ebd commit 9de9695
Show file tree
Hide file tree
Showing 5 changed files with 138 additions and 144 deletions.
138 changes: 70 additions & 68 deletions objective-c/class.dylan
View file
Expand Up @@ -9,10 +9,6 @@ define constant $class-registry :: <table> = make(<table>);
define C-subtype <objc/class> (<C-statically-typed-pointer>)
end;

define inline function as-raw-class (objc-class :: <objc/class>)
primitive-unwrap-c-pointer(objc-class)
end;

define sealed method \=
(class1 :: <objc/class>, class2 :: <objc/class>)
=> (equal? :: <boolean>)
Expand Down Expand Up @@ -68,11 +64,12 @@ define function objc/get-class (name :: <string>)
=> (objc-class :: false-or(<objc/class>))
let raw-objc-class
= primitive-wrap-machine-word
(%call-c-function ("objc_getClass")
(name :: <raw-byte-string>)
=> (object :: <raw-machine-word>)
(primitive-string-as-raw(name))
end);
(primitive-cast-pointer-as-raw
(%call-c-function ("objc_getClass")
(name :: <raw-byte-string>)
=> (object :: <raw-c-pointer>)
(primitive-string-as-raw(name))
end));
if (raw-objc-class ~= 0)
make(<objc/class>, address: raw-objc-class)
else
Expand All @@ -84,45 +81,47 @@ define inline function objc/super-class (objc-class :: <objc/class>)
=> (objc-class :: false-or(<objc/class>))
let raw-objc-class
= primitive-wrap-machine-word
(%call-c-function ("class_getSuperclass")
(objc-class :: <raw-machine-word>)
=> (objc-class :: <raw-machine-word>)
(objc-class.as-raw-class)
end);
(primitive-cast-pointer-as-raw
(%call-c-function ("class_getSuperclass")
(objc-class :: <raw-c-pointer>)
=> (objc-class :: <raw-c-pointer>)
(primitive-unwrap-c-pointer(objc-class))
end));
if (raw-objc-class ~= 0)
make(<objc/class>, address: raw-objc-class)
else
#f
end if
end;

define inline function objc/raw-super-class (objc-class :: <machine-word>)
define inline function objc/raw-super-class (raw-objc-class :: <machine-word>)
=> (raw-objc-class :: <machine-word>)
primitive-wrap-machine-word
(%call-c-function ("class_getSuperclass")
(objc-class :: <raw-machine-word>)
=> (objc-class :: <raw-machine-word>)
(primitive-unwrap-machine-word(objc-class))
end)
(primitive-cast-pointer-as-raw
(%call-c-function ("class_getSuperclass")
(objc-class :: <raw-c-pointer>)
=> (objc-class :: <raw-c-pointer>)
(primitive-cast-raw-as-pointer(primitive-unwrap-machine-word(raw-objc-class)))
end))
end;

define inline method objc/class-name (objc-class :: <objc/class>)
=> (objc-class-name :: <string>)
primitive-raw-as-string
(%call-c-function ("class_getName")
(objc-class :: <raw-machine-word>)
(objc-class :: <raw-c-pointer>)
=> (name :: <raw-byte-string>)
(objc-class.as-raw-class)
(primitive-unwrap-c-pointer(objc-class))
end)
end;

define inline method objc/class-name (raw-objc-class :: <machine-word>)
=> (objc-class-name :: <string>)
primitive-raw-as-string
(%call-c-function ("class_getName")
(objc-class :: <raw-machine-word>)
(objc-class :: <raw-c-pointer>)
=> (name :: <raw-byte-string>)
(primitive-unwrap-machine-word(raw-objc-class))
(primitive-cast-raw-as-pointer(primitive-unwrap-machine-word(raw-objc-class)))
end)
end;

Expand All @@ -131,21 +130,21 @@ define inline function objc/class-responds-to-selector?
=> (well? :: <boolean>)
primitive-raw-as-boolean
(%call-c-function ("class_respondsToSelector")
(objc-class :: <raw-machine-word>,
selector :: <raw-machine-word>)
(objc-class :: <raw-c-pointer>,
selector :: <raw-c-pointer>)
=> (well? :: <raw-boolean>)
(objc-class.as-raw-class,
selector.as-raw-selector)
(primitive-unwrap-c-pointer(objc-class),
primitive-unwrap-c-pointer(selector))
end);
end;

define inline function objc/instance-size (objc-class :: <objc/class>)
=> (objc-instance-size :: <integer>)
raw-as-integer
(%call-c-function ("class_getInstanceSize")
(objc-class :: <raw-machine-word>)
(objc-class :: <raw-c-pointer>)
=> (size :: <raw-machine-word>)
(objc-class.as-raw-class)
(primitive-unwrap-c-pointer(objc-class))
end)
end;

Expand All @@ -154,13 +153,14 @@ define inline function objc/get-class-method
=> (method? :: false-or(<objc/method>))
let raw-method
= primitive-wrap-machine-word
(%call-c-function ("class_getClassMethod")
(objc-class :: <raw-machine-word>,
selector :: <raw-machine-word>)
=> (method? :: <raw-machine-word>)
(objc-class.as-raw-class,
selector.as-raw-selector)
end);
(primitive-cast-pointer-as-raw
(%call-c-function ("class_getClassMethod")
(objc-class :: <raw-c-pointer>,
selector :: <raw-c-pointer>)
=> (method? :: <raw-c-pointer>)
(primitive-unwrap-c-pointer(objc-class),
primitive-unwrap-c-pointer(selector))
end));
if (raw-method ~= 0)
make(<objc/method>, address: raw-method)
else
Expand All @@ -173,13 +173,14 @@ define inline function objc/get-instance-method
=> (method? :: false-or(<objc/method>))
let raw-method
= primitive-wrap-machine-word
(%call-c-function ("class_getInstanceMethod")
(objc-class :: <raw-machine-word>,
selector :: <raw-machine-word>)
=> (method? :: <raw-machine-word>)
(objc-class.as-raw-class,
selector.as-raw-selector)
end);
(primitive-cast-pointer-as-raw
(%call-c-function ("class_getInstanceMethod")
(objc-class :: <raw-c-pointer>,
selector :: <raw-c-pointer>)
=> (method? :: <raw-c-pointer>)
(primitive-unwrap-c-pointer(objc-class),
primitive-unwrap-c-pointer(selector))
end));
if (raw-method ~= 0)
make(<objc/method>, address: raw-method)
else
Expand All @@ -194,25 +195,26 @@ define inline function objc/allocate-class-pair
let super-class = objc/class-for-shadow(super-class);
let raw-class
= primitive-wrap-machine-word
(%call-c-function ("objc_allocateClassPair")
(super-class :: <raw-machine-word>,
class-name :: <raw-byte-string>,
extra-bytes :: <raw-machine-word>)
=> (objc-class :: <raw-machine-word>)
(super-class.as-raw-class,
primitive-string-as-raw(class-name),
integer-as-raw(0))
end);
(primitive-cast-pointer-as-raw
(%call-c-function ("objc_allocateClassPair")
(super-class :: <raw-c-pointer>,
class-name :: <raw-byte-string>,
extra-bytes :: <raw-machine-word>)
=> (objc-class :: <raw-c-pointer>)
(primitive-unwrap-c-pointer(super-class),
primitive-string-as-raw(class-name),
integer-as-raw(0))
end));
make(<objc/class>, address: raw-class)
end;

define inline function objc/register-class-pair
(objc-class :: <objc/class>)
=> ()
%call-c-function ("objc_registerClassPair")
(objc-class :: <raw-machine-word>)
(objc-class :: <raw-c-pointer>)
=> (nothing :: <raw-c-void>)
(objc-class.as-raw-class)
(primitive-unwrap-c-pointer(objc-class))
end;
end;

Expand All @@ -224,13 +226,13 @@ define inline function objc/add-method
=> (added? :: <boolean>)
primitive-raw-as-boolean
(%call-c-function ("class_addMethod")
(objc-class :: <raw-machine-word>,
selector :: <raw-machine-word>,
implementation :: <raw-machine-word>,
(objc-class :: <raw-c-pointer>,
selector :: <raw-c-pointer>,
implementation :: <raw-c-pointer>,
types :: <raw-byte-string>)
=> (added? :: <raw-boolean>)
(objc-class.as-raw-class,
selector.as-raw-selector,
(primitive-unwrap-c-pointer(objc-class),
primitive-unwrap-c-pointer(selector),
primitive-unwrap-c-pointer(implementation),
primitive-string-as-raw(types))
end)
Expand All @@ -242,11 +244,11 @@ define inline method objc/conforms-to-protocol?
=> (conforms? :: <boolean>)
primitive-raw-as-boolean
(%call-c-function ("class_conformsToProtocol")
(objc-class :: <raw-machine-word>,
protocol :: <raw-machine-word>)
(objc-class :: <raw-c-pointer>,
protocol :: <raw-c-pointer>)
=> (conforms? :: <raw-boolean>)
(objc-class.as-raw-class,
protocol.as-raw-protocol)
(primitive-unwrap-c-pointer(objc-class),
primitive-unwrap-c-pointer(protocol))
end)
end;

Expand All @@ -256,10 +258,10 @@ define inline method objc/add-protocol
=> (added? :: <boolean>)
primitive-raw-as-boolean
(%call-c-function ("class_addProtocol")
(objc-class :: <raw-machine-word>,
protocol :: <raw-machine-word>)
(objc-class :: <raw-c-pointer>,
protocol :: <raw-c-pointer>)
=> (added? :: <raw-boolean>)
(objc-class.as-raw-class,
protocol.as-raw-protocol)
(primitive-unwrap-c-pointer(objc-class),
primitive-unwrap-c-pointer(protocol))
end)
end;
58 changes: 29 additions & 29 deletions objective-c/instance.dylan
View file
Expand Up @@ -11,10 +11,6 @@ define C-mapped-subtype <objc/instance> (<C-statically-typed-pointer>)
end;
end;

define inline function as-raw-instance (objc-instance :: <objc/instance>)
primitive-unwrap-c-pointer(objc-instance)
end;

define sealed method \=
(instance1 :: <objc/instance>, instance2 :: <objc/instance>)
=> (equal? :: <boolean>)
Expand All @@ -33,31 +29,33 @@ define function objc/instance-class (objc-instance :: <objc/instance>)
=> (objc-class :: <objc/class>)
let raw-objc-class
= primitive-wrap-machine-word
(%call-c-function ("object_getClass")
(objc-instance :: <raw-machine-word>)
=> (objc-class :: <raw-machine-word>)
(objc-instance.as-raw-instance)
end);
(primitive-cast-pointer-as-raw
(%call-c-function ("object_getClass")
(objc-instance :: <raw-c-pointer>)
=> (objc-class :: <raw-c-pointer>)
(primitive-unwrap-c-pointer(objc-instance))
end));
make(<objc/class>, address: raw-objc-class)
end;

define inline function objc/raw-instance-class (objc-instance :: <machine-word>)
=> (raw-objc-class :: <machine-word>)
primitive-wrap-machine-word
(%call-c-function ("object_getClass")
(objc-instance :: <raw-machine-word>)
=> (objc-class :: <raw-machine-word>)
(primitive-unwrap-machine-word(objc-instance))
end)
(primitive-cast-pointer-as-raw
(%call-c-function ("object_getClass")
(objc-instance :: <raw-c-pointer>)
=> (objc-class :: <raw-c-pointer>)
(primitive-unwrap-machine-word(objc-instance))
end))
end;

define function objc/instance-class-name (objc-instance :: <objc/instance>)
=> (objc-class-name :: <string>)
primitive-raw-as-string
(%call-c-function ("object_getClassName")
(objc-instance :: <raw-machine-word>)
(objc-instance :: <raw-c-pointer>)
=> (name :: <raw-byte-string>)
(objc-instance.as-raw-instance)
(primitive-unwrap-c-pointer(objc-instance))
end)
end;

Expand All @@ -83,13 +81,14 @@ define inline function objc/associated-object-inner
=> (objc-instance :: <objc/instance>)
let raw-associated-object
= primitive-wrap-machine-word
(%call-c-function ("objc_getAssociatedObject")
(objc-instance :: <raw-machine-word>,
key :: <raw-machine-word>)
=> (associated-object :: <raw-machine-word>)
(objc-instance.as-raw-instance,
primitive-unwrap-machine-word(key))
end);
(primitive-cast-pointer-as-raw
(%call-c-function ("objc_getAssociatedObject")
(objc-instance :: <raw-c-pointer>,
key :: <raw-machine-word>)
=> (associated-object :: <raw-c-pointer>)
(primitive-unwrap-c-pointer(objc-instance),
primitive-unwrap-machine-word(key))
end));
if (raw-associated-object ~= 0)
objc/make-instance(raw-associated-object);
else
Expand Down Expand Up @@ -130,13 +129,14 @@ define inline function objc/set-associated-object-inner
value :: <objc/instance>, association-policy :: <integer>)
=> ()
%call-c-function ("objc_setAssociatedObject")
(objc-instance :: <raw-machine-word>,
key :: <raw-machine-word>, value :: <raw-machine-word>,
(objc-instance :: <raw-c-pointer>,
key :: <raw-machine-word>,
value :: <raw-c-pointer>,
association-policy :: <raw-c-unsigned-int>)
=> (nothing :: <raw-c-void>)
(objc-instance.as-raw-instance,
(primitive-unwrap-c-pointer(objc-instance),
primitive-unwrap-machine-word(key),
value.as-raw-instance,
primitive-unwrap-c-pointer(value),
integer-as-raw(association-policy))
end;
end;
Expand All @@ -145,8 +145,8 @@ define function objc/remove-associated-objects
(objc-instance :: <objc/instance>)
=> ()
%call-c-function ("objc_removeAssociatedObjects")
(objc-instance :: <raw-machine-word>)
(objc-instance :: <raw-c-pointer>)
=> (nothing :: <raw-c-void>)
(objc-instance.as-raw-instance)
(primitive-unwrap-c-pointer(objc-instance))
end;
end;
19 changes: 8 additions & 11 deletions objective-c/method.dylan
View file
Expand Up @@ -6,10 +6,6 @@ copyright: See LICENSE file in this distribution.
define C-subtype <objc/method> (<C-statically-typed-pointer>)
end;

define inline function as-raw-method (objc-method :: <objc/method>)
primitive-unwrap-c-pointer(objc-method)
end;

define sealed method \=
(method1 :: <objc/method>, method2 :: <objc/method>)
=> (equal? :: <boolean>)
Expand All @@ -20,17 +16,18 @@ define function objc/method-name (objc-method :: <objc/method>)
=> (objc-method-selector :: <objc/selector>)
let raw-objc-selector
= primitive-wrap-machine-word
(%call-c-function ("method_getName")
(raw-method :: <raw-machine-word>)
=> (name :: <raw-machine-word>)
(objc-method.as-raw-method)
end);
(primitive-cast-pointer-as-raw
(%call-c-function ("method_getName")
(raw-method :: <raw-c-pointer>)
=> (name :: <raw-c-pointer>)
(primitive-unwrap-c-pointer(objc-method))
end));
let type-encoding
= primitive-raw-as-string
(%call-c-function ("method_getTypeEncoding")
(raw-method :: <raw-machine-word>)
(raw-method :: <raw-c-pointer>)
=> (encoding :: <raw-byte-string>)
(objc-method.as-raw-method)
(primitive-unwrap-c-pointer(objc-method))
end);
make(<objc/selector>,
address: raw-objc-selector,
Expand Down

0 comments on commit 9de9695

Please sign in to comment.