Merge pull request #4350 from waneck/objc

Initial objective-c extern implementation

ast.ml

@@ -130,6 +130,7 @@ module Meta = struct
 		| NotNull
 		| NoUsing
 		| Ns
+		| Objc
 		| Op
 		| Optional
 		| Overload
@@ -910,4 +911,4 @@ let full_dot_path mpath tpath =
 	if mpath = tpath then
 		(fst tpath) @ [snd tpath]
 	else
-		(fst mpath) @ [snd mpath;snd tpath]
+		(fst mpath) @ [snd mpath;snd tpath]

common.ml

@@ -223,6 +223,7 @@ module Define = struct
 		| NoSimplify
 		| NoSwfCompress
 		| NoTraces
+		| Objc
 		| PhpPrefix
 		| RealPosition
 		| ReplaceFiles
@@ -308,6 +309,7 @@ module Define = struct
 		| NoSimplify -> "no_simplify",("Disable simplification filter")
 		| NoSwfCompress -> ("no_swf_compress","Disable SWF output compression")
 		| NoTraces -> ("no_traces","Disable all trace calls")
+		| Objc -> ("objc","Sets the hxcpp output to objective-c++ classes. Must be defined for interop")
 		| PhpPrefix -> ("php_prefix","Compiled with --php-prefix")
 		| RealPosition -> ("real_position","Disables haxe source mapping when targetting C#")
 		| ReplaceFiles -> ("replace_files","GenCommon internal")
@@ -455,6 +457,7 @@ module MetaInfo = struct
 		| NotNull -> ":notNull",("Declares an abstract type as not accepting null values",[UsedOn TAbstract])
 		| NoUsing -> ":noUsing",("Prevents a field from being used with 'using'",[UsedOn TClassField])
 		| Ns -> ":ns",("Internally used by the Swf generator to handle namespaces",[Platform Flash])
+		| Objc -> ":objc",("Declares a class or interface that is used to interoperate with Objective-C code",[Platform Cpp;UsedOn TClass])
 		| Op -> ":op",("Declares an abstract field as being an operator overload",[HasParam "The operation";UsedOn TAbstractField])
 		| Optional -> ":optional",("Marks the field of a structure as optional",[UsedOn TClassField])
 		| Overload -> ":overload",("Allows the field to be called with different argument types",[HasParam "Function specification (no expression)";UsedOn TClassField])

gencpp.ml

@@ -171,8 +171,11 @@ let new_source_file common_ctx base_dir sub_dir extension class_path =
 
 
 let source_file_extension common_ctx =
-   try
-     "." ^ (Common.defined_value common_ctx Define.FileExtension)
+   (* no need to -D file_extension if -D objc is defined *)
+   if Common.defined common_ctx Define.Objc then
+      ".mm"
+   else try
+      "." ^ (Common.defined_value common_ctx Define.FileExtension)
    with
      Not_found -> ".cpp"
 ;;
@@ -562,6 +565,18 @@ let is_fromStaticFunction_call func =
    | _ -> false
 ;;
 
+let is_objc_call field =
+  match field with
+  | FStatic(cl,_) | FInstance(cl,_,_) ->
+      cl.cl_extern && Meta.has Meta.Objc cl.cl_meta
+  | _ -> false
+;;
+
+let is_objc_type t = match follow t with
+  | TInst(cl,_) -> cl.cl_extern && Meta.has Meta.Objc cl.cl_meta
+  | _ -> false
+;;
+
 let is_addressOf_call func =
    match (remove_parens func).eexpr with
    | TField (_,FStatic ({cl_path=["cpp"],"Pointer"},{cf_name="addressOf"} ) ) -> true
@@ -645,6 +660,15 @@ let rec class_string klass suffix params remap =
             | t when type_has_meta_key t Meta.NotNull -> "Dynamic"
             | _ -> "/*NULL*/" ^ (type_string t) )
          | _ -> assert false);
+   (* Objective-C class *)
+   | path when is_objc_type (TInst(klass,[])) ->
+      let str = join_class_path_remap klass.cl_path "::" in
+      if suffix = "_obj" then
+         str
+      else if klass.cl_interface then
+         "id <" ^ str ^ ">"
+      else
+         str ^ " *"
    (* Normal class *)
    | path when klass.cl_extern && (not (is_internal_class path) )->
             (join_class_path_remap klass.cl_path "::") ^ suffix
@@ -1801,6 +1825,33 @@ and gen_expression ctx retval expression =
          gen_expression_list remaining
       ) in
 
+   (* this will add a cast if boxing / unboxing an objective-c type *)
+   let check_objc_unbox expression to_type =
+     if is_objc_type to_type && not (is_objc_type expression.etype) then
+        { expression with eexpr = TCast(expression,None); etype = to_type }
+     else
+        expression
+   in
+   let check_objc_box expression to_type =
+     if is_objc_type expression.etype && not (is_objc_type to_type) then
+        { expression with eexpr = TCast(expression,None); etype = to_type }
+     else
+        expression
+   in
+   let add_objc_cast_if_needed expression =
+      (* objc-specific: since all `id` derived types are boxed to the same type,
+         we need to take one extra care when unboxing, and cast them to their
+         actual type *)
+      let is_cast =
+         retval && is_objc_type expression.etype && is_dynamic_in_cpp ctx expression
+      in
+      if is_cast then begin
+         output ("( (" ^ (type_string expression.etype) ^ ") (id) (");
+         ") )";
+      end else
+         ""
+   in
+
    let rec gen_bin_op_string expr1 op expr2 =
       let cast = (match op with
          | ">>" | "<<" | "&" | "|" | "^"  -> "int("
@@ -1832,6 +1883,11 @@ and gen_expression ctx retval expression =
       | _ -> ""
    in
    let rec gen_bin_op op expr1 expr2 =
+      let expr1, expr2 = match op with
+         | Ast.OpAssign | Ast.OpAssignOp _ -> expr1, check_objc_unbox expr2 expr1.etype
+         | Ast.OpEq | Ast.OpNotEq -> check_objc_box expr1 expr2.etype, check_objc_box expr2 expr1.etype
+         | _ -> expr1,expr2
+      in
       match op with
       | Ast.OpAdd when (is_const_string_term expr1) && (is_const_string_term expr2) ->
          output (str ((combine_string_terms expr1) ^ (combine_string_terms expr2)) )
@@ -2030,11 +2086,45 @@ and gen_expression ctx retval expression =
             output (" )");
          | _ -> error "fromStaticFunction must take a static function" expression.epos;
       )
+    | TCall ({ eexpr = TField(fexpr,field) }, arg_list) when is_objc_call field ->
+      output "[ ";
+      (match field with
+      | FStatic(cl,_) ->
+          output (join_class_path_remap cl.cl_path "::")
+      | FInstance _ ->
+          gen_expression ctx true fexpr
+      | _ -> assert false);
+      let names = ExtString.String.nsplit (field_name field) ":" in
+      let field_name, arg_names = match names with
+        | name :: args -> name, args
+        | _ -> assert false (* per nsplit specs, this should never happen *)
+      in
+      output (" " ^ field_name);
+      (try match arg_list, arg_names with
+      | [], _ -> ()
+      | [single_arg], _ -> output ": "; gen_expression ctx true single_arg
+      | first_arg :: args, arg_names ->
+          output ": ";
+          gen_expression ctx true first_arg;
+          ctx.ctx_calling <- true;
+          List.iter2 (fun arg arg_name ->
+            output (" " ^ arg_name ^ ": ");
+            gen_expression ctx true arg) args arg_names
+      with | Invalid_argument _ -> (* not all arguments names are known *)
+        error (
+          "The function called here with name " ^ (String.concat ":" names) ^
+          " does not contain the right amount of arguments' names as required" ^
+          " by the objective-c calling / naming convention:" ^
+          " expected " ^ (string_of_int (List.length arg_list)) ^
+          " and found " ^ (string_of_int (List.length arg_names)))
+        expression.epos);
+      output " ]"
 
    | TCall (func, [arg]) when is_addressOf_call func && not (is_lvalue arg) ->
       error "addressOf must take a local or member variable" expression.epos;
 
    | TCall (func, arg_list) ->
+      let after_cast = add_objc_cast_if_needed expression in
       let rec is_variable e = match e.eexpr with
       | TField _ | TEnumParameter _ -> false
       | TLocal { v_name = "__global__" } -> false
@@ -2110,6 +2200,7 @@ and gen_expression ctx retval expression =
             | _ -> ()
       in
       cast_array_output func;
+      output after_cast
 
    | TBlock expr_list ->
       if (retval) then
@@ -2163,6 +2254,7 @@ and gen_expression ctx retval expression =
       | TString s -> output (str s)
       | TBool b -> output (if b then "true" else "false")
       (*| TNull -> output ("((" ^ (type_string expression.etype) ^ ")null())")*)
+      | TNull when is_objc_type expression.etype -> output "nil"
       | TNull -> output (if ctx.ctx_for_extern then "null" else "null()")
       | TThis -> output (if ctx.ctx_real_this_ptr then "hx::ObjectPtr<OBJ_>(this)" else "__this")
       | TSuper when calling ->
@@ -2224,7 +2316,9 @@ and gen_expression ctx retval expression =
       gen_expression ctx true expr;
       output ( "))->__Param(" ^ (string_of_int i) ^ ")")
    | TField (field_object,field) ->
-      gen_tfield field_object field
+      let after_cast = add_objc_cast_if_needed expression in
+      gen_tfield field_object field;
+      output after_cast
 
    | TParenthesis expr when not retval ->
          gen_expression ctx retval expr;
@@ -2467,6 +2561,11 @@ and gen_expression ctx retval expression =
          output "HX_STACK_DO_THROW(";
          gen_expression ctx true expression;
          output ")";
+   | TCast (cast,None) when is_objc_type expression.etype && not (is_objc_type cast.etype) ->
+     let ret_type = type_string expression.etype in
+     output ("( (" ^ ret_type ^ ") (id) (");
+     gen_expression ctx true cast;
+     output ") )"
    | TCast (cast,None) when (not retval) || (type_string expression.etype) = "Void" ->
       gen_expression ctx retval cast;
    | TCast (cast,None) ->
@@ -5591,6 +5690,12 @@ let generate_source common_ctx =
    let scriptable = (Common.defined common_ctx Define.Scriptable) in
 
    List.iter (fun object_def ->
+      (* check if any @:objc class is referenced while '-D objc' is not defined
+         This will guard all code changes to this flag *)
+      (if not (Common.defined common_ctx Define.Objc) then match object_def with
+         | TClassDecl class_def when Meta.has Meta.Objc class_def.cl_meta ->
+            error "In order to compile '@:objc' classes, please define '-D objc'" class_def.cl_pos
+         | _ -> ());
       (match object_def with
       | TClassDecl class_def when is_extern_class class_def ->
          build_xml := !build_xml ^ (get_class_code class_def Meta.BuildXml);

tests/RunCi.hx

@@ -616,6 +616,13 @@ class RunCi {
 					changeDirectory(sysDir);
 					runCommand("haxe", ["compile-cpp.hxml"]);
 					runCpp("bin/cpp/Main-debug", []);
+
+					if (Sys.systemName() == "Mac")
+					{
+						changeDirectory(miscDir + "cppObjc");
+						runCommand("haxe", ["build.hxml"]);
+						runCpp("bin/TestObjc-debug");
+					}
 				case Js:
 					getJSDependencies();
 

tests/misc/cppObjc/.gitignore

@@ -0,0 +1 @@
+bin

tests/misc/cppObjc/TestObjc.hx

@@ -0,0 +1,202 @@
+class TestObjc extends haxe.unit.TestCase
+{
+	static function main()
+	{
+		var x:TestObjc = null;
+		var c:TestClass = null;
+		var runner = new haxe.unit.TestRunner();
+		runner.add(new TestObjc());
+		var code = runner.run() ? 0 : 1;
+		Sys.exit(code);
+	}
+
+	var cls:TestClass;
+
+	public function testCall()
+	{
+		assertEquals(TestClass.aStatic(), 42);
+		cls = TestClass.alloc().init();
+		assertEquals(cls.getOtherThing(), 0);
+		cls.setOtherThing(42);
+		assertEquals(cls.otherThing, 42);
+		assertEquals(cls.getOtherThing(), 42);
+		assertEquals(cls.getOtherThingChar(), 42);
+		assertEquals(cls.isBiggerThan10(2), false);
+		assertEquals(cls.isBiggerThan10(12), true);
+		assertEquals(cls.isBiggerThan10Int(3), false);
+		assertEquals(cls.isBiggerThan10Int(14), true);
+		assertEquals(cls.isBiggerThan10Num(3).boolValue(), false);
+		assertEquals(cls.isBiggerThan10Num(14).boolValue(), true);
+		assertEquals(cls.addHello("World"), "Hello, World");
+		cls.something = " test";
+		assertEquals(cls.something, " test");
+		assertEquals(cls.addSomething("Hey,"), "Hey, test");
+		assertEquals(cls.addHelloAndString("World"," it works"), "Hello, World it works");
+		cls.release();
+	}
+
+	public function testVar()
+	{
+		cls = TestClass.alloc().init();
+		cls.setOtherThing(142);
+		assertEquals(cls.otherThing, 142);
+		assertEquals(cls.getOtherThing(), 142);
+		cls.release();
+	}
+
+	public function testBoxing()
+	{
+		cls = TestClass.alloc().init();
+
+		cls.setOtherThing(255);
+
+		var dyn:Dynamic = cls;
+		this.assertTrue(dyn != null);
+		this.assertTrue(cls != null);
+
+		var someObjDecl = { a:10, b: cls };
+		dyn = someObjDecl; // don't let Haxe inline that TObjectDecl
+		assertEquals(someObjDecl.b.getOtherThing(), 255);
+		assertEquals(getFieldB(someObjDecl).getOtherThing(), 255);
+		cls = someObjDecl.b;
+		assertTrue(someObjDecl.b == cls);
+		dyn = cls;
+
+		cls.release();
+		cls = null;
+		this.assertTrue(cls == null);
+		cls = dyn;
+
+		assertEquals(cls.getOtherThing(), 255);
+		cls = null;
+		dyn = null;
+		dyn = cls;
+		assertTrue(dyn == null);
+		assertEquals(dyn,null);
+		assertTrue(dyn == cls);
+		assertEquals(dyn,cls);
+		cls.release();
+	}
+
+	static function getFieldB<T>(d:{ a:Int, b: T }):T
+		return d.b;
+
+	public function testNull()
+	{
+		this.assertTrue(TestClass.isNull(null));
+		this.assertFalse(TestClass.isNull(TestClass.alloc().init()));
+	}
+
+	public function testInterface()
+	{
+		cls = TestClass.alloc().init();
+		cls.setOtherThing(21);
+		this.assertTrue(cls.getSelf() == cls);
+		this.assertEquals(cls.getSelf(), cls);
+
+		var iface:TestInterface = cls;
+		var obj:Dynamic = iface;
+		this.assertTrue(iface == cls);
+		this.assertEquals(iface, cls);
+		this.assertTrue(obj == cls);
+		this.assertEquals(obj, cls);
+		this.assertEquals(iface.getSelf(), cls);
+		this.assertEquals(iface.getSelf(), cls.getSelf());
+
+		this.assertEquals(iface.getOtherThing(), 21);
+		this.assertEquals(iface.getOtherThingChar(), 21);
+		cls.setOtherThing(100);
+		this.assertEquals(iface.getOtherThing(), 100);
+		this.assertEquals(iface.getOtherThingChar(), 100);
+
+		this.assertEquals("someOptionalMethod!",iface.someOptionalMethod());
+
+		cls.release();
+	}
+}
+
+@:include("./native/include/test.h")
+@:objc extern interface TestInterface
+{
+	function getSelf():TestInterface;
+	function getOtherThing():Int;
+	function getOtherThingChar():cpp.Int8;
+
+	@:optional function someOptionalMethod():NSString;
+	@:optional function unimplementedOptional():NSString;
+}
+
+@:include("./native/include/test.h")
+@:sourceFile("./native/test.m")
+@:objc extern class TestClass implements TestInterface
+{
+	static function aStatic():Int;
+	static function isNull(t:TestClass):Bool;
+
+	static function alloc():TestClass;
+	function init():TestClass;
+
+	var something(get,set):NSString;
+	var otherThing:Int;
+
+	@:native("something") private function get_something():NSString;
+	@:native("setSomething") private function set_something(value:NSString):NSString;
+
+	function setOtherThing(value:Int):Void;
+	function getOtherThing():Int;
+	function getOtherThingChar():cpp.Int8;
+	function addHello(str:NSString):NSString;
+	@:native("addHello:andString") function addHelloAndString(str:NSString, str2:NSString):NSString;
+	function addSomething(str:NSString):NSString;
+	function isBiggerThan10(value:NSNumber):Bool;
+	function isBiggerThan10Num(value:NSNumber):NSNumber;
+	function isBiggerThan10Int(integer:Int):Bool;
+
+	function release():Void;
+	function retainCount():Int;
+
+	function getSelf():TestClass;
+
+	function someOptionalMethod():NSString;
+
+	@:deprecated('This method is not implemented on this class')
+	@:noCompletion @:optional function unimplementedOptional():NSString;
+
+	@:plain static function some_c_call(t:TestClass):Int;
+	@:plain static function is_bigger_than_10(t:TestClass, val:Int):Bool;
+}
+
+@:forward abstract NSString(_NSString) from _NSString to _NSString
+{
+	@:from @:extern inline public static function fromString(str:String):NSString
+		return _NSString.stringWithUTF8String(str);
+
+	@:to @:extern inline public function toString():String
+		return this.UTF8String();
+}
+
+@:native("NSString") @:objc extern class _NSString
+{
+	static function stringWithUTF8String(str:cpp.CastCharStar):NSString;
+
+	function UTF8String():cpp.ConstCharStar;
+}
+
+@:forward abstract NSNumber(_NSNumber) from _NSNumber to _NSNumber
+{
+	@:from @:extern inline public static function fromInt(i:Int):NSNumber
+		return _NSNumber.numberWithInt(i);
+
+	@:to @:extern inline public function toInt():Int
+		return this.intValue();
+
+	@:to @:extern inline public function toBool():Bool
+		return this.boolValue();
+}
+
+@:native("NSNumber") @:objc extern class _NSNumber
+{
+	static function numberWithInt(i:Int):NSNumber;
+	function intValue():Int;
+	function boolValue():Bool;
+}

tests/misc/cppObjc/build.hxml

@@ -0,0 +1,4 @@
+-main TestObjc
+-cpp bin
+-debug
+-D objc

tests/misc/cppObjc/native/.gitignore

@@ -0,0 +1,2 @@
+*.o
+*.a

tests/misc/cppObjc/native/Makefile

@@ -0,0 +1,20 @@
+CC=clang
+
+SOURCES=$(wildcard *.m)
+OBJECTS=$(SOURCES:.m=.o)
+
+libtest.a : $(OBJECTS)
+	$(AR) rcs libtest.a $(OBJECTS)
+	ranlib libtest.a
+
+%.c.o : %.c $(C_DEPS)
+	$(VERBOSE)$(CC) $(CFLAGS) -o $@ -c $<
+	 
+%.cpp.o : %.cpp $(C_DEPS)
+	$(VERBOSE)$(CXX) $(CXXFLAGS) -o $@ -c $<
+	 
+%.m.o : %.m $(C_DEPS)
+	$(VERBOSE)$(CXX) $(CFLAGS) -o $@ -c $<
+	 
+%.mm.o : %.mm $(C_DEPS)
+	$(VERBOSE)$(CXX) $(CXXFLAGS) -o $@ -c $< 

tests/misc/cppObjc/native/include/test.h

@@ -0,0 +1,59 @@
+#ifndef TEST_H_INCLUDED
+#define TEST_H_INCLUDED
+#import <Foundation/Foundation.h>
+
+@protocol TestInterface
+
+- (id <TestInterface>)getSelf;
+
+- (int)getOtherThing;
+
+- (char)getOtherThingChar;
+
+@optional
+
+- (NSString *)someOptionalMethod;
+
+- (NSString *)unimplementedOptional;
+
+@end
+
+@interface TestClass : NSObject <TestInterface> {
+	@public int otherThing;
+}
+
+@property (retain) NSString *something;
+
++ (int)aStatic;
+
++ (BOOL)isNull:(TestClass *)t;
+
+- (void)setOtherThing:(int) value;
+
+- (int)getOtherThing;
+
+- (char)getOtherThingChar;
+
+- (NSString *)addHello:(NSString *)str;
+
+- (NSString *)addHello:(NSString *)str andString:(NSString *) str2;
+
+- (NSString *)addSomething:(NSString *)str;
+
+- (BOOL)isBiggerThan10:(NSNumber *)value;
+
+- (NSNumber *)isBiggerThan10Num:(NSNumber *)value;
+
+- (BOOL)isBiggerThan10Int:(int)integer;
+
+- (TestClass *)getSelf;
+
+- (NSString *)someOptionalMethod;
+
+
+@end
+
+int some_c_call(TestClass *t);
+
+BOOL is_bigger_than_10(TestClass *t, int val);
+#endif

tests/misc/cppObjc/native/test.m

@@ -0,0 +1,82 @@
+#import "include/test.h"
+
+@implementation TestClass
+
+@synthesize something = _something;
+
++ (int)aStatic
+{
+	return 42;
+}
+
++ (BOOL)isNull:(TestClass *)t
+{
+	return t == nil;
+}
+
+- (void)setOtherThing:(int) value
+{
+	self->otherThing = value;
+}
+
+- (int)getOtherThing
+{
+	return self->otherThing;
+}
+
+- (char)getOtherThingChar
+{
+	return (char) self->otherThing;
+}
+
+- (NSString *)addHello:(NSString *)str
+{
+	return [@"Hello, " stringByAppendingString: str];
+}
+
+- (NSString *)addHello:(NSString *)str andString:(NSString *) str2
+{
+	return [[@"Hello, " stringByAppendingString: str] stringByAppendingString: str2];
+}
+
+- (NSString *)addSomething:(NSString *)str
+{
+	return [str stringByAppendingString: self->_something];
+}
+
+- (BOOL)isBiggerThan10:(NSNumber *)value
+{
+	return [value doubleValue] > 10;
+}
+
+- (NSNumber *)isBiggerThan10Num:(NSNumber *)value
+{
+	return [NSNumber numberWithBool:[value doubleValue] > 10];
+}
+
+- (BOOL)isBiggerThan10Int:(int)integer
+{
+	return integer > 10;
+}
+
+- (TestClass *)getSelf
+{
+	return self;
+}
+
+- (NSString *)someOptionalMethod
+{
+	return @"someOptionalMethod!";
+}
+
+@end
+
+int some_c_call(TestClass *t)
+{
+	return [t getOtherThing] + 10;
+}
+
+BOOL is_bigger_than_10(TestClass *t, int val)
+{
+	return [t isBiggerThan10Int: val];
+}