[WIP] experimental, it shows actually we have most type information even in…

jscomp/compiler.mllib

@@ -93,3 +93,4 @@ js_number
 js_helper
 js_cmj_datasets
 js_main
+env_summary

jscomp/env_summary.ml

@@ -0,0 +1,22 @@
+
+
+let print fmt summary =  
+  let rec aux (s : Env.summary) = 
+    match s with 
+    | Env_empty -> ()
+    | Env_value (s, id, des) 
+      -> 
+      Printtyp.value_description id fmt des ; aux s 
+    | Env_type (s, id,des)
+      -> aux s
+      (* -> Printtyp.type_declaration id fmt des; aux s *)
+    | Env_extension (s, id,des)
+      -> (* Printtyp.extension_constructor id fmt des ;  *)
+      aux s 
+    | Env_module(s,id,des) -> aux s
+    | Env_modtype(s,id,des) -> aux s
+    | Env_class(s,id,des) -> aux s 
+    | Env_cltype(s,id,des) -> aux s 
+    | Env_open(s,id) -> aux s 
+    | Env_functor_arg(s,id) -> aux s in
+  aux summary

jscomp/lam_compile_group.ml

@@ -379,7 +379,7 @@ let lambda_as_module
     (lam : Lambda.lambda) = 
   begin 
     Lam_current_unit.set_file filename ;  
-    Lam_current_unit.iset_debug_file "caml_string.ml";
+    Lam_current_unit.set_debug_file "test_env.ml";
     Ext_pervasives.with_file_as_chan 
       (Ext_filename.chop_extension ~loc:__LOC__ filename ^  ".js")
       (fun chan -> Js_dump.dump_deps_program (compile ~filename false env sigs lam) chan)

jscomp/lam_group.ml

@@ -140,7 +140,20 @@ let deep_flatten
 
   and aux  (lam : Lambda.lambda) : Lambda.lambda= 
     match lam with 
-    | Levent (e,_) -> aux  e (* TODO: We stripped event in the beginning*)
+    | Levent (e, ev) -> 
+      let kind =
+        match ev.lev_kind with
+        | Lev_before -> "before"
+        | Lev_after _  -> "after"
+        | Lev_function -> "funct-body" in
+      Ext_log.dwarn __LOC__ "@[<2>(%s %s(%i)%s:%i-%i@ %a@ %a)@]" kind
+              ev.lev_loc.Location.loc_start.Lexing.pos_fname
+              ev.lev_loc.Location.loc_start.Lexing.pos_lnum
+              (if ev.lev_loc.Location.loc_ghost then "<ghost>" else "")
+              (ev.lev_loc.Location.loc_start.Lexing.pos_cnum - ev.lev_loc.Location.loc_start.Lexing.pos_bol)
+              (ev.lev_loc.Location.loc_end.Lexing.pos_cnum - ev.lev_loc.Location.loc_end.Lexing.pos_bol)
+              Env_summary.print ev.lev_env Printlambda.lambda e;      
+      aux  e (* TODO: We stripped event in the beginning*)
     | Llet _ -> 
       let res, groups = flatten [] lam  
       in lambda_of_groups res groups

jscomp/test/.depend

@@ -216,6 +216,8 @@ test_demo.cmo : ../stdlib/list.cmi
 test_demo.cmx : ../stdlib/list.cmx
 test_dup_param.cmo :
 test_dup_param.cmx :
+test_env.cmo :
+test_env.cmx :
 test_eq.cmo :
 test_eq.cmx :
 test_exception.cmo : test_common.cmo
@@ -592,6 +594,8 @@ test_demo.cmo : ../stdlib/list.cmi
 test_demo.cmj : ../stdlib/list.cmj
 test_dup_param.cmo :
 test_dup_param.cmj :
+test_env.cmo :
+test_env.cmj :
 test_eq.cmo :
 test_eq.cmj :
 test_exception.cmo : test_common.cmo

jscomp/test/Makefile

@@ -7,7 +7,7 @@ INCLUDES= -I ../stdlib -I ../runtime -I ../lib
 SOURCE_LIST := $(shell cat test.mllib)
 TESTS := $(addsuffix .cmj, $(SOURCE_LIST) )
 
-COMPFLAGS+= -safe-string -w -40 
+COMPFLAGS+= -safe-string -w -40 -g
 
 $(TESTS): $(CAMLC)
 

jscomp/test/test.mllib

@@ -167,4 +167,5 @@ const_defs
 const_defs_test
 
 genlex_test
-cross_module_inline_test
+cross_module_inline_test
+test_env

jscomp/test/test_env.d.ts

@@ -0,0 +1,4 @@
+export var add: (x : any, y : any) => any ;
+export var add2: (x : any, y : any) => any ;
+export var iter: (f : any, param : any) => any ;
+

jscomp/test/test_env.js

@@ -0,0 +1,32 @@
+// Generated CODE, PLEASE EDIT WITH CARE
+'use strict';
+
+var Caml_curry = require("../runtime/caml_curry");
+
+function add(x, y) {
+  return x + y;
+}
+
+function add2(x, y) {
+  return x - y;
+}
+
+function iter(f, _param) {
+  while(true) {
+    var param = _param;
+    if (param) {
+      Caml_curry.app1(f, param[1]);
+      _param = param[2];
+      continue ;
+
+    }
+    else {
+      return /* () */0;
+    }
+  };
+}
+
+exports.add  = add;
+exports.add2 = add2;
+exports.iter = iter;
+/* No side effect */

jscomp/test/test_env.ml

@@ -0,0 +1,10 @@
+let add x y = x + y
+
+
+let add2 x y = x - y
+
+let rec iter (f : _ -> unit) = function
+  | [] -> ()
+  | a::l -> f a; iter f l
+
+