From f07cbceaff0761f02fff8340f489eac8bed6d3f7 Mon Sep 17 00:00:00 2001
From: Damien Bihel <biheldamien@gmail.com>
Date: Tue, 20 Dec 2022 11:36:41 +0100
Subject: [PATCH 1/8] fix: add OCaml 5 support

Before OCaml5, hash_variant was defined as an alias for
caml_hash_variant in compatibility.h file
(#define hash_variant caml_hash_variant)

Seems not present in OCaml5 so this patch rename hash_variant
to caml_hash_variant.
---
 lib/stubs/variant.cpp | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/lib/stubs/variant.cpp b/lib/stubs/variant.cpp
index af0ee03..ab854c3 100644
--- a/lib/stubs/variant.cpp
+++ b/lib/stubs/variant.cpp
@@ -34,30 +34,30 @@ extern "C" {
     CAMLlocal1(_var);
 
     if (!var.isValid()) {
-        _dest = hash_variant("empty");
+        _dest =caml_hash_variant("empty");
     } else {
         const int ut = var.userType();
 
         switch (ut) {
         case QMetaType::Bool:
             _dest = caml_alloc(2, 0);
-            Store_field(_dest, 0, hash_variant("bool"));
+            Store_field(_dest, 0,caml_hash_variant("bool"));
             Store_field(_dest, 1, Val_bool(var.toBool()));
             break;
         case QMetaType::QString:
             _dest = caml_alloc(2, 0);
-            Store_field(_dest, 0, hash_variant("string"));
+            Store_field(_dest, 0,caml_hash_variant("string"));
             Store_field(_dest, 1, caml_copy_string(var.value<QString>().toLocal8Bit().data()));
             break;
         case QMetaType::Int:
             _dest = caml_alloc(2, 0);
-            Store_field(_dest, 0, hash_variant("int"));
+            Store_field(_dest, 0,caml_hash_variant("int"));
             Store_field(_dest, 1, Val_int(var.value<int>()));
             break;
         case QMetaType::Float:
         case QMetaType::Double:
             _dest = caml_alloc(2, 0);
-            Store_field(_dest, 0, hash_variant("float"));
+            Store_field(_dest, 0,caml_hash_variant("float"));
             Store_field(_dest, 1, caml_copy_double(var.toFloat()));
             break;
         case QMetaType::User:
@@ -67,7 +67,7 @@ extern "C" {
               _var = caml_alloc_small(1,Abstract_tag);
               (*((QObject **) &Field(_var, 0))) = vvv;
               _dest = caml_alloc(2,0);
-              Store_field(_dest, 0, hash_variant("qobject"));
+              Store_field(_dest, 0,caml_hash_variant("qobject"));
               Store_field(_dest, 1, _var);
             }
             break;

From 306571136021c18d28e0960a94a671bed05cbff3 Mon Sep 17 00:00:00 2001
From: Damien Bihel <biheldamien@gmail.com>
Date: Tue, 20 Dec 2022 11:44:34 +0100
Subject: [PATCH 2/8] fix opam file

---
 lablqml.opam | 1 -
 1 file changed, 1 deletion(-)

diff --git a/lablqml.opam b/lablqml.opam
index 1e7b170..c6ba8cd 100644
--- a/lablqml.opam
+++ b/lablqml.opam
@@ -15,7 +15,6 @@ build: [
   ["sh" "-exc" "PATH=/usr/lib64/qt5/bin:/usr/lib/qt5/bin:$PATH dune build -p lablqml" ] { os-distribution = "alpine" | os-distribution = "centos" | os-distribution = "fedora" }
   ["sh" "-exc" "PATH=/usr/lib64/qt5/bin:/usr/lib/qt5/bin:$PATH make demos" ] { (os-distribution = "alpine"  | os-distribution = "centos" | os-distribution = "fedora") & with-test }
 
-  ["./configure"]            { os-distribution != "alpine" & os-distribution != "centos" & os-distribution != "fedora" }
   ["dune" "build" "-p" name "-j" jobs]
                              { os-distribution != "alpine" & os-distribution != "centos" & os-distribution != "fedora" }
   [make "demos"] { with-test & os-distribution != "alpine" & os-distribution != "centos" & os-distribution != "fedora" }

From c94ebcc98d5452680956cabf04e9de4f34905d3f Mon Sep 17 00:00:00 2001
From: Damien Bihel <biheldamien@gmail.com>
Date: Tue, 20 Dec 2022 14:36:37 +0100
Subject: [PATCH 3/8] formating

---
 lib/stubs/variant.cpp | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/lib/stubs/variant.cpp b/lib/stubs/variant.cpp
index ab854c3..9aaeef8 100644
--- a/lib/stubs/variant.cpp
+++ b/lib/stubs/variant.cpp
@@ -34,30 +34,30 @@ extern "C" {
     CAMLlocal1(_var);
 
     if (!var.isValid()) {
-        _dest =caml_hash_variant("empty");
+        _dest = caml_hash_variant("empty");
     } else {
         const int ut = var.userType();
 
         switch (ut) {
         case QMetaType::Bool:
             _dest = caml_alloc(2, 0);
-            Store_field(_dest, 0,caml_hash_variant("bool"));
+            Store_field(_dest, 0, caml_hash_variant("bool"));
             Store_field(_dest, 1, Val_bool(var.toBool()));
             break;
         case QMetaType::QString:
             _dest = caml_alloc(2, 0);
-            Store_field(_dest, 0,caml_hash_variant("string"));
+            Store_field(_dest, 0, caml_hash_variant("string"));
             Store_field(_dest, 1, caml_copy_string(var.value<QString>().toLocal8Bit().data()));
             break;
         case QMetaType::Int:
             _dest = caml_alloc(2, 0);
-            Store_field(_dest, 0,caml_hash_variant("int"));
+            Store_field(_dest, 0, caml_hash_variant("int"));
             Store_field(_dest, 1, Val_int(var.value<int>()));
             break;
         case QMetaType::Float:
         case QMetaType::Double:
             _dest = caml_alloc(2, 0);
-            Store_field(_dest, 0,caml_hash_variant("float"));
+            Store_field(_dest, 0, caml_hash_variant("float"));
             Store_field(_dest, 1, caml_copy_double(var.toFloat()));
             break;
         case QMetaType::User:
@@ -67,7 +67,7 @@ extern "C" {
               _var = caml_alloc_small(1,Abstract_tag);
               (*((QObject **) &Field(_var, 0))) = vvv;
               _dest = caml_alloc(2,0);
-              Store_field(_dest, 0,caml_hash_variant("qobject"));
+              Store_field(_dest, 0, caml_hash_variant("qobject"));
               Store_field(_dest, 1, _var);
             }
             break;

From ee6916b1c52763f3063f29cf2796a7705c871d4e Mon Sep 17 00:00:00 2001
From: Damien Bihel <biheldamien@gmail.com>
Date: Tue, 20 Dec 2022 14:36:45 +0100
Subject: [PATCH 4/8] Revert "fix opam file"

This reverts commit 306571136021c18d28e0960a94a671bed05cbff3.
---
 lablqml.opam | 1 +
 1 file changed, 1 insertion(+)

diff --git a/lablqml.opam b/lablqml.opam
index c6ba8cd..1e7b170 100644
--- a/lablqml.opam
+++ b/lablqml.opam
@@ -15,6 +15,7 @@ build: [
   ["sh" "-exc" "PATH=/usr/lib64/qt5/bin:/usr/lib/qt5/bin:$PATH dune build -p lablqml" ] { os-distribution = "alpine" | os-distribution = "centos" | os-distribution = "fedora" }
   ["sh" "-exc" "PATH=/usr/lib64/qt5/bin:/usr/lib/qt5/bin:$PATH make demos" ] { (os-distribution = "alpine"  | os-distribution = "centos" | os-distribution = "fedora") & with-test }
 
+  ["./configure"]            { os-distribution != "alpine" & os-distribution != "centos" & os-distribution != "fedora" }
   ["dune" "build" "-p" name "-j" jobs]
                              { os-distribution != "alpine" & os-distribution != "centos" & os-distribution != "fedora" }
   [make "demos"] { with-test & os-distribution != "alpine" & os-distribution != "centos" & os-distribution != "fedora" }

From d3aedfe5906bcc4632f6d04c9692d5b75d832c3a Mon Sep 17 00:00:00 2001
From: Kakadu <Kakadu@pm.me>
Date: Sat, 27 Jan 2024 18:40:27 +0300
Subject: [PATCH 5/8] Fix compilation error on MacOS

Signed-off-by: Kakadu <Kakadu@pm.me>
---
 dune_test/dune | 25 ++++++++++++++++++++-----
 1 file changed, 20 insertions(+), 5 deletions(-)

diff --git a/dune_test/dune b/dune_test/dune
index d3f5a6d..e75d80f 100644
--- a/dune_test/dune
+++ b/dune_test/dune
@@ -1,4 +1,8 @@
-(env(_(flags (-w -34))))
+; (env
+;  (_
+;   (flags
+;    (:standard -w -34))))
+
 (copy_files ui/Root.qml)
 
 (library
@@ -7,7 +11,14 @@
  (modules)
  (foreign_stubs
   (language cxx)
-  (names controller_c moc_controller_c c_c moc_c_c dataItem_c moc_dataItem_c qrc_resources)
+  (names
+   controller_c
+   moc_controller_c
+   c_c
+   moc_c_c
+   dataItem_c
+   moc_dataItem_c
+   qrc_resources)
   (flags
    ((:include %{project_root}/config/c_flags.sexp)
     -fPIC
@@ -28,8 +39,6 @@
     Controller)))
  (link_flags
   (-ccopt
-   -Wl,-no-as-needed
-   -ccopt
    -fPIC
    -cclib
    -lstdc++
@@ -58,7 +67,13 @@
   (run moc %{deps} -o %{targets})))
 
 (rule
- (targets controller_c.cpp controller.h c_c.cpp c.h dataItem.h dataItem_c.cpp)
+ (targets
+  controller_c.cpp
+  controller.h
+  c_c.cpp
+  c.h
+  dataItem.h
+  dataItem_c.cpp)
  (deps Controller.ml)
  (action
   (run ../ppx/pp/pp_qt.exe -ext cpp %{deps})))

From 16ea193202e5c96813c0b7032e840e7219875d8b Mon Sep 17 00:00:00 2001
From: Kakadu <Kakadu@pm.me>
Date: Sat, 27 Jan 2024 19:41:14 +0300
Subject: [PATCH 6/8] Fix compilation of dune_test_515 on MacOS

Signed-off-by: Kakadu <Kakadu@pm.me>
---
 dune_test_515/dune |  2 --
 ppx/gencpp.ml      | 18 ++++++++++++++----
 2 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/dune_test_515/dune b/dune_test_515/dune
index cfa71c2..c092e51 100644
--- a/dune_test_515/dune
+++ b/dune_test_515/dune
@@ -25,8 +25,6 @@
     -O3)))
  (link_flags
   (-ccopt
-   -Wl,-no-as-needed
-   -ccopt
    -fPIC
    -cclib
    -lstdc++
diff --git a/ppx/gencpp.ml b/ppx/gencpp.ml
index 40d00d1..a778450 100644
--- a/ppx/gencpp.ml
+++ b/ppx/gencpp.ml
@@ -101,6 +101,10 @@ module FilesKey = struct
     | (_, CSRC), (_, CHDR) -> -1
     | (_, CHDR), (_, CSRC) -> 1
     | (x, _), (y, _) -> cmp_string x y
+
+  let realname = function
+    | (classname, CSRC) -> sprintf "%s_c.%s" classname PpxQtCfg.config.ext
+    | (classname, CHDR) -> sprintf "%s.h" classname
 end
 
 module FilesMap = Stdlib.Map.Make (FilesKey)
@@ -126,11 +130,17 @@ let get_smart_ppf f ~classname =
 let only_open ~classname =
   (*print_endline "Opening files....";*)
   let destdir = PpxQtCfg.config.destdir in
-  let ext = PpxQtCfg.config.ext in
-  let src =
-    Stdio.Out_channel.create (sprintf "%s/%s_c.%s" destdir classname ext)
+  let src_name = sprintf "%s/%s" destdir FilesKey.(realname (classname,CSRC)) in 
+  let h_name = sprintf "%s/%s" destdir FilesKey.(realname (classname,CHDR)) in 
+  let () =
+    (* On MacOS we need to make files writable. No idea why. *)
+    if Stdlib.Sys.file_exists src_name
+    then Unix.chmod src_name 0o644;
+    if Stdlib.Sys.file_exists h_name
+    then Unix.chmod h_name 0o644;
   in
-  let hdr = Stdio.Out_channel.create (sprintf "%s/%s.h" destdir classname) in
+  let src = Stdio.Out_channel.create src_name in
+  let hdr = Stdio.Out_channel.create h_name in
   (files := FilesMap.(add (classname, FilesKey.CHDR) hdr !files));
   files := FilesMap.(add (classname, FilesKey.CSRC) src !files)
 

From 60adff161ad02947b517fce87ef2b4460eb73aa5 Mon Sep 17 00:00:00 2001
From: Kakadu <Kakadu@pm.me>
Date: Thu, 1 Feb 2024 01:45:08 +0300
Subject: [PATCH 7/8] Towards Qt6 and OCaml 5

Signed-off-by: Kakadu <Kakadu@pm.me>
---
 Makefile                       |  3 +-
 config/discover.ml             | 16 ++++--
 dune_test/dune                 | 19 +++++--
 dune_test/src/controller_c.cpp | 52 ------------------
 dune_test_515/dune             | 10 ++--
 dune_test_515/stubs/dune       | 15 +++---
 lib/dune                       |  4 +-
 lib/lablqml.ml                 | 98 +++++++++++++++-------------------
 lib/lablqml.mli                | 21 ++++----
 lib/stubs/lablqml.h            | 37 +++++++------
 lib/stubs/modelindex.cpp       |  1 +
 lib/stubs/propMap_stubs.cpp    |  5 +-
 lib/stubs/startup_stubs.cpp    | 46 +++++++++++-----
 lib/stubs/stubs.cpp            | 26 ++++++---
 ppx/gencpp.ml                  | 83 +++++++++++++++-------------
 ppx/pp/pp_qt.ml                | 20 +------
 ppx/ppx_qt.ml                  | 29 ++++++++--
 17 files changed, 240 insertions(+), 245 deletions(-)
 delete mode 100644 dune_test/src/controller_c.cpp

diff --git a/Makefile b/Makefile
index 1ef45ae..93634b6 100644
--- a/Makefile
+++ b/Makefile
@@ -37,4 +37,5 @@ watch:
 doc:
 	cd doc && sphinx-build . _build
 
-
+deps:
+	opam install --yes ppx_show ppx_string_interpolation ppxlib dune-configurator dune ppx_inline_test
diff --git a/config/discover.ml b/config/discover.ml
index c44feec..4314d87 100644
--- a/config/discover.ml
+++ b/config/discover.ml
@@ -22,6 +22,11 @@ end
 
 let write_sexp fn sexp = Out_channel.write_all fn ~data:(Sexp.to_string sexp)
 
+let qtquick_pkg,rcc, moc = 
+  match Sys.getenv "QT" with 
+  | Some "6" -> "Qt6Quick", "/usr/lib/qt6/libexec/rcc", "/usr/lib/qt6/libexec/moc"
+  | _ -> "Qt5Quick", "rcc", "moc"
+
 let () =
   C.main ~name:"mylib" (fun c ->
       let default : C.Pkg_config.package_conf = { libs = []; cflags = [] } in
@@ -31,16 +36,19 @@ let () =
           | None -> C.die "pkg-config is not available"
           | Some pc -> pc
         in
-        Option.value (C.Pkg_config.query pc ~package:"Qt5Quick") ~default
+        Option.value (C.Pkg_config.query pc ~package:qtquick_pkg) ~default
       in
       let check_which s =
         if Stdlib.Sys.command (Printf.sprintf "which %s-qt5" s) = 0 then
           sprintf "%s-qt5" s
         else s
       in
-      let qmake_bin = check_which "qmake" in
-      write_sexp "moc.sexp" (sexp_of_string @@ check_which "moc");
-      write_sexp "rcc.sexp" (sexp_of_string @@ check_which "rcc");
+      let qmake_bin = check_which (match Sys.getenv "QT" with 
+        | Some "6" -> "qmake6"
+        | _ -> "qmake") 
+      in
+      write_sexp "moc.sexp" (sexp_of_string @@ check_which moc);
+      write_sexp "rcc.sexp" (sexp_of_string @@ check_which rcc);
       write_sexp "qmake.sexp" (sexp_of_string qmake_bin);
 
       let run_qmake ?prefix spec =
diff --git a/dune_test/dune b/dune_test/dune
index e75d80f..d68a346 100644
--- a/dune_test/dune
+++ b/dune_test/dune
@@ -8,6 +8,7 @@
 (library
  (name mystubs_dune_test)
  (public_name lablqmlDemos.mystubs)
+ (libraries lablqml)
  (modules)
  (foreign_stubs
   (language cxx)
@@ -23,7 +24,8 @@
    ((:include %{project_root}/config/c_flags.sexp)
     -fPIC
     -Dprotected=public
-    -std=c++11
+    -std=c++17
+    -I%{project_root}/lib
     -O3)))
  (install_c_headers controller))
 
@@ -52,19 +54,19 @@
  (targets moc_controller_c.cpp)
  (deps controller.h)
  (action
-  (run moc %{deps} -o %{targets})))
+  (run %{read:../config/moc.sexp} %{deps} -o %{targets})))
 
 (rule
  (targets moc_dataItem_c.cpp)
  (deps dataItem.h)
  (action
-  (run moc %{deps} -o %{targets})))
+  (run %{read:../config/moc.sexp} %{deps} -o %{targets})))
 
 (rule
  (targets moc_c_c.cpp)
  (deps c.h)
  (action
-  (run moc %{deps} -o %{targets})))
+  (run %{read:../config/moc.sexp} %{deps} -o %{targets})))
 
 (rule
  (targets
@@ -76,7 +78,14 @@
   dataItem_c.cpp)
  (deps Controller.ml)
  (action
-  (run ../ppx/pp/pp_qt.exe -ext cpp %{deps})))
+  (run
+   ../ppx/pp/pp_qt.exe
+   ; -nolocks
+   -tracelocks
+   ;
+   -ext
+   cpp
+   %{deps})))
 
 (rule
  (targets qrc_resources.cpp)
diff --git a/dune_test/src/controller_c.cpp b/dune_test/src/controller_c.cpp
deleted file mode 100644
index 6d07548..0000000
--- a/dune_test/src/controller_c.cpp
+++ /dev/null
@@ -1,52 +0,0 @@
-/*
- * Generated at 16 Jul, 2018 19:36:50
- */
-#include "controller.h"
-
-// controller::getdescr: void,QString
-QString controller::getdescr()  {
-  CAMLparam0();
-  CAMLlocal3(_ans,_meth,_x0);
-  CAMLlocalN(_args,2);
-  CAMLlocal1(_cca0);
-  caml_acquire_runtime_system();
-  value _camlobj = this->_camlobjHolder;
-  Q_ASSERT(Is_block(_camlobj));
-  Q_ASSERT(Tag_val(_camlobj) == Object_tag);
-  _meth = caml_get_public_method(_camlobj, caml_hash_variant("getdescr"));
-  _ans = caml_callback2(_meth, _camlobj, Val_unit);;
-  caml_release_runtime_system();
-  QString cppans;
-  cppans = QString(String_val(_ans));
-  CAMLreturnT(QString,cppans);
-}
-// stub: void name(QString)
-extern "C" value caml_controller_descrChanged_cppmeth_wrapper(value _cppobj,value _x0) {
-  CAMLparam2(_cppobj,_x0);
-  // aux vars count = 0
-  caml_release_runtime_system();
-  controller *o = (controller*) (Field(_cppobj,0));
-  QString z0;
-  z0 = QString(String_val(_x0));
-  o->descrChanged(z0);
-  caml_acquire_runtime_system();
-  CAMLreturn(Val_unit);
-}
-extern "C" value caml_create_controller(value _dummyUnitVal) {
-  CAMLparam1(_dummyUnitVal);
-  CAMLlocal1(_ans);
-  caml_release_runtime_system();
-  _ans = caml_alloc_small(1, Abstract_tag);
-  (*((controller **) &Field(_ans, 0))) = new controller();
-  caml_acquire_runtime_system();
-  CAMLreturn(_ans);
-}
-
-extern "C" value caml_store_value_in_controller(value _cppobj,value _camlobj) {
-  CAMLparam2(_cppobj,_camlobj);
-  caml_release_runtime_system();
-  controller *o = (controller*) (Field(_cppobj,0));
-  o->storeCAMLobj(_camlobj);
-  caml_acquire_runtime_system();
-  CAMLreturn(Val_unit);
-}
diff --git a/dune_test_515/dune b/dune_test_515/dune
index c092e51..bd454c2 100644
--- a/dune_test_515/dune
+++ b/dune_test_515/dune
@@ -8,12 +8,10 @@
 (executable
  (name app)
  (public_name lablqmlDemos.app515)
- (libraries MyControls
-   lablqml lwt.unix threads mystubs_dune_hack)
+ (libraries MyControls lablqml lwt.unix threads mystubs_dune_hack)
  (modules app)
  (flags
   (:standard -w -33-27))
-
  (foreign_stubs
   (language cxx)
   (names qrc_resources proj2_qmltyperegistrations)
@@ -21,7 +19,7 @@
   (flags
    ((:include %{project_root}/../config/c_flags.sexp)
     -fPIC
-    -std=c++11
+    -std=c++17
     -O3)))
  (link_flags
   (-ccopt
@@ -52,15 +50,13 @@
  (deps stubs/moc_Singleton1_c.cpp.json)
  (action
   (run
-   moc
+   /usr/lib/qt6/libexec/moc
    %{read:../config/I_QT_INSTALL_HEADERS.sexp}
    --collect-json
    %{deps}
    -o
    %{target})))
 
-
-
 ; TODO: generated file should depend on the contents of .qrc file
 ;     xpath -q -e '/RCC/qresource/file/text()' hack/src/resources.qrc
 ; from  the apt package libxml-xpath-perl
diff --git a/dune_test_515/stubs/dune b/dune_test_515/stubs/dune
index bbb76d1..5aaa762 100644
--- a/dune_test_515/stubs/dune
+++ b/dune_test_515/stubs/dune
@@ -2,13 +2,11 @@
  (public_name app.MyControls)
  (name MyControls)
  (modules MyControls)
- (libraries lablqml )
+ (libraries lablqml)
  (preprocess
   (per_module
    ((pps lablqml.ppx)
-    MyControls)))
-)
-
+    MyControls))))
 
 (library
  (name mystubs_dune_hack)
@@ -19,12 +17,13 @@
   (flags
    ((:include %{project_root}/../config/c_flags.sexp)
     -fPIC
-    -std=c++11
+    -std=c++17
     -I.
+    -I%{project_root}/lib/
+    -I../../lib
     -O3)))
  (install_c_headers Singleton1))
 
-
 (rule
  (targets moc_Singleton1_c.cpp moc_Singleton1_c.cpp.json)
  (deps Singleton1.h)
@@ -32,7 +31,7 @@
  ; (>= %{read:QT_VERSION.sexp} 5.15))    ;; Doesn't work
  (action
   (run
-   moc
+   %{read:../../config/moc.sexp}
    %{read:../../config/I_QT_INSTALL_HEADERS.sexp}
    --output-json
    %{deps}
@@ -53,7 +52,7 @@
  (targets moc_myslider_c.cpp)
  (deps myslider.h)
  (action
-  (run moc %{deps} -o %{targets})))
+  (run %{read:../../config/moc.sexp} %{deps} -o %{targets})))
 
 (rule
  (targets myslider_c.cpp myslider.h)
diff --git a/lib/dune b/lib/dune
index 08ad0c5..21209a4 100644
--- a/lib/dune
+++ b/lib/dune
@@ -27,12 +27,12 @@
   (flags
    ((:include %{project_root}/config/c_flags.sexp)
     -Wall
-    -std=c++11
+    -std=c++17
     -O3
     -I
     .
     ; dirty hack next line
-    -Dprivate=public
+    ; -Dprivate=public
     -fPIC)))
  (c_library_flags
   (:include %{project_root}/config/c_library_flags.sexp))
diff --git a/lib/lablqml.ml b/lib/lablqml.ml
index 59eb8c7..df73c3f 100644
--- a/lib/lablqml.ml
+++ b/lib/lablqml.ml
@@ -6,25 +6,17 @@ let container : t M.t ref = ref M.empty
 let add_view name (v : t) = container := M.add name v !container
 let () = Callback.register "register_view" add_view
 let get_view_exn ~name = M.find name !container
-
-let get_view ~name =
-  try Some (get_view_exn ~name) with
-  | Not_found -> None
-;;
+let get_view ~name = try Some (get_view_exn ~name) with Not_found -> None
 
 type _ cppobj = [ `cppobject ]
 
-external set_context_property
-  :  ctx:t
-  -> name:string
-  -> _ cppobj
-  -> unit
+external set_context_property : ctx:t -> name:string -> _ cppobj -> unit
   = "caml_setContextProperty"
 
 module QPoint = struct
   type t = int * int
 
-  let create x y = x, y
+  let create x y = (x, y)
   let x = fst
   let y = snd
 end
@@ -38,8 +30,7 @@ module QVariant = struct
     | `qobject of wrap_cppobj
     | `int of int
     | `bool of bool
-    | `float of float
-    ]
+    | `float of float ]
 
   let empty = `empty
   let of_string s = `string s
@@ -54,10 +45,10 @@ end
 module QModelIndex = struct
   type t = int * int
 
-  let empty = -1, -1
+  let empty = (-1, -1)
   let row = fst
   let column = snd
-  let make ~row ~column = row, column
+  let make ~row ~column = (row, column)
   let to_string (row, column) = Printf.sprintf "(%d,%d)" row column
 end
 
@@ -67,7 +58,8 @@ class test_object ptr =
   object
     method handler = ptr
 
-    method property : string -> QVariant.t = fun name -> qobject_property ptr name
+    method property : string -> QVariant.t =
+      fun name -> qobject_property ptr name
   end
 
 module QGuiApplication = struct
@@ -79,13 +71,15 @@ end
 module QQmlEngine = struct
   type t
 
-  external register_context : name:string -> t -> unit = "caml_QQmlEngine_registerContext"
-  external add_import_path : string -> t -> unit = "caml_QQmlEngine_addImportPath"
+  external register_context : name:string -> t -> unit
+    = "caml_QQmlEngine_registerContext"
+
+  external add_import_path : string -> t -> unit
+    = "caml_QQmlEngine_addImportPath"
 end
 
-external create_qguiapplication_stub
-  :  string array
-  -> QGuiApplication.t * QQmlEngine.t
+external create_qguiapplication_stub :
+  string array -> QGuiApplication.t * QQmlEngine.t
   = "caml_create_QQmlEngine_and_app"
 
 let create_qapplication argv = create_qguiapplication_stub argv
@@ -104,10 +98,7 @@ module QQuickWindow = struct
   let as_test_object win = new test_object (as_test_object_stub win)
 end
 
-external loadQml_stub
-  :  string
-  -> QQmlEngine.t
-  -> QQuickWindow.t option
+external loadQml_stub : string -> QQmlEngine.t -> QQuickWindow.t option
   = "caml_QQmlEngine_loadQml"
 
 let loadQml path engine = loadQml_stub path engine
@@ -116,30 +107,27 @@ let loadQml path engine = loadQml_stub path engine
 module QQmlAppEngine = struct
   type t
 
-  external to_QQmlEngine : t -> QQmlEngine.t = "caml_QQmlAppEngine_to_QQmlEngine"
-  external root_named : t -> string -> _ cppobj = "caml_qml_application_engine_root_named"
+  external to_QQmlEngine : t -> QQmlEngine.t
+    = "caml_QQmlAppEngine_to_QQmlEngine"
+
+  external root_named : t -> string -> _ cppobj
+    = "caml_qml_application_engine_root_named"
 end
 
 (* TODO: make the names good *)
-external create_app_engine_stub
-  :  string array
-  -> string
-  -> QGuiApplication.t * QQmlAppEngine.t
+external create_app_engine_stub :
+  string array -> string -> QGuiApplication.t * QQmlAppEngine.t
   = "caml_create_QQmlAppEngine_and_app"
 
 let create_app_engine argv path = create_app_engine_stub argv path
 
-external run_with_QQmlApplicationEngine_stub
-  :  string array
-  -> (unit -> unit)
-  -> string
-  -> unit
+external run_with_QQmlApplicationEngine_stub :
+  string array -> (unit -> unit) -> string -> unit
   = "caml_run_QQmlApplicationEngine"
 
 (* TODO: add labeled arguments *)
 let run_with_QQmlApplicationEngine argv init path =
   run_with_QQmlApplicationEngine_stub argv init path
-;;
 
 type qvariantable
 type non_qvariantable
@@ -147,16 +135,13 @@ type non_qvariantable
 class virtual ['valtyp] prop (_name : string) =
   object (self)
     method name = _name
-
     method virtual get : 'valtyp
-
     method virtual set : 'valtyp -> unit
   end
 
 class virtual ['valtyp] qvariant_prop _name =
   object (self)
     inherit ['valtyp] prop _name as base
-
     method virtual wrap_in_qvariant : 'valtyp -> QVariant.t
   end
 
@@ -174,11 +159,17 @@ end = struct
 
   let handler : t -> t cppobj = fun x -> x
 
-  external create_stub : callback_t -> unit -> t cppobj = "caml_create_QQmlPropertyMap"
-  external insert_stub : t -> string -> QVariant.t -> unit = "caml_QQmlPropertyMap_insert"
+  external create_stub : callback_t -> unit -> t cppobj
+    = "caml_create_QQmlPropertyMap"
+
+  external insert_stub : t -> string -> QVariant.t -> unit
+    = "caml_QQmlPropertyMap_insert"
+
   external value_stub : t -> string -> QVariant.t = "caml_QQmlPropertyMap_value"
 
-  let create ?(callback : callback_t = fun _ _ -> ()) () = create_stub callback ()
+  let create ?(callback : callback_t = fun _ _ -> ()) () =
+    create_stub callback ()
+
   let insert map ~name variant = insert_stub map name variant
   let value_ map name = value_stub map name
 end
@@ -187,26 +178,21 @@ module OCamlObject = struct
   type t = t cppobj
   type variant_fn_t = QVariant.t -> unit
 
-  external binding_stub
-    :  create:bool
-    -> obj:t cppobj
-    -> name:string
-    -> fn:variant_fn_t
-    -> t
+  external binding_stub :
+    create:bool -> obj:t cppobj -> name:string -> fn:variant_fn_t -> t
     = "ocamlobject_binding"
 
-  let binding ?(create = false) obj name fn = binding_stub ~create ~obj ~name ~fn
+  let binding ?(create = false) obj name fn =
+    binding_stub ~create ~obj ~name ~fn
 
   (*external value: obj:t -> QVariant.t = "ocamlobject_value"*)
   external write : obj:t -> QVariant.t -> bool = "ocamlobject_write"
 end
 
-external object_child_named : 'a cppobj -> string -> 'b cppobj = "caml_qml_child_named"
+external object_child_named : 'a cppobj -> string -> 'b cppobj
+  = "caml_qml_child_named"
 
-external object_property_named
-  :  _ cppobj
-  -> string
-  -> _ cppobj
+external object_property_named : _ cppobj -> string -> _ cppobj
   = "caml_qml_property_child_named"
 
 module SingleFunc : sig
@@ -223,3 +209,5 @@ end = struct
 
   let create cb = create_stub cb
 end
+
+external set_check_locks : bool -> unit = "caml_lablqml_set_check_locks"
diff --git a/lib/lablqml.mli b/lib/lablqml.mli
index 281e00d..20e67eb 100644
--- a/lib/lablqml.mli
+++ b/lib/lablqml.mli
@@ -16,8 +16,7 @@ module QVariant : sig
     | `qobject of wrap_cppobj
     | `int of int
     | `bool of bool
-    | `float of float
-    ]
+    | `float of float ]
 
   val empty : t
   val of_string : string -> t
@@ -31,7 +30,6 @@ class test_object :
   t
   -> object
        method handler : t
-
        method property : string -> QVariant.t
      end
 
@@ -59,8 +57,8 @@ module QQmlEngine : sig
   val add_import_path : string -> t -> unit
 end
 
-(** Creates QGuiApplication. No platform-dependent styling applied. *)
 val create_qapplication : string array -> QGuiApplication.t * QQmlEngine.t
+(** Creates QGuiApplication. No platform-dependent styling applied. *)
 
 module QQuickWindow : sig
   type t
@@ -71,8 +69,8 @@ module QQuickWindow : sig
   val as_test_object : t -> test_object
 end
 
-(** Creates QQuickWindow using file and QQmlEngine *)
 val loadQml : string -> QQmlEngine.t -> QQuickWindow.t option
+(** Creates QQuickWindow using file and QQmlEngine *)
 
 (* This QML engine applies platform-dependent styling. With this engine
  * your root QML object should be a Window form QtQuick.Controls library.
@@ -88,14 +86,16 @@ end
 val object_child_named : 'a cppobj -> string -> 'a cppobj
 val object_property_named : 'a cppobj -> string -> 'a cppobj
 
+val create_app_engine :
+  string array -> string -> QGuiApplication.t * QQmlAppEngine.t
 (** Creates QGuiApplication and QQmlApplicationEngine. *)
-val create_app_engine : string array -> string -> QGuiApplication.t * QQmlAppEngine.t
 
+val run_with_QQmlApplicationEngine :
+  string array -> (unit -> unit) -> string -> unit
 (** Function [run_with_QQmlApplicationEngine argv callback path] initializates
     and open QQuickWindow using QQmlApplcationEngine. It uses platform-dependent
     styling, so the root element of the QML file specified in [path] should be
     a Window from QtQuick.Controls library *)
-val run_with_QQmlApplicationEngine : string array -> (unit -> unit) -> string -> unit
 
 type qvariantable
 type non_qvariantable
@@ -104,9 +104,7 @@ class virtual ['valtyp] prop :
   string
   -> object
        method virtual get : 'valtyp
-
        method name : string
-
        method virtual set : 'valtyp -> unit
      end
 
@@ -114,11 +112,8 @@ class virtual ['valtyp] qvariant_prop :
   string
   -> object
        method virtual get : 'valtyp
-
        method name : string
-
        method virtual set : 'valtyp -> unit
-
        method virtual wrap_in_qvariant : 'valtyp -> QVariant.t
      end
 
@@ -145,3 +140,5 @@ module SingleFunc : sig
   val handler : t -> 'a cppobj
   val create : (unit -> unit) -> t
 end
+
+val set_check_locks : bool -> unit
diff --git a/lib/stubs/lablqml.h b/lib/stubs/lablqml.h
index e89388b..7ae5e5c 100644
--- a/lib/stubs/lablqml.h
+++ b/lib/stubs/lablqml.h
@@ -1,5 +1,11 @@
 #pragma once
 
+#include <QtCore/QAbstractItemModel>
+#include <QtCore/QString>
+#include <QtCore/QDebug>
+#include <QtQml/QQmlContext>
+
+
 extern "C" {
 #include <caml/mlvalues.h>
 #include <caml/alloc.h>
@@ -11,10 +17,6 @@ extern "C" {
 #include <caml/fail.h>
 }
 
-#include <QtCore/QAbstractItemModel>
-#include <QtCore/QString>
-#include <QtQml/QQmlContext>
-
 #define Ctype_of_val(T, V) (*((T **) Data_custom_val(V)))
 #define Ctype_field(T, B, I) ((*((T **) &Field(B, I))))
 
@@ -33,20 +35,25 @@ static value Val_some(value v) {
   CAMLreturn(some);
 }
 
+extern bool lablqml_check_locks;
 
-/* #define DEBUG_ENTER_OCAML \
-    qDebug() << "ENTER TO OCAML == acquire_runtime == leave_section" << __FILE__ << __LINE__;
+#define DEBUG_ENTER_OCAML \
+    qDebug() << "ENTER OCAML == release_runtime_lock " << __FILE__ << __LINE__;
 #define DEBUG_LEAVE_OCAML \
-    qDebug() << "LEAVE TO OCAML == release_runtime == enter_section" << __FILE__ << __LINE__;
- */
-
-#define DEBUG_ENTER_OCAML
-#define DEBUG_LEAVE_OCAML
+    qDebug() << "LEAVE OCAML == acquire_runtime_lock" << __FILE__ << __LINE__;
 
-#define LABLQML_ENTER_OCAML \
-    DEBUG_ENTER_OCAML \
-    caml_acquire_runtime_system();
+#define LABLQML_USE_LOCKS 1
+// #define DEBUG_ENTER_OCAML
+// #define DEBUG_LEAVE_OCAML
 
 #define LABLQML_LEAVE_OCAML \
+  if (lablqml_check_locks) { \
     DEBUG_LEAVE_OCAML \
-    caml_release_runtime_system();
+    if (LABLQML_USE_LOCKS) caml_acquire_runtime_system(); \
+  }
+
+#define LABLQML_ENTER_OCAML \
+  if (lablqml_check_locks) { \
+    DEBUG_ENTER_OCAML \
+    if (LABLQML_USE_LOCKS) caml_release_runtime_system(); \
+  }
diff --git a/lib/stubs/modelindex.cpp b/lib/stubs/modelindex.cpp
index a3d886f..fa0a949 100644
--- a/lib/stubs/modelindex.cpp
+++ b/lib/stubs/modelindex.cpp
@@ -1,3 +1,4 @@
+#define private public
 #include <QtCore/QAbstractItemModel>
 
 QModelIndex make_qmodelindex4(int x, int y, void* ptr, const QAbstractItemModel *amodel) {
diff --git a/lib/stubs/propMap_stubs.cpp b/lib/stubs/propMap_stubs.cpp
index bde6079..4469b4a 100644
--- a/lib/stubs/propMap_stubs.cpp
+++ b/lib/stubs/propMap_stubs.cpp
@@ -1,10 +1,11 @@
+#include <QtCore/QDebug>
+#include <QtQml/QQmlEngine>
+
 #include "lablqml.h"
 
 #include "variant.h"
 #include "CamlPropertyMap.h"
 
-#include <QtCore/QDebug>
-#include <QtQml/QQmlEngine>
 
 extern "C" {
 
diff --git a/lib/stubs/startup_stubs.cpp b/lib/stubs/startup_stubs.cpp
index dc031de..8c92bc5 100644
--- a/lib/stubs/startup_stubs.cpp
+++ b/lib/stubs/startup_stubs.cpp
@@ -1,10 +1,3 @@
-#include "lablqml.h"
-
-/*  QGuiApplication for any GUI application
- *  QApplication inherits QGuiApplication is for QWidget-based apps.
- *  We use first one.
- */
-// #define QT_QML_DEBUG // Enable for access with QML profiler
 #include <QtGui/QGuiApplication>
 #include <QtQml/QQmlEngine>
 #include <QtQml/QQmlApplicationEngine>
@@ -13,6 +6,15 @@
 #include <QtQuick/QQuickItem>
 #include <QtCore/QDirIterator>
 
+#include "lablqml.h"
+
+/*  QGuiApplication for any GUI application
+ *  QApplication inherits QGuiApplication is for QWidget-based apps.
+ *  We use first one.
+ */
+// #define QT_QML_DEBUG // Enable for access with QML profiler
+
+
 /* This is a crazy macro to allocation argc and argv and pass them to
  * QApplication. The problem is that we need copying of argv because they are
  * ocaml values that can be moved. Moreover, we need to allocate argc because
@@ -242,9 +244,12 @@ extern "C" value caml_QQuickWindow_showFullScreen(value _w) {
 extern "C" value caml_run_QQmlApplicationEngine(value _argv, value _cb, value _qmlpath) {
   CAMLparam3(_argv, _cb, _qmlpath);
   CAMLlocal2(_ctx, _cb_res);
-  //qDebug() << "App exec. inside caml_run_QQmlApplicationEngine. "<<__FILE__<< ", line " << __LINE__ ;
-  LABLQML_LEAVE_OCAML;
+  // LABLQML_LEAVE_OCAML;
+  qDebug() << "App exec. inside caml_run_QQmlApplicationEngine. " << __FILE__ << ", line " << __LINE__;
 
+
+  lablqml_check_locks = false;
+  qDebug() << "lablqml_check_locks = " << lablqml_check_locks;
   ARGC_N_ARGV(_argv, copy);
 
   /*
@@ -265,13 +270,22 @@ extern "C" value caml_run_QQmlApplicationEngine(value _argv, value _cb, value _q
   _ctx = caml_alloc_small(1, Abstract_tag);
   (*((QQmlContext **) &Field(_ctx, 0))) = ctxt; */
   //debug_leave_blocking;
-  caml_leave_blocking_section();
+  // LABLQML_ENTER_OCAML;
+  // caml_release_runtime_system();
+  qDebug() << __FILE__ << ", line " << __LINE__;
   _cb_res = caml_callback(_cb, Val_unit);
+  qDebug() << __FILE__ << ", line " << __LINE__;
   //debug_enter_blocking;
-  caml_enter_blocking_section();
+  // LABLQML_LEAVE_OCAML
   Q_ASSERT(_cb_res == Val_unit);
 
-  engine.load(QUrl(QString(String_val(_qmlpath))));
+  const QString &path = QString(String_val(_qmlpath));
+  LABLQML_ENTER_OCAML;
+  qDebug() << __FILE__ << ", line " << __LINE__;
+  engine.load(QUrl(path));
+  LABLQML_LEAVE_OCAML;
+  qDebug() << __FILE__ << ", line " << __LINE__;
+
   QList<QObject*> xs = engine.rootObjects();
   if (xs.count() == 0) {
     Q_ASSERT_X(false, "Creating C++ runtime", "Your QML file seems buggy");
@@ -279,8 +293,12 @@ extern "C" value caml_run_QQmlApplicationEngine(value _argv, value _cb, value _q
   QQuickWindow *window = qobject_cast<QQuickWindow*>(xs.at(0));
   Q_ASSERT_X(window != nullptr, "Creating C++ runtime", "Couldn't cast root object to QQuickWindow");
   window->show();
-  //qDebug() << "executing app.exec()";
+  lablqml_check_locks = true;
+  qDebug() << "lablqml_check_locks = " << lablqml_check_locks;
+  caml_release_runtime_system();
+  // qDebug() << "executing app.exec()";
   app.exec();
-  caml_leave_blocking_section();
+
+
   CAMLreturn(Val_unit);
 }
diff --git a/lib/stubs/stubs.cpp b/lib/stubs/stubs.cpp
index 968bfd0..13f3524 100644
--- a/lib/stubs/stubs.cpp
+++ b/lib/stubs/stubs.cpp
@@ -6,11 +6,12 @@
 #include <QQuickWindow>
 
 void registerContext(const QString& name, QQmlContext* v) {
+  // LABLQML_LEAVE_OCAML;
   CAMLparam0();
   CAMLlocal3(_name,_view,_ans);
   static value *closure = nullptr;
 
-  LABLQML_ENTER_OCAML;
+
 
   if (closure == nullptr) {
     closure = (value*) caml_named_value("register_view") ;
@@ -21,7 +22,7 @@ void registerContext(const QString& name, QQmlContext* v) {
   (*((QQmlContext **) &Field(_view, 0))) = v;
   _ans = caml_callback2(*closure, _name, _view); // should be a unit
 
-  LABLQML_LEAVE_OCAML;
+  // LABLQML_ENTER_OCAML;
 
   Q_UNUSED(_ans);
   CAMLreturn0;
@@ -30,6 +31,7 @@ void registerContext(const QString& name, QQmlContext* v) {
 // ctx:t -> name:string -> cppobj -> unit
 extern "C" value caml_setContextProperty(value _ctx, value _name, value _cppObj) {
   CAMLparam3(_ctx,_name,_cppObj);
+  // LABLQML_LEAVE_OCAML;
 
   Q_ASSERT( Tag_val(_ctx) == Abstract_tag );
   Q_ASSERT( Tag_val(_cppObj) == Abstract_tag || Tag_val(_cppObj) == Custom_tag );
@@ -40,32 +42,34 @@ extern "C" value caml_setContextProperty(value _ctx, value _name, value _cppObj)
     (*(QObject**) (Data_custom_val(_cppObj))) : ((QObject*) Field(_cppObj,0));
   ctx->setContextProperty(name, o);
   //qDebug() << "setted property " << name << " to " << o;
+  // LABLQML_ENTER_OCAML;
   CAMLreturn(Val_unit);
 }
 
 // string -> QQmlEngine.t -> unit
 extern "C" value caml_QQmlEngine_registerContext(value _name, value _engine) {
   CAMLparam2(_name,_engine);
+  // LABLQML_LEAVE_OCAML;
 
-  Q_ASSERT( true );
-  QQmlEngine  *engine = ((QQmlEngine*) Field(_engine,0));
+  QQmlEngine *engine = ((QQmlEngine*) Field(_engine,0));
   Q_ASSERT(engine != nullptr);
   QQmlContext *ctx = engine->rootContext();
   const QString &name = QString::fromLocal8Bit(String_val(_name));
-  LABLQML_LEAVE_OCAML;
   registerContext(name, ctx);
-  LABLQML_ENTER_OCAML;
+  // LABLQML_ENTER_OCAML;
   CAMLreturn(Val_unit);
 }
 
 // string -> QQmlEngine.t -> unit
 extern "C" value caml_QQmlEngine_addImportPath(value _path, value _engine) {
   CAMLparam2(_path,_engine);
+  // LABLQML_LEAVE_OCAML;
 
-  QQmlEngine  *engine = ((QQmlEngine*) Field(_engine,0));
+  QQmlEngine *engine = ((QQmlEngine*) Field(_engine,0));
   Q_ASSERT(engine != nullptr);
   const QString &path = QString::fromLocal8Bit(String_val(_path));
   engine->addImportPath(path);
+  // LABLQML_ENTER_OCAML;
   CAMLreturn(Val_unit);
 }
 
@@ -158,6 +162,14 @@ extern "C" value caml_quick_window_find_child(value window_val, value name_val)
     CAMLreturn(Val_some(object_val));
 }
 
+bool lablqml_check_locks = false;
+
+extern "C" value caml_lablqml_set_check_locks(value b) {
+  CAMLparam1(b);
+  lablqml_check_locks = Bool_val(b);
+  CAMLreturn(Val_unit);
+}
+
 /*
 extern "C" value caml_set_caml_object(value _cppobj,value _camlobj) {
   CAMLparam2(_cppobj, _camlobj);
diff --git a/ppx/gencpp.ml b/ppx/gencpp.ml
index a778450..c60edee 100644
--- a/ppx/gencpp.ml
+++ b/ppx/gencpp.ml
@@ -46,6 +46,8 @@ let fprintfn ppf fmt = Format.ksprintf (Format.fprintf ppf "%s\n%!") fmt
 let print_time ppf =
   fprintfn ppf "/*";
   fprintfn ppf " * Generated at %s" Time.(now () |> to_string);
+  fprintfn ppf " *   insert_locks = %b" PpxQtCfg.config.insert_locks;
+  fprintfn ppf " *   trace_locks  = %b" PpxQtCfg.config.trace_locks;
   fprintfn ppf " */"
 
 let ref_append ~set x = set := !set @ [ x ] [@@warning "-32"]
@@ -62,11 +64,9 @@ type opt_item = OInstantiable | OItemModel | OItemModelVal of string option
 
 module Options = struct
   type item = opt_item
-
   type t = item list
 
   let myfind x ~set = List.mem set x ~equal:Stdlib.( = )
-
   let is_itemmodel set = myfind OItemModel ~set
 
   let has_itemmodel_val set =
@@ -74,24 +74,33 @@ module Options = struct
 end
 
 let enter_blocking_section ch =
-  if PpxQtCfg.config.insert_locks then
+  (* Format.eprintf "inside enter_blocking_section\n"; *)
+  if PpxQtCfg.config.insert_locks then (
+    fprintfn ch "  if (lablqml_check_locks) {";
     let () =
-      if PpxQtCfg.config.trace_locks then
-        fprintfn ch "  qDebug() << \"release_runtime_system();\";"
+      if PpxQtCfg.config.trace_locks then (
+        fprintfn ch {|    qDebug() << "Caml_state_opt = " << Caml_state_opt;|};
+        fprintfn ch
+          {|    qDebug() << "release_runtime_system()" << Q_FUNC_INFO;|})
     in
-    fprintfn ch "  caml_release_runtime_system();"
+    fprintfn ch "  caml_release_runtime_system();";
+    fprintfn ch "}")
 
 let leave_blocking_section ch =
-  if PpxQtCfg.config.insert_locks then
+  (* Format.eprintf "inside leave_blocking_section\n"; *)
+  if PpxQtCfg.config.insert_locks then (
+    fprintfn ch "  if (lablqml_check_locks) {";
     let () =
-      if PpxQtCfg.config.trace_locks then
-        fprintfn ch "  qDebug() << \"acquire_runtime_system();\";"
+      if PpxQtCfg.config.trace_locks then (
+        fprintfn ch {|  qDebug() << "Caml_state_opt = " << Caml_state_opt;|};
+        fprintfn ch
+          {|  qDebug() << "acquire_runtime_system();" << Q_FUNC_INFO;|})
     in
-    fprintfn ch "  caml_acquire_runtime_system();"
+    fprintfn ch "  caml_acquire_runtime_system();";
+    fprintfn ch "}")
 
 module FilesKey = struct
   type ext = CSRC | CHDR
-
   type t = string * ext
 
   let cmp_string : string -> string -> int = String.compare
@@ -110,9 +119,7 @@ end
 module FilesMap = Stdlib.Map.Make (FilesKey)
 
 let files = ref FilesMap.empty
-
 let get_header_ch ~classname = FilesMap.find (classname, FilesKey.CHDR) !files
-
 let get_source_ch ~classname = FilesMap.find (classname, FilesKey.CSRC) !files
 
 let get_header_ppf ~classname =
@@ -183,6 +190,7 @@ let print_header_preamble ~classname =
   println "#include <QtCore/QAbstractItemModel>";
   println "#include <QtQml/QQmlEngine>";
   println "#include <QtQml/QtQml>  // macro like QML_ELEMENT, etc.";
+  println "#include <lablqml.h>";
   println "";
   println "#ifdef __cplusplus";
   println "extern \"C\" {";
@@ -202,6 +210,7 @@ let open_files ~options ~classname =
   print_header_preamble ~classname;
   let ppf = get_header_ppf ~classname in
   let println fmt = fprintfn ppf fmt in
+  println "#define DO_CHECK_CAML_STATE 0";
   println "class %s : public %s {" classname
     (if Options.is_itemmodel options then "QAbstractItemModel" else "QObject");
   println "  Q_OBJECT";
@@ -213,7 +222,7 @@ let open_files ~options ~classname =
   println "       //maybe unregister global root?";
   println "    }";
   println "    _camlobjHolder = x;";
-  println "    register_global_root(&_camlobjHolder);";
+  println "    caml_register_global_root(&_camlobjHolder);";
   println "  }\n";
   let () =
     if Options.is_itemmodel options then (
@@ -278,13 +287,13 @@ let close_files ?(caml_owner = true) ~options:_ () =
             classname;
           println "  CAMLparam1(_dummyUnitVal);";
           println "  CAMLlocal1(_ans);";
-          enter_blocking_section ppf;
+          (* leave_blocking_section ppf; *)
           alloc_and_store ppf ~classname
             ~obj:(sprintf "new %s()" classname)
             ~where:"_ans";
           (* println "  _ans = caml_alloc_small(1, Abstract_tag);";
              println "  (*((%s **) &Field(_ans, 0))) = new %s();" classname classname; *)
-          leave_blocking_section ppf;
+          (* enter_blocking_section ppf; *)
           println "  CAMLreturn(_ans);";
           println "}\n";
           println
@@ -292,10 +301,10 @@ let close_files ?(caml_owner = true) ~options:_ () =
              _camlobj) {"
             classname;
           println "  CAMLparam2(_cppobj,_camlobj);";
-          enter_blocking_section ppf;
+          (* leave_blocking_section ppf; *)
           println "  %s *o = (%s*) (Field(_cppobj,0));" classname classname;
           println "  o->storeCAMLobj(_camlobj);";
-          leave_blocking_section ppf;
+          (* enter_blocking_section ppf; *)
           println "  CAMLreturn(Val_unit);";
           println "}")
     (*
@@ -320,9 +329,7 @@ let close_files ?(caml_owner = true) ~options:_ () =
 
 module Names = struct
   let signal_of_prop s = s ^ "Changed"
-
   let getter_of_prop s = "get" ^ s
-
   let setter_of_prop s = "set" ^ s
 end
 
@@ -375,7 +382,6 @@ let print_declarations ?(mode = Local) ppf xs =
   helper xs
 
 let print_local_declarations ch xs = print_declarations ~mode:Local ch xs
-
 let print_param_declarations ch xs = print_declarations ~mode:Param ch xs
 
 let cpp_value_of_ocaml ?(options = []) ~cppvar ~ocamlvar ppf
@@ -565,7 +571,7 @@ let gen_stub_cpp ?(options = []) ~classname ~stubname ~methname ppf
   println "  // aux vars count = %d" aux_count;
   let local_names = List.init ~f:(sprintf "_x%d") aux_count in
   print_local_declarations ppf local_names;
-  enter_blocking_section ppf;
+  (* enter_blocking_section ppf; *)
   println "  %s *o = (%s*) (Field(_cppobj,0));" classname classname;
   let triplet = vars_triplet local_names in
   let options =
@@ -577,20 +583,22 @@ let gen_stub_cpp ?(options = []) ~classname ~stubname ~methname ppf
       println "  %s %s;" (cpptyp_of_typ arg) cppvar;
       cpp_value_of_ocaml ppf ~options ~cppvar ~ocamlvar triplet (fst arg));
   let () =
-    match res with
-    | Unit, _ ->
-        println "  o->%s(%s);" methname (String.concat ~sep:"," cppvars);
-        leave_blocking_section ppf;
-        println "  CAMLreturn(Val_unit);"
-    | _t, _ai ->
-        let cppvar = "res" in
-        println "  %s %s = o->%s(%s);" (cpptyp_of_typ res) cppvar methname
-          (String.concat ~sep:"," cppvars);
-        let ocamlvar = "_ans" in
-        fprintf ppf "  ";
-        ocaml_value_of_cpp ppf triplet ~ocamlvar ~cppvar (fst res);
-        leave_blocking_section ppf;
-        println "  CAMLreturn(%s);" ocamlvar
+    let ocamlvar =
+      match res with
+      | Unit, _ ->
+          println "  o->%s(%s);" methname (String.concat ~sep:"," cppvars);
+          "Val_unit"
+      | _t, _ai ->
+          let cppvar = "res" in
+          println "  %s %s = o->%s(%s);" (cpptyp_of_typ res) cppvar methname
+            (String.concat ~sep:"," cppvars);
+          let ocamlvar = "_ans" in
+          fprintf ppf "  ";
+          ocaml_value_of_cpp ppf triplet ~ocamlvar ~cppvar (fst res);
+          ocamlvar
+    in
+    (* leave_blocking_section ppf; *)
+    println "  CAMLreturn(%s);" ocamlvar
   in
   println "}";
   ()
@@ -616,6 +624,7 @@ let gen_meth_cpp_generic ?(minfo = TypeRepr.mi_empty) ~classname ~methname wrap
         String.concat ~sep:","
         @@ List.mapi ~f:(fun i t -> sprintf "%s x%d" (cpptyp_of_typ t) i) args)
     (if minfo.mi_const then " const" else "");
+  leave_blocking_section ppf;
   println "  CAMLparam0();";
   let locals_count =
     2
@@ -632,7 +641,7 @@ let gen_meth_cpp_generic ?(minfo = TypeRepr.mi_empty) ~classname ~methname wrap
   (* generate name *)
   let cb_locals = List.mapi ~f:(fun i _ -> make_cb_var i) args in
   print_local_declarations ppf cb_locals;
-  leave_blocking_section ppf;
+
   let triplet, call_closure_str = wrap ~make_cb_var "_meth" locals ~args in
   let () =
     match fst res with
diff --git a/ppx/pp/pp_qt.ml b/ppx/pp/pp_qt.ml
index 4c19ddb..7095150 100644
--- a/ppx/pp/pp_qt.ml
+++ b/ppx/pp/pp_qt.ml
@@ -1,21 +1,3 @@
 open Ppxlib
 
-let () =
-  let open Ppx_qt_rewriter.PpxQtCfg in
-
-  Driver.add_arg "-nocpp"
-    (Unit (fun () -> config.gencpp <- false)) ~doc:" Don't generate C++";
-  Driver.add_arg "-cpp"
-    (Unit (fun () -> config.gencpp <- true))  ~doc:" Do    generate C++ (default)";
-  Driver.add_arg "-destdir"
-    (String (fun s -> config.destdir <- s)) ~doc:"DIR Where to put files";
-  Driver.add_arg "-ext"
-    (String (fun s -> config.ext <- s)) ~doc:"EXT File extension to use (usually .cpp or .c)";
-  Driver.add_arg "-nolocks"
-    (Unit (fun () -> config.insert_locks <- false)) ~doc:" omit caml_leave_blocking_section and others";
-  Driver.add_arg "-tracelocks"
-    (Unit (fun () -> config.trace_locks <- false)) ~doc:" trace some acquired and released locks";
-  ()
-
-let () =
-  Driver.standalone ()
+let () = Driver.standalone ()
diff --git a/ppx/ppx_qt.ml b/ppx/ppx_qt.ml
index 771a938..b46260f 100644
--- a/ppx/ppx_qt.ml
+++ b/ppx/ppx_qt.ml
@@ -7,13 +7,9 @@ open Ppxlib.Ast_builder.Default
 open TypeRepr
 
 let make_coretyp ~loc txt = Ast_helper.Typ.constr ~loc { txt; loc } []
-
 let cppobj_coretyp loc = make_coretyp ~loc (Lident "cppobj")
-
 let unit_coretyp loc = make_coretyp ~loc (Lident "unit")
-
 let int_coretyp loc = make_coretyp ~loc (Lident "int")
-
 let string_coretyp loc = make_coretyp ~loc (Lident "string")
 
 let make_store_func ~loc ~classname : structure_item =
@@ -105,7 +101,8 @@ let wrap_meth ~classname (* ?(options = []) *)
           (* let options =
                if Options.is_itemmodel options then [ OItemModel ] else []
              in *)
-          Gencpp.gen_meth (*~options*) ~classname ~methname
+          Gencpp.gen_meth (*~options*)
+            ~classname ~methname
             (meth_typ :> Arg.non_cppobj Arg.t list)
       in
       [ pcf_method ~loc m ]
@@ -339,6 +336,28 @@ module OfClass = struct
     !heading @ [ ans; creator ]
 end
 
+let () =
+  let open PpxQtCfg in
+  Driver.add_arg "-nocpp"
+    (Unit (fun () -> config.gencpp <- false))
+    ~doc:" Don't generate C++";
+  Driver.add_arg "-cpp"
+    (Unit (fun () -> config.gencpp <- true))
+    ~doc:" Do    generate C++ (default)";
+  Driver.add_arg "-destdir"
+    (String (fun s -> config.destdir <- s))
+    ~doc:"DIR Where to put files";
+  Driver.add_arg "-ext"
+    (String (fun s -> config.ext <- s))
+    ~doc:"EXT File extension to use (usually .cpp or .c)";
+  Driver.add_arg "-nolocks"
+    (Unit (fun () -> config.insert_locks <- false))
+    ~doc:" omit caml_leave_blocking_section and others";
+  Driver.add_arg "-tracelocks"
+    (Unit (fun () -> config.trace_locks <- true))
+    ~doc:" trace some acquired and released locks";
+  ()
+
 let () =
   Ppxlib.Driver.register_transformation
     ~impl:(fun ss ->

From e4eb362f6b7d82984d63026e176eb6e63f79d9a0 Mon Sep 17 00:00:00 2001
From: Kakadu <Kakadu@pm.me>
Date: Sat, 3 Feb 2024 22:30:00 +0300
Subject: [PATCH 8/8] Repair dune_test_515 example

Signed-off-by: Kakadu <Kakadu@pm.me>
---
 lib/stubs/lablqml.h         | 6 ++++++
 lib/stubs/startup_stubs.cpp | 6 ++----
 ppx/generation2.ml          | 2 ++
 3 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/lib/stubs/lablqml.h b/lib/stubs/lablqml.h
index 7ae5e5c..05f1b5d 100644
--- a/lib/stubs/lablqml.h
+++ b/lib/stubs/lablqml.h
@@ -57,3 +57,9 @@ extern bool lablqml_check_locks;
     DEBUG_ENTER_OCAML \
     if (LABLQML_USE_LOCKS) caml_release_runtime_system(); \
   }
+
+#define LABLQML_MAYBE_TAKE_LOCK \
+  bool __lablqml_need_release_ = (Caml_state_opt == NULL) ? true : false; \
+  if (__lablqml_need_release_) caml_acquire_runtime_system();
+
+#define LABLQML_MAYBE_RELEASE_LOCK if (__lablqml_need_release_) caml_release_runtime_system();
\ No newline at end of file
diff --git a/lib/stubs/startup_stubs.cpp b/lib/stubs/startup_stubs.cpp
index 8c92bc5..ba98956 100644
--- a/lib/stubs/startup_stubs.cpp
+++ b/lib/stubs/startup_stubs.cpp
@@ -272,19 +272,17 @@ extern "C" value caml_run_QQmlApplicationEngine(value _argv, value _cb, value _q
   //debug_leave_blocking;
   // LABLQML_ENTER_OCAML;
   // caml_release_runtime_system();
-  qDebug() << __FILE__ << ", line " << __LINE__;
   _cb_res = caml_callback(_cb, Val_unit);
-  qDebug() << __FILE__ << ", line " << __LINE__;
   //debug_enter_blocking;
   // LABLQML_LEAVE_OCAML
   Q_ASSERT(_cb_res == Val_unit);
 
   const QString &path = QString(String_val(_qmlpath));
   LABLQML_ENTER_OCAML;
-  qDebug() << __FILE__ << ", line " << __LINE__;
+  // qDebug() << __FILE__ << ", line " << __LINE__;
   engine.load(QUrl(path));
   LABLQML_LEAVE_OCAML;
-  qDebug() << __FILE__ << ", line " << __LINE__;
+  // qDebug() << __FILE__ << ", line " << __LINE__;
 
   QList<QObject*> xs = engine.rootObjects();
   if (xs.count() == 0) {
diff --git a/ppx/generation2.ml b/ppx/generation2.ml
index 02aca9b..6852f4a 100644
--- a/ppx/generation2.ml
+++ b/ppx/generation2.ml
@@ -36,6 +36,7 @@ module GenProp = struct
               ~getter_name:(Option.value_exn pinfo.p_read)
           in
           println "%s %s::%s() {" cpptyp_name classname getter_name;
+          println "  LABLQML_MAYBE_TAKE_LOCK;";
           println "  CAMLparam0();";
           println "  CAMLlocal1(_ans);";
           prints_
@@ -53,6 +54,7 @@ module GenProp = struct
           Gencpp.cpp_value_of_ocaml ~cppvar ~ocamlvar:"_ans" ppf
             (Gencpp.vars_triplet [ "_ans" ])
             typ;
+          println "  LABLQML_MAYBE_RELEASE_LOCK;";
           println "  CAMLreturnT(%s,ans);" (cpptyp_of_typ (typ, ai_empty));
           println "}\n"
         in