cocoa.message: better unknown objc type with class/method names

diff --git a/basis/cocoa/messages/messages.factor b/basis/cocoa/messages/messages.factor
index 6b8ae883b6701773249cdfca54ee94d563197c5d..859126ed67db412baf5d2edc9722f7550c819369 100644 (file)
--- a/basis/cocoa/messages/messages.factor
+++ b/basis/cocoa/messages/messages.factor
@@ -2,7 +2,7 @@
 ! See https://factorcode.org/license.txt for BSD license.
 USING: accessors alien alien.c-types alien.data alien.strings
 arrays assocs classes.struct cocoa.runtime cocoa.types
-combinators core-graphics.types generalizations io
+combinators continuations core-graphics.types generalizations io
 io.encodings.utf8 kernel layouts libc make math math.parser
 namespaces sequences sets specialized-arrays
 splitting stack-checker strings words ;
@@ -218,21 +218,26 @@ ERROR: no-objc-type name ;
     [ method-arg-type ] with map ;
 
 : method-return-type ( method -- ctype )
-    method_copyReturnType
-    [
-        utf8 alien>string dup string>number [
-            "unknown objc return type: " prepend
-            [ print ] with-output>error
-            f
-        ] [ parse-objc-type ] if
-    ] keep (free) ;
+    method_copyReturnType [ utf8 alien>string ] [ (free) ] bi ;
+
+: method-return-type-parsed ( method -- ctype/f )
+    method-return-type
+    [ parse-objc-type ] [ 2drop f ] recover ;
 
 : method-signature ( method -- signature )
-    [ method-return-type ] [ method-arg-types ] bi 2array ;
+    [ method-return-type-parsed ] [ method-arg-types ] bi 2array ;
 
 : method-name ( method -- name )
     method_getName sel_getName ;
 
+: warn-unknown-objc-method ( classname method-name method -- )
+    '[
+        _ write bl
+        _ "`" dup surround write bl
+        "has unknown method-return-type:" write bl
+        _ method-return-type print
+    ] with-output>error ;
+
 :: register-objc-method ( classname method -- )
     method method-signature :> signature
     method method-name :> name
@@ -241,7 +246,9 @@ ERROR: no-objc-type name ;
         signature cache-stubs
         signature name objc-methods get set-at
         signature fullname objc-methods get set-at
-    ] when ;
+    ] [
+        classname name method warn-unknown-objc-method
+    ] if ;
 
 : method-collisions ( -- collisions )
     objc-methods get >alist
@@ -249,6 +256,9 @@ ERROR: no-objc-type name ;
     [ first "." split1 nip ] collect-by
     [ nip values members length 1 > ] assoc-filter ;
 
+: method-count ( class -- c-direct-array )
+    0 uint <ref> [ class_copyMethodList (free) ] keep uint deref ;
+
 : each-method-in-class ( class quot: ( classname method -- ) -- )
     [
         [ class_getName ] keep