Auto-discovery of Objective-C methods

TODO.FACTOR.txt

@@ -1,3 +1,6 @@
+- file responder issues
+- if select() returns an error, fep
+- FILE* leaked in process.factor
 - fix remaining HTML stream issues
 - help cross-referencing
 - UI browser pane needs 'back' button

library/alien/objective-c/runtime.factor

@@ -1,6 +1,6 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-IN: objective-c
+IN: objc
 
 LIBRARY: objc
 
@@ -66,3 +66,5 @@ FUNCTION: void class_removeMethods ( objc-class* class, objc-method-list* method
 FUNCTION: uint method_getNumberOfArguments ( objc-method* method ) ;
 
 FUNCTION: uint method_getSizeOfArguments ( objc-method* method ) ;
+
+FUNCTION: uint method_getArgumentInfo ( objc-method* method, int argIndex, char** type, int* offset ) ;

library/alien/objective-c/syntax.factor

@@ -1,14 +0,0 @@
-! Copyright (C) 2006 Slava Pestov
-! See http://factorcode.org/license.txt for BSD license.
-IN: !syntax
-USING: kernel lists namespaces objective-c parser syntax words ;
-
-: OBJC-CLASS:
-    #! Syntax: name
-    CREATE dup word-name
-    [ objc_getClass ] curry define-compound ; parsing
-
-: OBJC-MESSAGE:
-    scan string-mode on
-    [ string-mode off msg-send-args define-msg-send ] f ;
-    parsing

library/alien/objective-c/utils.factor

@@ -1,18 +1,15 @@
 ! Copyright (C) 2006 Slava Pestov
 ! See http://factorcode.org/license.txt for BSD license.
-IN: objective-c
-USING: alien arrays kernel lists namespaces parser sequences
-words ;
+IN: objc
+USING: alien arrays hashtables kernel lists math namespaces
+parser sequences words ;
 
 TUPLE: selector name object ;
 
 C: selector ( name -- sel ) [ set-selector-name ] keep ;
 
-: selector-valid? ( selector -- ? )
-    selector-object dup [ expired? not ] when ;
-
 : selector ( selector -- alien )
-    dup selector-valid? [
+    dup selector-object dup expired? not and [
         selector-object
     ] [
         dup selector-name sel_registerName
@@ -24,37 +21,102 @@ C: selector ( name -- sel ) [ set-selector-name ] keep ;
     [ "void*" <c-array> dup ] keep objc_getClassList
     [ swap void*-nth objc-class-name ] map-with ;
 
+: method-arg-type ( method i -- type )
+    f <void*> 0 <int> over
+    >r method_getArgumentInfo drop
+    r> *char* ;
+
+: objc-primitive-type ( char -- ctype )
+    H{
+        { CHAR: c "char" }
+        { CHAR: i "int" }
+        { CHAR: s "short" }
+        { CHAR: l "long" }
+        { CHAR: q "longlong" }
+        { CHAR: C "uchar" }
+        { CHAR: I "uint" }
+        { CHAR: S "ushort" }
+        { CHAR: L "ulong" }
+        { CHAR: Q "ulonglong" }
+        { CHAR: f "float" }
+        { CHAR: d "double" }
+        { CHAR: B "bool" }
+        { CHAR: v "void" }
+        { CHAR: * "char*" }
+        { CHAR: @ "id" }
+        { CHAR: # "id" }
+        { CHAR: : "SEL" }
+    } hash ;
+
+: objc-struct-type ( i string -- ctype )
+    2dup CHAR: = -rot index* swap subseq ;
+
+: (parse-objc-type) ( i string -- ctype )
+    2dup nth >r >r 1+ r> r> {
+        { [ dup CHAR: ^ = ] [ 3drop "void*" ] }
+        { [ dup CHAR: { = ] [ drop objc-struct-type ] }
+        { [ dup CHAR: [ = ] [ 3drop "void*" ] }
+        { [ t ] [ 2nip objc-primitive-type ] }
+    } cond ;
+
+: parse-objc-type ( string -- ctype ) 0 swap (parse-objc-type) ;
+
+: method-arg-types ( method -- args )
+    dup method_getNumberOfArguments
+    [ method-arg-type parse-objc-type ] map-with ;
+
+: method-return-type ( method -- ctype )
+    #! Undocumented hack! Apple does not support this feature!
+    objc-method-types parse-objc-type ;
+
+: objc-method-info ( method -- { return name args } )
+    [ method-return-type ] keep
+    [ objc-method-name sel_getName ] keep
+    method-arg-types 3array ;
+
 : method-list>seq ( method-list -- seq )
     dup objc-method-list-elements swap objc-method-list-count [
-        swap objc-method-nth objc-method-name sel_getName
+        swap objc-method-nth objc-method-info
     ] map-with ;
 
 : (objc-methods) ( objc-class iterator -- )
-    2dup class_nextMethodList [
-        method-list>seq % (objc-methods)
-    ] [
-        2drop
-    ] if* ;
+    2dup class_nextMethodList
+    [ method-list>seq % (objc-methods) ] [ 2drop ] if* ;
 
 : objc-methods ( class -- seq )
-    [ objc_getClass f <void*> (objc-methods) ] { } make ;
+    [ f <void*> (objc-methods) ] { } make ;
+
+: instance-methods ( classname -- seq )
+    objc_getClass objc-methods ;
+
+: class-methods ( classname -- seq )
+    objc_getMetaClass objc-methods ;
 
 : make-dip ( quot n -- quot )
     dup \ >r <array> -rot \ r> <array> append3 ;
 
-: make-msg-send ( returns args selector -- )
-    <selector> [ selector ] curry over length make-dip [
+: make-objc-method ( returns args selector -- )
+    <selector> [ selector ] curry over length 2 - make-dip [
         %
         swap ,
-        [ f "objc_msgSend" ] % 
-        [ "id" "SEL" ] swap append ,
+        [ f "objc_msgSend" ] % ,
         \ alien-invoke ,
     ] [ ] make ;
 
-: define-msg-send ( returns types selector -- )
-    [ make-msg-send "[" ] keep "]" append3 create-in
+: define-objc-method ( returns types selector -- )
+    [ make-objc-method "[" ] keep "]" append3 create-in
     swap define-compound ;
 
-: msg-send-args ( args -- types selector )
-    dup length 1 =
-    [ first { } ] [ unpair >r concat r> ] if swap ;
+: define-objc-methods ( seq -- )
+    [ first3 swap define-objc-method ] each ;
+
+: define-objc-class-word ( name -- )
+    create-in over [ objc_getClass ] curry define-compound ;
+
+: define-objc-class ( name -- )
+    [
+        "objc-" over append in set
+        dup define-objc-class-word
+        dup instance-methods define-objc-methods
+        class-methods define-objc-methods
+    ] with-scope ;

library/bootstrap/boot-stage1.factor

@@ -146,7 +146,6 @@ vectors words ;
         
         "/library/alien/objective-c/runtime.factor"
         "/library/alien/objective-c/utils.factor"
-        "/library/alien/objective-c/syntax.factor"
         
         "/library/io/buffer.factor"
 

library/test/alien.factor

@@ -1,5 +1,6 @@
 IN: temporary
-USING: arrays alien kernel kernel-internals namespaces test ;
+USING: alien arrays kernel kernel-internals namespaces
+objective-c test ;
 
 [ t ] [ 0 <alien> 0 <alien> = ] unit-test
 [ f ] [ 0 <alien> 1024 <alien> = ] unit-test
@@ -49,3 +50,7 @@ cell 8 = [
 
 [ "hello world" ]
 [ "hello world" string>alien alien>string ] unit-test
+
+[ "example" ] [ "{example=@*i}" parse-objc-type ] unit-test
+[ "void*" ] [ "[12^f]" parse-objc-type ] unit-test
+[ "float*" ] [ "^f" parse-objc-type ] unit-test