[Caml-list] [Compiler] Reworking application of plugin hooks for typedtree

[Caml-list] [Compiler] Reworking application of plugin hooks for typedtree

[Kakadu]

[-- Attachment #1: Type: text/plain, Size: 1518 bytes --]

Hello,

I have some difficulties with compiler plugins for rewriting typed tree.

The current implementation of `Typemod.type_implementation` behaves
like this (I think):
* Checks types in the original implementation module
* If corresponding  for the implementation `.cmi` file doesn't exist
it writes generated interface to the disk.
* If a `.cmi` file exists  then performs some checks
* Applies typed tree hooks.

The consequence of this behavior is that the plugin can't add new
values to the typed tree, at least they will not appear in the .cmi
file. But adding new values during rewriting the typed tree is exactly
the thing that  I need these days! So, I thought that following
pipeline will suit better (steps 2 and 3 are swapped).

`Typemod.type_implementation`
* Checks types in the original implementation module.
* Calls plugins to rewrite this typed tree and get a new typed tree
and a signature for it
* Creates a `.cmi` file if there are no any or checks that existing
`.cmi` file agrees with the signature returned by plugins' hooks.

I tried to implement this [1] (the important part of the diff is in
the attachment) but  I get a crash of `ocamlrun` when building the
whole compiler. The patch seems harmless but am I missing something
under the hood? Any delayed check that relies on the fact that
signature of a module will not change?  Am I at least trying to fix in
right place? How should I work on crashes like this?


Happy hacking,
Kakadu

[1] https://github.com/Kakadu/ocaml/tree/pptx-fix

[-- Attachment #2: pptx-reorder-typemod.ml.diff --]
[-- Type: text/plain, Size: 5778 bytes --]

diff --git a/typing/env.ml b/typing/env.ml
index 21cbca7a..9c8d2752 100644
--- a/typing/env.ml
+++ b/typing/env.ml
@@ -2121,6 +2121,7 @@ let open_signature
 (* Read a signature from a file *)
 
 let read_signature modname filename =
+  print_endline "read_signature";
   let ps = read_pers_struct modname filename in
   Lazy.force ps.ps_sig
 
@@ -2195,6 +2196,7 @@ let save_signature_with_imports ~deprecated sg modname filename imports =
     raise exn
 
 let save_signature ~deprecated sg modname filename =
+  Format.printf "save_signature of length %d to %s\n%!" (List.length sg) filename; 
   save_signature_with_imports ~deprecated sg modname filename (imports())
 
 (* Folding on environments *)
diff --git a/typing/typemod.ml b/typing/typemod.ml
index 84fc6490..94b1b36b 100644
--- a/typing/typemod.ml
+++ b/typing/typemod.ml
@@ -51,7 +51,7 @@ exception Error of Location.t * Env.t * error
 exception Error_forward of Location.error
 
 module ImplementationHooks = Misc.MakeHooks(struct
-    type t = Typedtree.structure * Typedtree.module_coercion
+    type t = Typedtree.structure * Types.signature * Typedtree.module_coercion
   end)
 module InterfaceHooks = Misc.MakeHooks(struct
     type t = Typedtree.signature
@@ -1675,8 +1675,8 @@ let type_toplevel_phrase env s =
   Env.reset_required_globals ();
   let (str, sg, env) =
     type_structure ~toplevel:true false None env s Location.none in
-  let (str, _coerce) = ImplementationHooks.apply_hooks
-      { Misc.sourcefile = "//toplevel//" } (str, Tcoerce_none)
+  let (str, sg, _coerce) = ImplementationHooks.apply_hooks
+      { Misc.sourcefile = "//toplevel//" } (str, sg, Tcoerce_none)
   in
   (str, sg, env)
 
@@ -1791,8 +1791,34 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
     Typecore.force_delayed_checks ();
     Printtyp.wrap_printing_env initial_env
       (fun () -> fprintf std_formatter "%a@." Printtyp.signature simple_sg);
-    (str, Tcoerce_none)   (* result is ignored by Compile.implementation *)
+    (str, simple_sg, Tcoerce_none)   (* result is ignored by Compile.implementation *)
   end else begin
+   (* if we comment next let we will stop getting an error during compilation of compiler:
+		mkdir -p stdlib_man
+		../boot/ocamlrun -I ../otherlibs/unix -I ../otherlibs/str ./ocamldoc -man -d stdlib_man -I ../parsing -I ../utils -I ../typing -I ../driver -I ../bytecomp -I ../toplevel -I ../stdlib -I ../compilerlibs -I ../otherlibs/str -I ../otherlibs/dynlink -I ../otherlibs/unix -I ../otherlibs/graph \
+		-t "OCaml library" -man-mini ../stdlib/*.mli ../parsing/*.mli ../otherlibs/unix/unix.mli ../otherlibs/str/str.mli ../otherlibs/bigarray/bigarray.mli
+		Segmentation fault (core dumped)
+
+     or
+
+	make[4]: вход в каталог «/home/kakadu/asp/ocaml-trunk/stdlib»
+	../boot/ocamlrun ../ocamlc -strict-sequence -absname -w +a-4-9-41-42-44-45-48 -g -warn-error A -bin-annot -nostdlib -safe-string -strict-formats `sh ./Compflags camlinternalFormatBasics.cmi` -c camlinternalFormatBasics.mli
+	Segmentation fault (core dumped)
+
+ *)
+
+    (* but this let should be harmless, I don't know why it creates crashes *) 
+    let (str, sg) = 
+      if ImplementationHooks.count_hooks () > 0 
+      then 
+        let (str,sg,_) = ImplementationHooks.apply_hooks { Misc.sourcefile } 
+            (str, simple_sg, Tcoerce_none) 
+        in
+        (str,sg)
+      else (str, simple_sg)
+    in
+
+    let simple_sg = simplify_signature sg in
     let sourceintf =
       Filename.remove_extension sourcefile ^ !Config.interface_suffix in
     if Sys.file_exists sourceintf then begin
@@ -1811,7 +1837,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
          are not reported as being unused. *)
       Cmt_format.save_cmt (outputprefix ^ ".cmt") modulename
         (Cmt_format.Implementation str) (Some sourcefile) initial_env None;
-      (str, coercion)
+      (str, simple_sg, coercion)
     end else begin
       let coercion =
         Includemod.compunit initial_env sourcefile sg
@@ -1833,7 +1859,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
           (Cmt_format.Implementation str)
           (Some sourcefile) initial_env (Some cmi);
       end;
-      (str, coercion)
+      (str, simple_sg, coercion)
     end
     end
   with e ->
@@ -1843,9 +1869,11 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
       (Some sourcefile) initial_env None;
     raise e
 
+(*
 let type_implementation sourcefile outputprefix modulename initial_env ast =
   ImplementationHooks.apply_hooks { Misc.sourcefile }
     (type_implementation sourcefile outputprefix modulename initial_env ast)
+*)
 
 let save_signature modname tsg outputprefix source_file initial_env cmi =
   Cmt_format.save_cmt  (outputprefix ^ ".cmti") modname
diff --git a/typing/typemod.mli b/typing/typemod.mli
index fb767db2..f7ebf0de 100644
--- a/typing/typemod.mli
+++ b/typing/typemod.mli
@@ -28,7 +28,7 @@ val type_toplevel_phrase:
          Typedtree.structure * Types.signature * Env.t
 val type_implementation:
   string -> string -> string -> Env.t -> Parsetree.structure ->
-  Typedtree.structure * Typedtree.module_coercion
+  Typedtree.structure * Types.signature * Typedtree.module_coercion
 val type_interface:
         string -> Env.t -> Parsetree.signature -> Typedtree.signature
 val transl_signature:
@@ -85,6 +85,6 @@ val report_error: Env.t -> formatter -> error -> unit
 
 
 module ImplementationHooks : Misc.HookSig
-  with type t = Typedtree.structure * Typedtree.module_coercion
+  with type t = Typedtree.structure * Types.signature * Typedtree.module_coercion
 module InterfaceHooks : Misc.HookSig
   with type t = Typedtree.signature