rewrited from camlp4 based sexplib to PPX one

src/.merlin

@@ -1,7 +1,11 @@
 S .
 S mocml
+S ppxext
 S _build/mocml
+
 B _build
 B _build/mocml
+B _build/ppxext
+
 PKG core_kernel
 PKG yojson

src/_oasis

@@ -11,7 +11,7 @@ OCamlVersion: >= 4.02
 Library mocmllib
   Path: mocml
   Modules:          Qml,Qml2,TypAst,Qml_wrap,Qtgui,WrapAbstractItemModel,ParseYaml,TypLexer,TypParser
-  BuildDepends:     sexplib.syntax,sexplib,core_kernel,threads,str,yojson
+  BuildDepends:     core_kernel,threads,str,yojson,ppx_sexp_conv
 
 Executable mocml
   Path:             mocml
@@ -24,4 +24,3 @@ Executable ppx_qt
   BuildDepends:   compiler-libs.common,unix
   MainIs:         ppx_qt.ml
   CompiledObject: native
-

src/_tags

@@ -1,8 +1,9 @@
 # OASIS_START
-# DO NOT EDIT (digest: 5f6967e3d74627d24aebdc660c213320)
+# DO NOT EDIT (digest: cd75ebe09c2c620c1ef72c00e92b971b)
 # Ignore VCS directories, you can use the same kind of rule outside
 # OASIS_START/STOP if you want to exclude directories that contains
 # useless stuff for the build process
+true: annot, bin_annot
 <**/.svn>: -traverse
 <**/.svn>: not_hygienic
 ".bzr": -traverse
@@ -17,29 +18,24 @@
 "mocml/mocmllib.cmxs": use_mocmllib
 # Executable mocml
 "mocml/mocml.native": package(core_kernel)
-"mocml/mocml.native": package(sexplib)
-"mocml/mocml.native": package(sexplib.syntax)
+"mocml/mocml.native": package(ppx_sexp_conv)
 "mocml/mocml.native": package(str)
 "mocml/mocml.native": package(threads)
 "mocml/mocml.native": package(yojson)
 "mocml/mocml.native": use_mocmllib
-<mocml/*.ml{,i}>: package(core_kernel)
-<mocml/*.ml{,i}>: package(sexplib)
-<mocml/*.ml{,i}>: package(sexplib.syntax)
-<mocml/*.ml{,i}>: package(str)
-<mocml/*.ml{,i}>: package(threads)
-<mocml/*.ml{,i}>: package(yojson)
-<mocml/*.ml{,i}>: use_mocmllib
+<mocml/*.ml{,i,y}>: package(core_kernel)
+<mocml/*.ml{,i,y}>: package(ppx_sexp_conv)
+<mocml/*.ml{,i,y}>: package(str)
+<mocml/*.ml{,i,y}>: package(threads)
+<mocml/*.ml{,i,y}>: package(yojson)
+<mocml/*.ml{,i,y}>: use_mocmllib
 # Executable ppx_qt
 "ppxext/ppx_qt.native": package(compiler-libs.common)
 "ppxext/ppx_qt.native": package(unix)
-<ppxext/*.ml{,i}>: package(compiler-libs.common)
-<ppxext/*.ml{,i}>: package(unix)
+<ppxext/*.ml{,i,y}>: package(compiler-libs.common)
+<ppxext/*.ml{,i,y}>: package(unix)
 # OASIS_STOP
-"mocml/ParseYaml.ml": syntax_camlp4o, package_sexplib.syntax
-"mocml/TypAst.ml": syntax_camlp4o, package_sexplib.syntax
-"lib/parser.ml": syntax_camlp4o, package_sexplib.syntax
-"mocml/Parser.ml": syntax_camlp4o, package_sexplib.syntax
+"mocml/Parser.ml" or "lib/parser.ml" or "mocml/TypAst.ml" or "mocml/ParseYaml.ml": package(ppx_sexp_conv)
+
 true: debug, warn(@6)
 <test_qt>: not_hygienic
-

src/mocml/ParseYaml.ml

@@ -32,18 +32,18 @@ let parse filename : (string * (string list)) list =
 module Yaml2 = struct
   open Core_kernel
   open Sexplib.Conv
-  open Parser
+  open ParserTypes
 
   module Types = struct
-    type typ = Parser.cpptype with sexp
-    type meth = string * typ list * typ * [`Const] list with sexp
-    type sgnl = string * typ list * string list option with sexp
-    type prop = {name:string; getter:string; setter: string option; notifier: string; typ:typ} with sexp
+    type typ = cpptype [@@deriving sexp]
+    type meth = string * typ list * typ * [`Const] list [@@deriving sexp]
+    type sgnl = string * typ list * string list option [@@deriving sexp]
+    type prop = {name:string; getter:string; setter: string option; notifier: string; typ:typ} [@@deriving sexp]
     type clas =
         {classname:string; slots: meth list; signals: sgnl list; members: meth list;
-         basename: string option; props: prop list}
-    with sexp
-    type data = clas list with sexp
+         basename: string option; props: prop list} [@@deriving sexp]
+
+    type data = clas list [@@deriving sexp]
   end
 end
 

src/mocml/Parser.ml → src/mocml/ParserTypes.ml

@@ -12,7 +12,7 @@ and meth = {
   m_access:[`Public | `Protected| `Private];
   m_modif :[`Static | `Abstract | `Const | `Virtual | `Explicit | `Inline ] list
 }
-with sexp
+[@@deriving sexp]
 
 let void_type = {t_name="void"; t_is_const=false; t_indirections=0; t_is_ref=false; t_params=[] }
 let qmodelindex_type =

src/mocml/Qml_wrap.ml

@@ -4,9 +4,9 @@ module B=Bigbuffer
 open Helpers
 open B.Printf
 open ParseYaml.Yaml2.Types
-open Parser
+open ParserTypes
 open Qml
-open Config
+open GConfig
 
 let with_file path f =
   let file = open_out path in
@@ -15,7 +15,7 @@ let with_file path f =
 
 
 let generate ?(directory=".") ?(config=[]) {classname; basename; members; slots; props; signals} =
-  let (_: Config.MethOptions.t) = config in
+  let (_: GConfig.MethOptions.t) = config in
   let debugBlockingSections = List.mem config `DebugBlockingSections in
   (*printf "debugBlockingSections = %b\n" debugBlockingSections;*)
   let b_h   = B.create 100 in
@@ -68,12 +68,12 @@ let generate ?(directory=".") ?(config=[]) {classname; basename; members; slots;
 
   (* method: We generate C++ method and call OCaml in it *)
   let do_meth ~classname ~config (name,args,res,modif) =
-    let (_:Config.MethOptions.t) = config in
-    let (_:Parser.cpptype list) = args in
-    let (_:Parser.cpptype) = res in
-    let args = if args = [Parser.void_type] then [] else args in
-    p_h "  Q_INVOKABLE %s %s(%s)%s;\n" (Parser.string_of_type res) name
-      (List.map args ~f:Parser.string_of_type |> String.concat ~sep:",")
+    let (_: GConfig.MethOptions.t) = config in
+    let (_: cpptype list) = args in
+    let (_: cpptype) = res in
+    let args = if args = [void_type] then [] else args in
+    p_h "  Q_INVOKABLE %s %s(%s)%s;\n" (string_of_type res) name
+      (List.map args ~f:string_of_type |> String.concat ~sep:",")
       (if List.mem modif `Const then " const" else "");
     (* now source *)
     let locals_count = 1 + (* for _ans *)
@@ -86,8 +86,8 @@ let generate ?(directory=".") ?(config=[]) {classname; basename; members; slots;
       (List.map (args@[res]) ~f:(fun x -> x |> TypAst.of_verbose_typ_exn |> TypAst.to_ocaml_type)
           |> String.concat ~sep:"->"
       );
-    p_c "%s %s::%s(%s) %s{\n" (Parser.string_of_type res) classname name
-      (let types = List.map args ~f:Parser.string_of_type in
+    p_c "%s %s::%s(%s) %s{\n" (string_of_type res) classname name
+      (let types = List.map args ~f:string_of_type in
        List.map2_exn ~f:(sprintf "%s %s") types argnames_cpp |> String.concat ~sep:",")
       (if List.mem modif `Const then "const " else "");
     p_c "  CAMLparam0();\n";
@@ -127,7 +127,7 @@ let generate ?(directory=".") ?(config=[]) {classname; basename; members; slots;
         sprintf "caml_callbackN(_meth, %d, _args)" (n+1)
       end
     in
-    if res = Parser.void_type then begin
+    if res = void_type then begin
       p_c "  %s;\n" call_closure_str;
       enter_blocking_section ~debug:debugBlockingSections b_c;
       p_c "  CAMLreturn0;\n"
@@ -136,8 +136,8 @@ let generate ?(directory=".") ?(config=[]) {classname; basename; members; slots;
       enter_blocking_section ~debug:debugBlockingSections b_c;
       let cpp_ans_var = "cppans" in
       let new_cpp_var = Qml.getter_of_cppvars "xx" in
-      p_c "  %s %s;\n" (Parser.string_of_type res) cpp_ans_var;
-      let options = Config.TypeOptions.of_meth_options config in
+      p_c "  %s %s;\n" (string_of_type res) cpp_ans_var;
+      let options = GConfig.TypeOptions.of_meth_options config in
       Qml.cpp_value_of_ocaml ~options ~cpp_var:cpp_ans_var ~ocaml_var:"_ans"
         b_c (get_var,release_var, new_cpp_var) res;
       p_c "  CAMLreturnT(%s,%s);\n" (string_of_type res) cpp_ans_var;
@@ -199,9 +199,9 @@ let generate ?(directory=".") ?(config=[]) {classname; basename; members; slots;
     let () = match setter with
       | Some setter ->
           let (tt,convt) =
-            if typ = Parser.int_type then "int","of_int"
-            else if typ = Parser.qpoint_type then "QPoint","of_qpoint"
-            else if typ = Parser.string_type then "string","of_string"
+            if typ = int_type then "int","of_int"
+            else if typ = qpoint_type then "QPoint","of_qpoint"
+            else if typ = string_type then "string","of_string"
             else failwith "only QVariant-compatible types can be in properties"
           in
           p_ml "  method prop_%s = object\n" name;

src/mocml/TypAst.ml

@@ -10,7 +10,7 @@ type t =
   | `QGMouseEvent    (* QGraphicsSceneMouseEvent *)
   | `QByteArray
   | `QVariant
-  ] with sexp
+  ] [@@deriving sexp]
 
 let aux_variables_count (x : t) =
   let rec h = function
@@ -82,7 +82,7 @@ let to_ocaml_type (typ: t) =
   helper typ
 
 let to_verbose_typ =
-  let open Parser in
+  let open ParserTypes in
   let rec helper = function
     | `Float     -> {t_name="float";   t_is_const=false; t_indirections=0; t_is_ref=false; t_params=[] }
     | `Int       -> {t_name="int";     t_is_const=false; t_indirections=0; t_is_ref=false; t_params=[] }
@@ -110,9 +110,10 @@ let to_verbose_typ =
   in
   helper
 
-exception Cant_convert_cpptype of Parser.cpptype
+exception Cant_convert_cpptype of ParserTypes.cpptype
+
 let of_verbose_typ_exn typ: t =
-  let open Parser in
+  let open ParserTypes in
   let rec helper = function
     | {t_name="float";  t_indirections=0;_} -> `Float
     | {t_name="int";    t_indirections=0;_} -> `Int

src/mocml/WrapAbstractItemModel.ml

@@ -1,11 +1,10 @@
 open Core_kernel
 open Core_kernel.Std
-open Parser
+open ParserTypes
 open Qml
 open Helpers
 
 let qabstractItemView_members =
-  let open Parser in
   let unref_model = unreference qmodelindex_type in
   let model = {qmodelindex_type with t_is_const=true} in
   [ ("parent",      [model],  unref_model, [`Const])
@@ -71,7 +70,7 @@ let gen_cppmeth_wrapper ~classname ?(config=[]) (cbuf: Bigbuffer.t) meth =
   cpp_stub_name
 
 
-let wrap ~classname ~(config: Config.MethOptions.t) do_meth do_meth_caml b_h b_c
+let wrap ~classname ~(config: GConfig.MethOptions.t) do_meth do_meth_caml b_h b_c
     external_buf top_externals_buf clas_def_buf =
   let open Bigbuffer.Printf in
   let p_h   fmt = bprintf b_h fmt in
@@ -104,7 +103,7 @@ let wrap ~classname ~(config: Config.MethOptions.t) do_meth do_meth_caml b_h b_c
 
       (* next methods declared in C++ and are not overridable in OCaml *)
       let cpp_wrap_stubs =
-        [ (("dataChanged",[Parser.qmodelindex_type;Parser.qmodelindex_type],Parser.void_type,[]),
+        [ (("dataChanged",[qmodelindex_type; qmodelindex_type], void_type, []),
            "stub_report_dataChanged", "report_dataChanged")
         ; (("beginInsertRows",[qmodelindex_type;int_type;int_type],void_type,[]),
            "stub_beginInsertRows", "beginInsertRows")

src/mocml/qml.ml

@@ -7,6 +7,7 @@ module B=Bigbuffer
 open B.Printf
 open ParseYaml.Yaml2
 open Types
+open ParserTypes
 
 let ocaml_name_of_prop ~classname sort ({name;typ;_}) : string =
   sprintf "prop_%s_%s_%s_%s" classname name
@@ -264,10 +265,10 @@ let gen_meth ~classname ~ocaml_methname ?(options=[])
   let arg' = List.map2_exn lst argnames ~f:(sprintf "%s %s") in
   let () =
     print_h  "  %s%s %s(%s);\n"
-    (if List.mem options `Invokable then "Q_INVOKABLE " else "") (Parser.string_of_type res)
+    (if List.mem options `Invokable then "Q_INVOKABLE " else "") (string_of_type res)
     name (String.concat ~sep:"," arg') in
   let () =
-    print_cpp "%s %s::%s(%s) {\n" (Parser.string_of_type res) classname
+    print_cpp "%s %s::%s(%s) {\n" (string_of_type res) classname
     name (String.concat ~sep:"," arg') in
   print_cpp "  CAMLparam0();\n";
   let locals_count = 1 + (* for _ans *)
@@ -316,12 +317,12 @@ let gen_meth ~classname ~ocaml_methname ?(options=[])
     end
   in
   let (hasSetter,res) =
-    if Parser.is_void_type res then begin
+    if is_void_type res then begin
       match List.find options ~f:(function `Setter _ -> true | _ -> false) with
         | Some (`Setter signal) ->
             print_cpp "  _ans = %s;\n" call_closure_str;
             (Some signal,
-             Parser.({t_name="bool";t_params=[];t_indirections=0;t_is_const=false;t_is_ref=false})
+             ({t_name="bool";t_params=[];t_indirections=0;t_is_const=false;t_is_ref=false})
             )
         | None ->
             print_cpp "  %s;\n" call_closure_str;
@@ -336,17 +337,17 @@ let gen_meth ~classname ~ocaml_methname ?(options=[])
   (* Now we should convert OCaml result value to C++*)
   let new_cpp_var = getter_of_cppvars "xx" in
   let () =
-    if Parser.is_void_type res then begin
+    if is_void_type res then begin
           assert (hasSetter = None);
           ()
     end else begin
           let cpp_ans_var = "cppans" in
-          print_cpp "  %s %s;\n" (Parser.string_of_type  res) cpp_ans_var;
+          print_cpp "  %s %s;\n" (string_of_type  res) cpp_ans_var;
           cpp_value_of_ocaml file_cpp
             (get_var,release_var, new_cpp_var) ~cpp_var:cpp_ans_var ~ocaml_var:"_ans" res;
           match hasSetter with
             | Some signal ->
-                assert (Parser.is_bool_type res);
+                assert (is_bool_type res);
                 print_cpp "  if (cppans) emit %s(%s);\n" signal (List.hd_exn argnames)
             | None  ->
                 print_cpp "  return %s;\n" cpp_ans_var
@@ -392,23 +393,23 @@ let do_prop hbuf cbuf ({name;getter;setter;notifier;typ} as prop) =
   (*let p_c fmt = bprintf cbuf fmt in*)
   p_h "public:\n";
   p_h "  Q_PROPERTY(%s %s %s READ %s NOTIFY %s)\n"
-    (Parser.string_of_type typ) name (match setter with Some x -> "WRITE "^x | None -> "") getter notifier;
+    (string_of_type typ) name (match setter with Some x -> "WRITE "^x | None -> "") getter notifier;
   let ocaml_methname (x,y,_,_) = ocaml_name_of_prop ~classname `Getter prop in
-  gen_meth ~classname ~ocaml_methname ~options:[] hbuf cbuf (getter,[Parser.void_type],typ,[]);
+  gen_meth ~classname ~ocaml_methname ~options:[] hbuf cbuf (getter,[void_type],typ,[]);
   let () =
     match setter with
       | Some setter ->
           let ocaml_methname (x,y,_,_) = ocaml_name_of_prop ~classname `Setter prop in
           gen_meth ~classname ~ocaml_methname
-            ~options:[`Setter notifier] hbuf cbuf (setter,[typ],Parser.void_type,[]);
+            ~options:[`Setter notifier] hbuf cbuf (setter,[typ],void_type,[]);
       | None -> ()
   in
   p_h "signals:\n";
-  p_h "  void %s(%s);\n" notifier (Parser.string_of_type typ);
+  p_h "  void %s(%s);\n" notifier (string_of_type typ);
   gen_signal_stub ~classname ~signal:notifier ~typ:(TypAst.of_verbose_typ_exn typ)
       cbuf (stubname_for_signal_emit name notifier);
   p_h "public:\n";
-  p_h "  void emit_%s(%s arg1) {\n" notifier (Parser.string_of_type typ);
+  p_h "  void emit_%s(%s arg1) {\n" notifier (string_of_type typ);
   p_h "    emit %s(arg1);\n" notifier;
   p_h "  }\n\n"
 

src/mocml/qml2.ml

@@ -3,6 +3,7 @@ open Core_kernel.Std
 open ParseYaml
 open Printf
 open Helpers
+open ParserTypes
 
 open ParseYaml.Yaml2
 open Types
@@ -103,7 +104,7 @@ let gen_cpp {classname; members; slots; props; _ } =
       | Some s -> (true,s)
       | None   -> (false,"")
     in
-    let cpp_typ = Parser.string_of_type  typ in
+    let cpp_typ = string_of_type  typ in
     bprintf publics "  Q_PROPERTY(%s %s%s READ %s NOTIFY %s)\n" cpp_typ
       name (if declare_setter then " WRITE "^setter else "") getter notifier;
 
@@ -125,10 +126,10 @@ let gen_cpp {classname; members; slots; props; _ } =
       bprintf publics "  } }\n"
     in
 
-    bprintf signals "  void %s(%s);\n" notifier (Parser.string_of_type typ);
+    bprintf signals "  void %s(%s);\n" notifier (string_of_type typ);
     gen_signal_stub ~classname ~signal:notifier
       ~typ:(TypAst.of_verbose_typ_exn typ) cpp_buf (stubname_for_signal_emit name notifier);
-    bprintf publics "  void emit_%s(%s arg1) {\n" notifier (Parser.string_of_type typ);
+    bprintf publics "  void emit_%s(%s arg1) {\n" notifier (string_of_type typ);
     bprintf publics "    qDebug() << \"emitted %s\";\n" notifier;
     bprintf publics "    emit %s(arg1);\n" notifier;
     bprintf publics "  }\n\n";