Add option to generate method definitions for a class.

generate/main.ml

@@ -9,6 +9,7 @@ Usage: generate-ml -classes <lib-name> | -methods <class-name>
 let fw_name = ref ""
 let gen_classes = ref ""
 let gen_methods = ref ""
+let gen_method_def = ref ""
 let gen_protocols = ref false
 let include_superclass = ref false
 let load_fw = ref ""
@@ -17,6 +18,8 @@ let open_modules = ref ""
 let speclist =
   [ ("-classes", Arg.Set_string gen_classes, "Generate classes in <lib>")
   ; ("-methods", Arg.Set_string gen_methods, "Generate methods in <class>")
+  ; ("-method-def", Arg.Set_string gen_method_def,
+      "Generate methods definitions for <class>")
   ; ("-protocols", Arg.Set gen_protocols,
       "Generate protocols registered in the runtime")
   ; ("-super", Arg.Set include_superclass,
@@ -31,6 +34,7 @@ let () =
   Arg.parse speclist ignore usage;
   let lib = !gen_classes
   and cls = !gen_methods
+  and method_def_cls = !gen_method_def
   and proto = !gen_protocols
   and fw = !fw_name
   and include_superclass = !include_superclass
@@ -47,6 +51,8 @@ let () =
         emit_class_module cls ~fw ~include_superclass ~open_modules)
   else if not (String.equal cls "") then
     emit_class_module cls ~fw ~include_superclass ~open_modules
+  else if not (String.equal method_def_cls "") then
+    emit_class_method_def method_def_cls ~open_modules
   else if proto then
     (* emit_protocols ~open_modules *)
     failwith "Disabled until next release of camlkit"

lib/encode.ml

@@ -82,12 +82,17 @@ let rec string_of_objc_type ?(raise_on_struct = false) ty = match ty with
     else
       raise (Encode_type "Missing tag")
 | `Method (args, ret) ->
-  (args
-  |> List.tl  (* skip self *)
-  |> List.tl  (* skip cmd *)
-  |> List.map string_of_objc_type
-  |> String.concat " @-> ") ^
-  " @-> returning (" ^ string_of_objc_type ret ^ ")"
+  begin match args with
+  | _self :: _cmd :: [] ->
+    "returning (" ^ string_of_objc_type ret ^ ")"
+  | _ ->
+    (args
+    |> List.tl  (* skip self *)
+    |> List.tl  (* skip cmd *)
+    |> List.map string_of_objc_type
+    |> String.concat " @-> ") ^
+    " @-> returning (" ^ string_of_objc_type ret ^ ")"
+  end
 ;;
 
 let type64_to_ctype_string ty_str =

lib/lib.ml

@@ -246,6 +246,28 @@ let emit_class_module
       close_out file
 ;;
 
+let emit_class_method_def class_name ~open_modules =
+  let cls = Objc.get_class class_name
+  and file = open_out (class_name ^ "Methods.ml") in
+  emit_prelude ~open_modules file;
+  Inspect.methods cls
+  |> List.filter_map (fun m ->
+    let cmd = Sel.get_name (Method.get_name m) in
+    if String.begins_with_char '_' cmd || String.begins_with_char '.' cmd then
+      Option.none
+    else
+      Option.some (cmd, Method.get_type_encoding m))
+  |> List.sort (fun a b -> String.compare (fst a) (fst b))
+  |> List.iter (fun (cmd, enc) ->
+    let name = cmd |> String.split_on_char ':' |> String.concat "'" in
+    Encode.parse_type ~is_method:true enc
+    |> Option.iter (fun typ ->
+        Printf.fprintf file
+          "let %s imp = Define.method_spec ~cmd:(selector \"%s\") ~typ:(%s) ~enc:\"%s\" ~imp\n"
+          (valid_name name) cmd (Encode.string_of_objc_type typ) enc));
+  close_out file
+;;
+
 (* let emit_protocols ~open_modules =
   Inspect.registered_protocols ()
   |> List.iter @@ fun p ->

test/test-bridgesupport/dune

@@ -1,5 +1,6 @@
 (test
  (name test_bridgesupport)
+ (build_if (= %{context_name} "default"))
  (libraries
   lib
   lambdasoup

test/test-parse-enc/dune

@@ -1,3 +1,4 @@
 (test
  (name test_parse_enc)
+ (build_if (= %{context_name} "default"))
  (libraries lib alcotest))