binary-annot: added command genannot

git-svn-id: http://caml.inria.fr/svn/ocaml/branches/binary-annot@10860 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

14 files changed, 1102 insertions, 47 deletions

diff --git a/ChangeLog.txt b/ChangeLog.txt
index 5866b1ca54..65cda57a1f 100644
--- a/ChangeLog.txt
+++ b/ChangeLog.txt
@@ -1,3 +1,13 @@
+2010-11-25:
+ * Added command "genannot" to translate a .types file into a .annot file
+    * Some duplicated annotations are removed
+    * Some forgotten annotations have been added
+    * "call(" annotations are not generated
+    * Display warning messages about identifiers without annotations
+       (identifiers bound by "for" and "external")
+ * Removed automatic generation of _ast2src.ml and _typ2src.ml files
+ * Added functor in Typedtree to iter on the typedtree
+
 2010-11-16:
  * Moved code from typedtree.ml to:
    * new file parsing/pprintast.ml for pretty-printing of parsetree
diff --git a/ocaml-binary-annot/.depend b/ocaml-binary-annot/.depend
index 14840a72ef..bfcfa70b73 100644
--- a/ocaml-binary-annot/.depend
+++ b/ocaml-binary-annot/.depend
@@ -113,7 +113,10 @@ typing/types.cmi: typing/primitive.cmi typing/path.cmi typing/ident.cmi \
 typing/typetexp.cmi: typing/types.cmi typing/typedtree.cmi typing/path.cmi \
     parsing/parsetree.cmi parsing/longident.cmi parsing/location.cmi \
     typing/env.cmi
-typing/untypeast.cmi: parsing/parsetree.cmi
+typing/typetexp_ast2src.cmi: typing/types.cmi typing/typedtree.cmi \
+    typing/path.cmi parsing/parsetree.cmi parsing/longident.cmi \
+    parsing/location.cmi typing/env.cmi
+typing/untypeast.cmi: typing/typedtree.cmi parsing/parsetree.cmi
 typing/unused_var.cmi: parsing/parsetree.cmi
 typing/btype.cmo: typing/types.cmi typing/path.cmi utils/misc.cmi \
     typing/btype.cmi
@@ -205,6 +208,12 @@ typing/subst.cmo: typing/types.cmi utils/tbl.cmi typing/path.cmi \
     utils/misc.cmi typing/ident.cmi typing/btype.cmi typing/subst.cmi
 typing/subst.cmx: typing/types.cmx utils/tbl.cmx typing/path.cmx \
     utils/misc.cmx typing/ident.cmx typing/btype.cmx typing/subst.cmi
+typing/ty.cmo: typing/typedtree.cmi typing/path.cmi parsing/parsetree.cmi \
+    utils/misc.cmi parsing/longident.cmi typing/ident.cmi \
+    parsing/asttypes.cmi
+typing/ty.cmx: typing/typedtree.cmx typing/path.cmx parsing/parsetree.cmi \
+    utils/misc.cmx parsing/longident.cmx typing/ident.cmx \
+    parsing/asttypes.cmi
 typing/typeclass.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
     typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \
     typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi typing/predef.cmi \
@@ -255,18 +264,20 @@ typing/typedtree.cmo: typing/types.cmi typing/primitive.cmi typing/path.cmi \
 typing/typedtree.cmx: typing/types.cmx typing/primitive.cmx typing/path.cmx \
     utils/misc.cmx parsing/location.cmx typing/ident.cmx typing/env.cmx \
     parsing/asttypes.cmi typing/typedtree.cmi
-typing/typemod.cmo: utils/warnings.cmi typing/typetexp.cmi typing/types.cmi \
-    typing/typedtree.cmi typing/typedecl.cmi typing/typecore.cmi \
-    typing/typeclass.cmi typing/subst.cmi typing/stypes.cmi \
-    typing/printtyp.cmi typing/path.cmi parsing/parsetree.cmi \
+typing/typemod.cmo: utils/warnings.cmi typing/untypeast.cmi \
+    typing/typetexp.cmi typing/types.cmi typing/typedtree.cmi \
+    typing/typedecl.cmi typing/typecore.cmi typing/typeclass.cmi \
+    typing/subst.cmi typing/stypes.cmi typing/printtyp.cmi \
+    parsing/pprintast.cmi typing/path.cmi parsing/parsetree.cmi \
     typing/mtype.cmi utils/misc.cmi parsing/longident.cmi \
     parsing/location.cmi typing/includemod.cmi typing/ident.cmi \
     typing/env.cmi typing/ctype.cmi utils/config.cmi utils/clflags.cmi \
     typing/btype.cmi parsing/asttypes.cmi typing/annot.cmi typing/typemod.cmi
-typing/typemod.cmx: utils/warnings.cmx typing/typetexp.cmx typing/types.cmx \
-    typing/typedtree.cmx typing/typedecl.cmx typing/typecore.cmx \
-    typing/typeclass.cmx typing/subst.cmx typing/stypes.cmx \
-    typing/printtyp.cmx typing/path.cmx parsing/parsetree.cmi \
+typing/typemod.cmx: utils/warnings.cmx typing/untypeast.cmx \
+    typing/typetexp.cmx typing/types.cmx typing/typedtree.cmx \
+    typing/typedecl.cmx typing/typecore.cmx typing/typeclass.cmx \
+    typing/subst.cmx typing/stypes.cmx typing/printtyp.cmx \
+    parsing/pprintast.cmx typing/path.cmx parsing/parsetree.cmi \
     typing/mtype.cmx utils/misc.cmx parsing/longident.cmx \
     parsing/location.cmx typing/includemod.cmx typing/ident.cmx \
     typing/env.cmx typing/ctype.cmx utils/config.cmx utils/clflags.cmx \
@@ -285,10 +296,12 @@ typing/typetexp.cmx: utils/warnings.cmx typing/types.cmx typing/typedtree.cmx \
     utils/misc.cmx parsing/longident.cmx parsing/location.cmx typing/env.cmx \
     typing/ctype.cmx utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \
     typing/typetexp.cmi
-typing/untypeast.cmo: typing/path.cmi parsing/parsetree.cmi \
-    parsing/longident.cmi typing/ident.cmi typing/untypeast.cmi
-typing/untypeast.cmx: typing/path.cmx parsing/parsetree.cmi \
-    parsing/longident.cmx typing/ident.cmx typing/untypeast.cmi
+typing/untypeast.cmo: typing/typedtree.cmi typing/path.cmi \
+    parsing/parsetree.cmi utils/misc.cmi parsing/longident.cmi \
+    typing/ident.cmi parsing/asttypes.cmi typing/untypeast.cmi
+typing/untypeast.cmx: typing/typedtree.cmx typing/path.cmx \
+    parsing/parsetree.cmi utils/misc.cmx parsing/longident.cmx \
+    typing/ident.cmx parsing/asttypes.cmi typing/untypeast.cmi
 typing/unused_var.cmo: utils/warnings.cmi parsing/parsetree.cmi \
     parsing/longident.cmi parsing/location.cmi parsing/asttypes.cmi \
     typing/unused_var.cmi
@@ -520,8 +533,8 @@ asmcomp/selectgen.cmi: utils/tbl.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
 asmcomp/selection.cmi: asmcomp/mach.cmi asmcomp/cmm.cmi
 asmcomp/spill.cmi: asmcomp/mach.cmi
 asmcomp/split.cmi: asmcomp/mach.cmi
-asmcomp/arch.cmo:
-asmcomp/arch.cmx:
+asmcomp/arch.cmo: utils/misc.cmi utils/config.cmi
+asmcomp/arch.cmx: utils/misc.cmx utils/config.cmx
 asmcomp/asmgen.cmo: bytecomp/translmod.cmi asmcomp/split.cmi \
     asmcomp/spill.cmi asmcomp/selection.cmi asmcomp/scheduling.cmi \
     asmcomp/reload.cmi asmcomp/reg.cmi asmcomp/proc.cmi asmcomp/printmach.cmi \
@@ -625,13 +638,15 @@ asmcomp/debuginfo.cmo: parsing/location.cmi bytecomp/lambda.cmi \
 asmcomp/debuginfo.cmx: parsing/location.cmx bytecomp/lambda.cmx \
     asmcomp/debuginfo.cmi
 asmcomp/emit.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
-    asmcomp/mach.cmi asmcomp/linearize.cmi asmcomp/emitaux.cmi \
-    asmcomp/debuginfo.cmi utils/config.cmi asmcomp/compilenv.cmi \
-    asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/emit.cmi
+    asmcomp/mach.cmi parsing/location.cmi asmcomp/linearize.cmi \
+    asmcomp/emitaux.cmi asmcomp/debuginfo.cmi utils/config.cmi \
+    asmcomp/compilenv.cmi asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo \
+    asmcomp/emit.cmi
 asmcomp/emit.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
-    asmcomp/mach.cmx asmcomp/linearize.cmx asmcomp/emitaux.cmx \
-    asmcomp/debuginfo.cmx utils/config.cmx asmcomp/compilenv.cmx \
-    asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/emit.cmi
+    asmcomp/mach.cmx parsing/location.cmx asmcomp/linearize.cmx \
+    asmcomp/emitaux.cmx asmcomp/debuginfo.cmx utils/config.cmx \
+    asmcomp/compilenv.cmx asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx \
+    asmcomp/emit.cmi
 asmcomp/emitaux.cmo: asmcomp/reg.cmi asmcomp/linearize.cmi \
     asmcomp/debuginfo.cmi asmcomp/cmm.cmi asmcomp/arch.cmo \
     asmcomp/emitaux.cmi
@@ -671,17 +686,17 @@ asmcomp/printmach.cmx: asmcomp/reg.cmx asmcomp/proc.cmx asmcomp/printcmm.cmx \
     asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx asmcomp/arch.cmx \
     asmcomp/printmach.cmi
 asmcomp/proc.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
-    utils/config.cmi asmcomp/cmm.cmi utils/ccomp.cmi asmcomp/arch.cmo \
-    asmcomp/proc.cmi
+    utils/config.cmi asmcomp/cmm.cmi utils/clflags.cmi utils/ccomp.cmi \
+    asmcomp/arch.cmo asmcomp/proc.cmi
 asmcomp/proc.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
-    utils/config.cmx asmcomp/cmm.cmx utils/ccomp.cmx asmcomp/arch.cmx \
-    asmcomp/proc.cmi
+    utils/config.cmx asmcomp/cmm.cmx utils/clflags.cmx utils/ccomp.cmx \
+    asmcomp/arch.cmx asmcomp/proc.cmi
 asmcomp/reg.cmo: asmcomp/cmm.cmi asmcomp/reg.cmi
 asmcomp/reg.cmx: asmcomp/cmm.cmx asmcomp/reg.cmi
 asmcomp/reload.cmo: asmcomp/reloadgen.cmi asmcomp/reg.cmi asmcomp/mach.cmi \
-    asmcomp/cmm.cmi utils/clflags.cmi asmcomp/arch.cmo asmcomp/reload.cmi
+    asmcomp/cmm.cmi asmcomp/arch.cmo asmcomp/reload.cmi
 asmcomp/reload.cmx: asmcomp/reloadgen.cmx asmcomp/reg.cmx asmcomp/mach.cmx \
-    asmcomp/cmm.cmx utils/clflags.cmx asmcomp/arch.cmx asmcomp/reload.cmi
+    asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/reload.cmi
 asmcomp/reloadgen.cmo: asmcomp/reg.cmi utils/misc.cmi asmcomp/mach.cmi \
     asmcomp/reloadgen.cmi
 asmcomp/reloadgen.cmx: asmcomp/reg.cmx utils/misc.cmx asmcomp/mach.cmx \
@@ -702,10 +717,10 @@ asmcomp/selectgen.cmx: utils/tbl.cmx asmcomp/reg.cmx asmcomp/proc.cmx \
     asmcomp/cmm.cmx asmcomp/arch.cmx asmcomp/selectgen.cmi
 asmcomp/selection.cmo: asmcomp/selectgen.cmi asmcomp/reg.cmi asmcomp/proc.cmi \
     utils/misc.cmi asmcomp/mach.cmi asmcomp/debuginfo.cmi asmcomp/cmm.cmi \
-    utils/clflags.cmi asmcomp/arch.cmo asmcomp/selection.cmi
+    asmcomp/arch.cmo asmcomp/selection.cmi
 asmcomp/selection.cmx: asmcomp/selectgen.cmx asmcomp/reg.cmx asmcomp/proc.cmx \
     utils/misc.cmx asmcomp/mach.cmx asmcomp/debuginfo.cmx asmcomp/cmm.cmx \
-    utils/clflags.cmx asmcomp/arch.cmx asmcomp/selection.cmi
+    asmcomp/arch.cmx asmcomp/selection.cmi
 asmcomp/spill.cmo: asmcomp/reg.cmi asmcomp/proc.cmi utils/misc.cmi \
     asmcomp/mach.cmi asmcomp/spill.cmi
 asmcomp/spill.cmx: asmcomp/reg.cmx asmcomp/proc.cmx utils/misc.cmx \
diff --git a/ocaml-binary-annot/Makefile b/ocaml-binary-annot/Makefile
index c201ea1585..097afb7a88 100644
--- a/ocaml-binary-annot/Makefile
+++ b/ocaml-binary-annot/Makefile
@@ -17,7 +17,7 @@
 include config/Makefile
 include stdlib/StdlibModules
 
-CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot -g
+CAMLC=boot/ocamlrun boot/ocamlc -nostdlib -I boot -g -annot
 CAMLOPT=boot/ocamlrun ./ocamlopt -I -nostdlib -I stdlib -I otherlibs/dynlink
 COMPFLAGS=-strict-sequence -warn-error A $(INCLUDES)
 LINKFLAGS=
diff --git a/ocaml-binary-annot/boot/ocamlc b/ocaml-binary-annot/boot/ocamlc
index efbf58c9d0..d228433dbe 100755
--- a/ocaml-binary-annot/boot/ocamlc
+++ b/ocaml-binary-annot/boot/ocamlc
diff --git a/ocaml-binary-annot/boot/ocamldep b/ocaml-binary-annot/boot/ocamldep
index 0bd3c89977..d5af62e893 100755
--- a/ocaml-binary-annot/boot/ocamldep
+++ b/ocaml-binary-annot/boot/ocamldep
diff --git a/ocaml-binary-annot/tools/Makefile.shared b/ocaml-binary-annot/tools/Makefile.shared
index 12bf76f0d0..5772b6ac75 100644
--- a/ocaml-binary-annot/tools/Makefile.shared
+++ b/ocaml-binary-annot/tools/Makefile.shared
@@ -23,12 +23,12 @@ INCLUDES=-I ../utils -I ../parsing -I ../typing -I ../bytecomp -I ../asmcomp \
 COMPFLAGS= -warn-error A $(INCLUDES)
 LINKFLAGS=$(INCLUDES)
 
-all: ocamldep ocamlprof ocamlcp ocamlmktop ocamlmklib dumpobj objinfo
-# scrapelabels addlabels
+all: ocamldep ocamlprof ocamlcp ocamlmktop ocamlmklib dumpobj objinfo genannot
+# scrapelabels addlabels 
 
 .PHONY: all
 
-opt.opt: ocamldep.opt
+opt.opt: ocamldep.opt genannot.opt
 .PHONY: opt.opt
 
 # The dependency generator
@@ -226,6 +226,46 @@ clean::
 
 beforedepend:: opnames.ml
 
+# Convert .types files to .annot
+
+
+GENANNOT_OBJ=\
+  ../utils/misc.cmo \
+  ../utils/tbl.cmo \
+  ../utils/consistbl.cmo \
+  ../utils/config.cmo \
+  ../utils/clflags.cmo \
+  ../utils/warnings.cmo \
+  ../parsing/linenum.cmo \
+  ../parsing/location.cmo \
+  ../typing/ident.cmo \
+  ../typing/path.cmo \
+  ../typing/types.cmo \
+  ../typing/btype.cmo \
+  ../typing/subst.cmo \
+  ../typing/predef.cmo \
+  ../typing/datarepr.cmo \
+  ../typing/env.cmo \
+  ../typing/typedtree.cmo \
+  ../typing/ctype.cmo \
+  ../typing/oprint.cmo \
+  ../typing/primitive.cmo \
+  ../typing/printtyp.cmo \
+  ../typing/stypes.cmo \
+  genannot.cmo
+
+genannot: $(GENANNOT_OBJ)
+	$(CAMLC) -o genannot $(GENANNOT_OBJ)
+
+genannot.opt: $(GENANNOT_OBJ:.cmo=.cmx)
+	$(CAMLOPT) $(LINKFLAGS) -o genannot.opt $(GENANNOT_OBJ:.cmo=.cmx)
+
+install::
+	cp genannot $(BINDIR)/genannot$(EXE)
+
+clean::
+	rm -f genannot
+
 # Display info on compiled files
 
 objinfo_helper$(EXE): objinfo_helper.c ../config/s.h
diff --git a/ocaml-binary-annot/tools/genannot.ml b/ocaml-binary-annot/tools/genannot.ml
new file mode 100644
index 0000000000..cbb431daa4
--- /dev/null
+++ b/ocaml-binary-annot/tools/genannot.ml
@@ -0,0 +1,295 @@
+(***********************************************************************)
+(*                                                                     *)
+(*                           Objective Caml                            *)
+(*                                                                     *)
+(*      Fabrice Le Fessant, projet OCamlPro, INRIA Rocquencourt        *)
+(*                                                                     *)
+(*  Copyright 2010 Institut National de Recherche en Informatique et   *)
+(*  en Automatique.  All rights reserved.  This file is distributed    *)
+(*  under the terms of the Q Public License version 1.0.               *)
+(*                                                                     *)
+(***********************************************************************)
+(*
+Generate .annot file from a .types files.
+*)
+
+open Typedtree
+
+let pattern_scopes = ref []
+
+let push_None () = 
+  pattern_scopes := None :: !pattern_scopes
+let push_Some annot =
+  pattern_scopes := (Some annot) :: !pattern_scopes
+let pop_scope () =
+  match !pattern_scopes with
+    [] -> assert false
+  | _ :: scopes -> pattern_scopes := scopes
+  
+module ForIterator = struct
+    open Asttypes
+    
+    include DefaultIteratorArgument
+    
+    let structure_begin_scopes = ref []
+    let structure_end_scopes = ref []
+
+    let rec find_last list =
+      match list with
+        [] -> assert false
+      | [x] -> x
+      | _ :: tail -> find_last tail
+      
+    let enter_structure str = 
+      match str.str_items with
+        [] -> ()
+      | _ ->
+          let loc = 
+            match !structure_end_scopes with
+              [] -> Location.none
+            | _ -> 
+                let s = find_last str.str_items in
+                s.str_loc
+          in
+          structure_end_scopes := loc :: !structure_end_scopes;
+          
+          let rec iter list =
+            match list with
+              [] -> assert false
+            | [ { str_desc = Tstr_value (Nonrecursive, _); str_loc = loc } ] ->
+                structure_begin_scopes := loc.Location.loc_end
+                  :: !structure_begin_scopes
+            | [ _ ] -> ()
+            | item :: tail ->
+                iter tail;
+                match item, tail with
+                  { str_desc = Tstr_value (Nonrecursive,_) },
+                  { str_loc = loc } :: _ ->
+                    structure_begin_scopes := loc.Location.loc_start
+                      :: !structure_begin_scopes
+                | _ -> ()
+          in
+          iter str.str_items
+      
+    let leave_structure str = 
+      match str.str_items with
+        [] -> ()
+      | _ ->
+          match !structure_end_scopes with
+            [] -> assert false
+          | _ :: scopes -> structure_end_scopes := scopes
+              
+    let enter_class_expr node =
+      Stypes.record (Stypes.Ti_class node)
+    let enter_module_expr node =
+      Stypes.record (Stypes.Ti_mod node)
+          
+    let add_variable pat id =
+      match !pattern_scopes with
+      | [] -> assert false
+      | None :: _ -> ()
+      | (Some s) :: _ -> 
+          Stypes.record (Stypes.An_ident (pat.pat_loc, Ident.name id, s))
+    
+    let enter_pattern pat =
+      match pat.pat_desc with
+      | Tpat_var id
+      | Tpat_alias (_, TPat_alias id)
+        
+        -> add_variable pat id
+      
+      | Tpat_alias (_, (TPat_constraint _ | TPat_type _) )        
+      | Tpat_any _ -> ()
+      | Tpat_constant _
+      | Tpat_tuple _
+      | Tpat_construct _
+      | Tpat_lazy _
+      | Tpat_or _
+      | Tpat_array _
+      | Tpat_record _
+      | Tpat_variant _
+        -> ()
+    
+    let leave_pattern pat =
+      Stypes.record (Stypes.Ti_pat pat)
+    
+    let rec name_of_path = function
+      | Path.Pident id -> Ident.name id
+      | Path.Pdot(p, s, pos) ->
+          if Oprint.parenthesized_ident s then
+            name_of_path p ^ ".( " ^ s ^ " )"
+          else
+            name_of_path p ^ "." ^ s
+      | Path.Papply(p1, p2) -> name_of_path p1 ^ "(" ^ name_of_path p2 ^ ")" 
+    
+    let enter_expression exp =
+      match exp.exp_desc with
+        Texp_ident (path, _) ->
+          let full_name = name_of_path path in
+          begin
+            try
+              let annot = Env.find_annot path exp.exp_env in
+              Stypes.record
+                (Stypes.An_ident (exp.exp_loc, full_name , annot))
+            with Not_found ->                 
+                Printf.fprintf stderr "Path %s not found in env\n%!"
+                  full_name;
+          end
+      
+      | Texp_let (rec_flag, _, body) ->
+          begin
+            match rec_flag with
+            | Recursive -> push_Some (Annot.Idef exp.exp_loc)
+            | Nonrecursive -> push_Some (Annot.Idef body.exp_loc)
+            | Default -> push_None ()
+          end          
+      | Texp_function _ -> push_None ()
+      | Texp_match _ -> push_None ()
+      | Texp_try _ -> push_None ()                            
+      | _ -> ()
+    
+    let leave_expression exp =
+      if not exp.exp_loc.Location.loc_ghost then
+        Stypes.record (Stypes.Ti_expr exp);
+      match exp.exp_desc with
+      | Texp_let _          
+      | Texp_function _
+      | Texp_match _ 
+      | Texp_try _ 
+        -> pop_scope ()
+      | _ -> ()
+    
+    let enter_binding pat exp =
+      let scope = 
+        match !pattern_scopes with
+        | [] -> assert false
+        | None :: _ -> Some (Annot.Idef exp.exp_loc)
+        | scope :: _ -> scope    
+      in
+      pattern_scopes := scope :: !pattern_scopes
+    
+    let leave_binding _ _ = 
+      pop_scope ()
+    
+    let enter_class_expr exp =
+      match exp.cl_desc with
+      | Tcl_fun _ -> push_None ()
+      | Tcl_let _ -> push_None ()
+      | _ -> ()
+    
+    let leave_class_expr exp =
+      match exp.cl_desc with
+      | Tcl_fun _
+      | Tcl_let _ -> pop_scope ()
+      | _ -> ()
+    
+    let enter_class_structure _ =
+      push_None ()
+    
+    let leave_class_structure _ = 
+      pop_scope ()
+    
+    let enter_class_field cf =
+      match cf.cf_desc with
+        Tcf_let _ -> push_None ()
+      | _ -> ()
+    
+    let leave_class_field cf =
+      match cf.cf_desc with
+        Tcf_let _ -> pop_scope ()
+      | _ -> ()
+
+          
+    let enter_structure_item s =
+      Stypes.record_phrase s.str_loc;
+      match s.str_desc with
+        Tstr_value (rec_flag, _) -> 
+          begin
+            let loc = s.str_loc in
+            let scope = match !structure_end_scopes with
+                [] -> assert false
+              | scope :: _ -> scope
+            in
+            match rec_flag with
+            | Recursive -> push_Some
+                  (Annot.Idef { scope with
+                    Location.loc_start = loc.Location.loc_start})
+            | Nonrecursive ->
+(* TODO: do it lazily, when we start the next element ! *)
+(*
+                 let start = match srem with
+                  | [] -> loc.Location.loc_end
+                  | {pstr_loc = loc2} :: _ -> loc2.Location.loc_start
+in  *)
+                let start = 
+                  match !structure_begin_scopes with
+                    [] -> assert false
+                  | loc :: tail ->
+                      structure_begin_scopes := tail;
+                      loc
+                in
+                push_Some (Annot.Idef {scope with Location.loc_start = start})
+            | Default -> push_None ()
+          end
+      | _ -> ()
+
+    let leave_structure_item s =
+      match s.str_desc with
+        Tstr_value _ -> pop_scope ()
+      | _ -> ()
+          
+      
+  end
+
+  
+  
+module Iterator = MakeIterator(ForIterator)
+
+  
+let init_path () =
+  let dirs =
+    if !Clflags.use_threads then "+threads" :: !Clflags.include_dirs
+    else if !Clflags.use_vmthreads then "+vmthreads" :: !Clflags.include_dirs
+    else !Clflags.include_dirs in
+  let exp_dirs =
+    List.map (Misc.expand_directory Config.standard_library) dirs in
+  Config.load_path := "" :: List.rev_append exp_dirs (Clflags.std_include_dir ());
+  Env.reset_cache ()
+
+open Clflags
+
+(*
+TODO: external functions have no annotations ! fix typecore.ml !
+TODO: Texp_for bound idents have no annoations ! fix typecore.ml !
+  *)
+  
+let _ =
+  Clflags.annotations := true;
+
+  Arg.parse [
+    "-I", Arg.String (fun filename -> 
+        include_dirs := filename :: !include_dirs),  
+    "<dir>  Add <dir> to the list of include directories";
+
+    "-thread", Arg.Unit (fun _ -> use_threads := true),
+    " Generate code that supports the system threads library";
+    
+      "-vmthread", Arg.Unit (fun _ -> use_vmthreads := true),
+    " Generate code that supports the threads library with VM-level\n\
+    \     scheduling"
+
+    
+  ] (fun filename ->
+        init_path();  
+
+      let ic = open_in filename in
+      let (types : saved_type array) = input_value ic in
+      close_in ic;      
+      match types with
+        [| Saved_implementation typedtree |] ->
+          Iterator.iter_structure typedtree;
+          Stypes.dump (filename ^ ".annot")
+      | _ ->
+          Printf.fprintf stderr "File was generated with an error\n%!";
+          exit 2
+  ) " <filename>.types : generate corresponding .annot file"
\ No newline at end of file
diff --git a/ocaml-binary-annot/typing/env.ml b/ocaml-binary-annot/typing/env.ml
index c8d1541b09..4acd66c70f 100644
--- a/ocaml-binary-annot/typing/env.ml
+++ b/ocaml-binary-annot/typing/env.ml
@@ -337,6 +337,8 @@ and find_class =
   find (fun env -> env.classes) (fun sc -> sc.comp_classes)
 and find_cltype =
   find (fun env -> env.cltypes) (fun sc -> sc.comp_cltypes)
+and find_annot =
+  find (fun env -> env.annotations) (fun sc -> sc.comp_annotations)
 
 (* Find the manifest type associated to a type when appropriate:
    - the type should be public or should have a private row,
diff --git a/ocaml-binary-annot/typing/env.mli b/ocaml-binary-annot/typing/env.mli
index 28997aa1fe..180984d536 100644
--- a/ocaml-binary-annot/typing/env.mli
+++ b/ocaml-binary-annot/typing/env.mli
@@ -30,6 +30,7 @@ val find_module: Path.t -> t -> module_type
 val find_modtype: Path.t -> t -> modtype_declaration
 val find_class: Path.t -> t -> class_declaration
 val find_cltype: Path.t -> t -> class_type_declaration
+val find_annot: Path.t -> t -> Annot.ident
 
 val find_type_expansion: Path.t -> t -> type_expr list * type_expr
 val find_type_expansion_opt: Path.t -> t -> type_expr list * type_expr
diff --git a/ocaml-binary-annot/typing/typeclass.ml b/ocaml-binary-annot/typing/typeclass.ml
index a5aa7a151c..d3b7f8c2b2 100644
--- a/ocaml-binary-annot/typing/typeclass.ml
+++ b/ocaml-binary-annot/typing/typeclass.ml
@@ -188,7 +188,7 @@ let rec limited_generalize rv =
 (* Record a class type *)
 let rc node =
   Typedtree.add_saved_type (Saved_class_expr node);
-  Stypes.record (Stypes.Ti_class node);
+  Stypes.record (Stypes.Ti_class node); (* moved to genannot *)
   node
 
 
diff --git a/ocaml-binary-annot/typing/typecore.ml b/ocaml-binary-annot/typing/typecore.ml
index a46ff94444..567e508b31 100644
--- a/ocaml-binary-annot/typing/typecore.ml
+++ b/ocaml-binary-annot/typing/typecore.ml
@@ -92,12 +92,12 @@ let type_object =
 *)
 let re node =
   Typedtree.add_saved_type (Saved_expression node);
-  Stypes.record (Stypes.Ti_expr node);
+  Stypes.record (Stypes.Ti_expr node); (* moved to genannot *)
   node
 ;;
 let rp node =
   Typedtree.add_saved_type (Saved_pattern node);
-  Stypes.record (Stypes.Ti_pat node);
+  Stypes.record (Stypes.Ti_pat node); (* moved to genannot *)
   node
 ;;
 
@@ -229,7 +229,7 @@ let enter_variable ?(is_module=false) loc name ty =
   end else begin
     match !pattern_scope with
     | None -> ()
-    | Some s -> Stypes.record (Stypes.An_ident (loc, name, s));
+    | Some s -> Stypes.record (Stypes.An_ident (loc, name, s)); (* moved to genannot *)
   end;
   id
 
@@ -1104,8 +1104,8 @@ let rec type_exp env sexp =
                     else
                       name_of_path p ^ "." ^ s
                 | Path.Papply(p1, p2) -> name_of_path p1 ^ "(" ^ name_of_path p2 ^ ")" in
-              Stypes.record
-                (Stypes.An_ident (loc, name_of_path path, annot))
+              Stypes.record  (* moved to genannot *)
+                (Stypes.An_ident (loc, name_of_path path, annot)) (* moved to genannot *)
             with _ -> ()
           end;
         let (path, desc) = Typetexp.find_value env loc lid in
@@ -1456,7 +1456,9 @@ let rec type_exp env sexp =
         exp_loc = arg.exp_loc;
         exp_type = ty';
           exp_env = env } in
-      re { arg with exp_desc = Texp_constraint (arg, cty, cty') }
+      re { arg with 
+        exp_desc = Texp_constraint (arg, cty, cty'); 
+        exp_loc = loc; }
   | Pexp_when(scond, sbody) ->
       let cond = type_expect env scond (instance Predef.type_bool) in
       let body = type_exp env sbody in
diff --git a/ocaml-binary-annot/typing/typedtree.ml b/ocaml-binary-annot/typing/typedtree.ml
index 86ddfa8232..7973901b29 100644
--- a/ocaml-binary-annot/typing/typedtree.ml
+++ b/ocaml-binary-annot/typing/typedtree.ml
@@ -450,7 +450,619 @@ let rec alpha_pat env p = match p.pat_desc with
 
 
 
-
-
-
-
+  
+module type IteratorArgument = sig
+    
+    val enter_structure : structure -> unit
+    val enter_value_description : value_description -> unit
+    val enter_type_declaration : type_declaration -> unit
+    val enter_exception_declaration :
+      exception_declaration -> unit
+    val enter_pattern : pattern -> unit
+    val enter_expression : expression -> unit
+    val enter_package_type : package_type -> unit
+    val enter_signature : signature -> unit
+    val enter_signature_item : signature_item -> unit
+    val enter_modtype_declaration : modtype_declaration -> unit
+    val enter_module_type : module_type -> unit
+    val enter_module_expr : module_expr -> unit
+    val enter_with_constraint : with_constraint -> unit
+    val enter_class_expr : class_expr -> unit
+    val enter_class_signature : class_signature -> unit
+    val enter_class_description : class_description -> unit
+    val enter_class_type_declaration :
+      class_type_declaration -> unit
+    val enter_class_infos : 'a class_infos -> unit
+    val enter_class_type : class_type -> unit
+    val enter_class_type_field : class_type_field -> unit
+    val enter_core_type : core_type -> unit
+    val enter_core_field_type : core_field_type -> unit
+    val enter_class_structure : class_structure -> unit
+    val enter_class_field : class_field -> unit
+    val enter_structure_item : structure_item -> unit
+
+      
+    val leave_structure : structure -> unit
+    val leave_value_description : value_description -> unit
+    val leave_type_declaration : type_declaration -> unit
+    val leave_exception_declaration :
+      exception_declaration -> unit
+    val leave_pattern : pattern -> unit
+    val leave_expression : expression -> unit
+    val leave_package_type : package_type -> unit
+    val leave_signature : signature -> unit
+    val leave_signature_item : signature_item -> unit
+    val leave_modtype_declaration : modtype_declaration -> unit
+    val leave_module_type : module_type -> unit
+    val leave_module_expr : module_expr -> unit
+    val leave_with_constraint : with_constraint -> unit
+    val leave_class_expr : class_expr -> unit
+    val leave_class_signature : class_signature -> unit
+    val leave_class_description : class_description -> unit
+    val leave_class_type_declaration :
+      class_type_declaration -> unit
+    val leave_class_infos : 'a class_infos -> unit
+    val leave_class_type : class_type -> unit
+    val leave_class_type_field : class_type_field -> unit
+    val leave_core_type : core_type -> unit
+    val leave_core_field_type : core_field_type -> unit
+    val leave_class_structure : class_structure -> unit
+    val leave_class_field : class_field -> unit
+    val leave_structure_item : structure_item -> unit
+
+    val enter_bindings : rec_flag -> unit
+    val enter_binding : pattern -> expression -> unit
+    val leave_binding : pattern -> expression -> unit
+    val leave_bindings : rec_flag -> unit
+      
+      end
+      
+module MakeIterator(Iter : IteratorArgument) : sig
+    
+    val iter_structure : structure -> unit
+    val iter_signature : signature -> unit
+  
+  end = struct
+    
+    let may_iter f v =
+      match v with
+        None -> ()
+      | Some x -> f x
+    
+    
+    open Misc
+    open Asttypes
+    
+    let rec iter_structure str =
+      Iter.enter_structure str;
+      List.iter iter_structure_item str.str_items;
+      Iter.leave_structure str
+    
+
+    and iter_binding (pat, exp) =
+      Iter.enter_binding pat exp;
+      iter_pattern pat;
+      iter_expression exp;
+      Iter.leave_binding pat exp
+
+    and iter_bindings rec_flag list =
+      Iter.enter_bindings rec_flag;
+      List.iter iter_binding list;
+      Iter.leave_bindings rec_flag
+      
+    and iter_structure_item item =
+      Iter.enter_structure_item item;
+      begin
+        match item.str_desc with
+          Tstr_eval exp -> iter_expression exp
+        | Tstr_value (rec_flag, list) ->
+            iter_bindings rec_flag list
+        | Tstr_primitive (id, v) -> iter_value_description v
+        | Tstr_type list ->
+            List.iter (fun (id, decl) -> iter_type_declaration decl) list
+        | Tstr_exception (id, decl) -> iter_exception_declaration decl
+        | Tstr_exn_rebind (id, p) -> ()
+        | Tstr_module (id, mexpr) ->
+            iter_module_expr mexpr
+        | Tstr_recmodule list ->
+            List.iter (fun (id, mtype, mexpr) ->
+                iter_module_type mtype;
+                iter_module_expr mexpr) list
+        | Tstr_modtype (id, mtype) ->
+            iter_module_type mtype
+        | Tstr_open path -> ()
+        | Tstr_class list ->
+            List.iter (fun (ci, _, _) ->
+                Iter.enter_class_infos ci;
+                iter_class_expr ci.ci_expr;
+            ) list
+        | Tstr_class_type list ->
+            List.iter (fun (id, ct) ->
+                Iter.enter_class_infos ct;
+                iter_class_type ct.ci_expr;
+            ) list
+        | Tstr_include (mexpr, _) ->
+            iter_module_expr mexpr
+      end;
+      Iter.leave_structure_item item
+    
+    and iter_value_description v =
+      Iter.enter_value_description v;
+      iter_core_type v.val_desc;
+      Iter.leave_value_description v
+    
+    and iter_type_declaration decl =
+      Iter.enter_type_declaration decl;
+      List.iter (fun (ct1, ct2, loc) ->
+          iter_core_type ct1;
+          iter_core_type ct2
+      ) decl.typ_cstrs;
+      begin match decl.typ_kind with
+          Ttype_abstract -> ()
+        | Ttype_variant list ->
+            List.iter (fun (s, cts, loc) ->
+                List.iter iter_core_type cts
+            ) list
+        | Ttype_record list ->
+            List.iter (fun (s, mut, ct, loc) ->
+                iter_core_type ct
+            ) list
+      end;
+      begin match decl.typ_manifest with
+          None -> ()
+        | Some ct -> iter_core_type ct
+      end;
+      Iter.leave_type_declaration decl
+    
+    and iter_exception_declaration decl =
+      Iter.enter_exception_declaration decl;
+      List.iter iter_core_type decl;
+      Iter.leave_exception_declaration decl;
+    
+    and iter_pattern pat =
+      Iter.enter_pattern pat;
+      begin
+        match pat.pat_desc with
+          Tpat_any -> ()
+        | Tpat_var id -> ()
+        | Tpat_alias (pat1, kind) ->
+            iter_pattern pat1;
+            begin
+              match kind with
+                TPat_alias _ -> ()
+              | TPat_type ct -> ()
+              | TPat_constraint ct -> iter_core_type ct
+            end
+        | Tpat_constant cst -> ()
+        | Tpat_tuple list ->
+            List.iter iter_pattern list
+        | Tpat_construct (path, _, args) ->
+            List.iter iter_pattern args
+        | Tpat_variant (label, pato, _) ->
+            begin match pato with
+                None -> ()
+              | Some pat -> iter_pattern pat
+            end
+        | Tpat_record (list, closed) ->
+            List.iter (fun (path, _, pat) -> iter_pattern pat) list
+        | Tpat_array list -> List.iter iter_pattern list
+        | Tpat_or (p1, p2, _) -> iter_pattern p1; iter_pattern p2
+        | Tpat_lazy p -> iter_pattern p
+      end;
+      Iter.leave_pattern pat
+    
+    and iter_expression exp =
+      Iter.enter_expression exp;
+      begin
+        match exp.exp_desc with
+          Texp_ident (path, _) -> ()
+        | Texp_constant cst -> ()
+        | Texp_let (rec_flag, list, exp) ->
+            iter_bindings rec_flag list;
+            iter_expression exp
+        | Texp_function (label, cases, _) ->
+            iter_bindings Nonrecursive cases
+        | Texp_apply (exp, list) ->
+            iter_expression exp;
+            List.iter (fun (label, expo, _) ->
+                match expo with
+                  None -> ()
+                | Some exp -> iter_expression exp
+            ) list
+        | Texp_match (exp, list, _) ->
+            iter_expression exp;
+            iter_bindings Nonrecursive list
+        | Texp_try (exp, list) ->
+            iter_expression exp;
+            iter_bindings Nonrecursive list
+        | Texp_tuple list ->
+            List.iter iter_expression list
+        | Texp_construct (path, _, args) ->
+            List.iter iter_expression args
+        | Texp_variant (label, expo) ->
+            begin match expo with
+                None -> ()
+              | Some exp -> iter_expression exp
+            end
+        | Texp_record (list, expo) ->
+            List.iter (fun (path, _, exp) ->
+                iter_expression exp
+            ) list;
+            begin match expo with
+                None -> ()
+              | Some exp -> iter_expression exp
+            end
+        | Texp_field (exp, path, label) ->
+            iter_expression exp
+        | Texp_setfield (exp1, path , label, exp2) ->
+            iter_expression exp1;
+            iter_expression exp2
+        | Texp_array list ->
+            List.iter iter_expression list
+        | Texp_ifthenelse (exp1, exp2, expo) ->
+            iter_expression exp1;
+            iter_expression exp2;
+            begin match expo with
+                None -> ()
+              | Some exp -> iter_expression exp
+            end
+        | Texp_sequence (exp1, exp2) ->
+            iter_expression exp1; 
+            iter_expression exp2
+        | Texp_while (exp1, exp2) ->
+            iter_expression exp1; 
+            iter_expression exp2
+        | Texp_for (id, exp1, exp2, dir, exp3) ->
+            iter_expression exp1;
+            iter_expression exp2;
+            iter_expression exp3
+        | Texp_when (exp1, exp2) ->
+            iter_expression exp1; 
+            iter_expression exp2
+        | Texp_send (exp, meth, _) ->
+            iter_expression exp
+        | Texp_new (path, _) -> ()
+        | Texp_instvar (_, path) -> ()
+        | Texp_setinstvar (_, path, exp) ->
+            iter_expression exp
+        | Texp_override (_, list) ->
+            List.iter (fun (path, exp) ->
+                iter_expression exp
+            ) list
+        | Texp_letmodule (id, mexpr, exp) ->
+            iter_module_expr mexpr;
+            iter_expression exp
+        | Texp_assert exp -> iter_expression exp
+        | Texp_assertfalse -> ()
+        | Texp_lazy exp -> iter_expression exp
+        | Texp_object (cl, _) ->
+            iter_class_structure cl
+        | Texp_pack (mexpr) ->
+            iter_module_expr mexpr
+        | Texp_poly (exp, None) -> iter_expression exp
+        | Texp_poly (exp, Some ct) ->
+            iter_expression exp; iter_core_type ct
+        | Texp_open (path, exp) ->
+            iter_expression exp
+        | Texp_newtype (s, exp) ->
+            iter_expression exp
+        | Texp_constraint (exp, cto1, cto2) ->
+            iter_expression exp;
+            may_iter iter_core_type cto1;
+            may_iter iter_core_type cto2
+      end;
+      Iter.leave_expression exp;
+    
+    and iter_package_type pack =
+      Iter.enter_package_type pack;      
+      List.iter (fun (s, ct) -> iter_core_type ct) pack.pack_fields;
+      Iter.leave_package_type pack;
+    
+    and iter_signature sg =
+      Iter.enter_signature sg;
+      List.iter iter_signature_item sg.sig_items;
+      Iter.leave_signature sg;
+    
+    and iter_signature_item item =
+      Iter.enter_signature_item item;
+      begin
+        match item.sig_desc with
+          Tsig_value (id, v) ->
+            iter_value_description v
+        | Tsig_type list ->
+            List.iter (fun (id, decl) ->
+                iter_type_declaration decl
+            ) list
+        | Tsig_exception (id, decl) ->
+            iter_exception_declaration decl
+        | Tsig_module (id, mtype) ->
+            iter_module_type mtype
+        | Tsig_recmodule list ->
+            List.iter (fun (id, mtype) -> iter_module_type mtype) list
+        | Tsig_modtype (id, mdecl) ->
+            iter_modtype_declaration mdecl
+        | Tsig_open path -> ()
+        | Tsig_include mty -> iter_module_type mty
+        | Tsig_class list ->
+            List.iter iter_class_description list
+        | Tsig_class_type list ->
+            List.iter iter_class_type_declaration list
+      end;
+      Iter.leave_signature_item item;
+    
+    and iter_modtype_declaration mdecl =
+      Iter.enter_modtype_declaration mdecl;
+      begin
+        match mdecl with
+          Tmodtype_abstract -> ()
+        | Tmodtype_manifest mtype -> iter_module_type mtype
+      end;
+      Iter.leave_modtype_declaration mdecl;
+    
+    
+    and iter_class_description cd =
+      Iter.enter_class_description cd;
+      iter_class_type cd.ci_expr;
+      Iter.leave_class_description cd;
+    
+    and iter_class_type_declaration cd =
+      Iter.enter_class_type_declaration cd;
+      iter_class_type cd.ci_expr;
+        Iter.leave_class_type_declaration cd;
+    
+    and iter_module_type mty =
+      Iter.enter_module_type mty;
+      begin
+        match mty.mty_desc with
+          Tmty_ident path -> ()
+        | Tmty_signature sg -> iter_signature sg
+        | Tmty_functor (id, mtype1, mtype2) ->
+            iter_module_type mtype1; iter_module_type mtype2
+        | Tmty_with (mtype, list) ->
+            iter_module_type mtype;
+            List.iter (fun (path, withc) ->
+                iter_with_constraint withc
+            ) list
+        | Tmty_typeof mexpr ->
+            iter_module_expr mexpr
+      end;
+      Iter.leave_module_type mty;
+    
+    and iter_with_constraint cstr =
+      Iter.enter_with_constraint cstr;
+      begin
+        match cstr with
+          Twith_type decl -> iter_type_declaration decl
+        | Twith_module path -> ()
+        | Twith_typesubst decl -> iter_type_declaration decl
+        | Twith_modsubst path -> ()
+      end;
+      Iter.leave_with_constraint cstr;
+    
+    and iter_module_expr mexpr =
+      Iter.enter_module_expr mexpr;
+      begin
+        match mexpr.mod_desc with
+          Tmod_ident p -> ()
+        | Tmod_structure st -> iter_structure st
+        | Tmod_functor (id, mtype, mexpr) ->
+            iter_module_type mtype;
+            iter_module_expr mexpr
+        | Tmod_apply (mexp1, mexp2, _) ->
+            iter_module_expr mexp1;
+            iter_module_expr mexp2
+        | Tmod_constraint (mexpr, _, Tmodtype_implicit, _ ) ->
+            iter_module_expr mexpr
+        | Tmod_constraint (mexpr, _, Tmodtype_explicit mtype, _) ->
+            iter_module_expr mexpr;
+            iter_module_type mtype
+        | Tmod_unpack (exp, mty) ->
+            iter_expression exp
+(*          iter_module_type mty *)
+      end;
+      Iter.leave_module_expr mexpr;
+    
+    and iter_class_expr cexpr =
+      Iter.enter_class_expr cexpr;
+      begin
+        match cexpr.cl_desc with
+        | Tcl_constraint (cl, None, _, _, _ ) ->
+            iter_class_expr cl;
+        | Tcl_structure clstr -> iter_class_structure clstr
+        | Tcl_fun (label, pat, pv, cl, partial) ->
+            iter_pattern pat; 
+            iter_class_expr cl
+        
+        | Tcl_apply (cl, args) ->
+            iter_class_expr cl;
+            List.iter (fun (label, expo, _) ->
+                match expo with
+                  None -> ()
+                | Some exp -> iter_expression exp
+            ) args
+        
+        | Tcl_let (rec_flat, bindings, ivars, cl) ->
+            iter_bindings Nonrecursive bindings;
+            iter_class_expr cl
+        
+        | Tcl_constraint (cl, Some clty, vals, meths, concrs) ->
+            iter_class_expr cl; 
+            iter_class_type clty
+        
+        | Tcl_ident (_, tyl) -> 
+            List.iter iter_core_type tyl
+      end;
+      Iter.leave_class_expr cexpr;
+    
+    and iter_class_type ct =
+      Iter.enter_class_type ct;
+      begin
+        match ct.cltyp_desc with
+          Tcty_signature csg -> iter_class_signature csg
+        | Tcty_constr (path, list) ->
+            List.iter iter_core_type list
+        | Tcty_fun (label, ct, cl) ->
+            iter_core_type ct;
+            iter_class_type cl
+      end;
+      Iter.leave_class_type ct;
+    
+    and iter_class_signature cs =
+      Iter.enter_class_signature cs;
+      iter_core_type cs.csig_self;
+      List.iter iter_class_type_field cs.csig_fields;
+      Iter.leave_class_signature cs
+    
+    
+    and iter_class_type_field ctf =
+      Iter.enter_class_type_field ctf;
+      begin
+        match ctf.ctf_desc with
+          Tctf_inher ct -> iter_class_type ct
+        | Tctf_val (s, mut, virt, ct) ->
+            iter_core_type ct
+        | Tctf_virt  (s, priv, ct) ->
+            iter_core_type ct
+        | Tctf_meth  (s, priv, ct) ->
+            iter_core_type ct
+        | Tctf_cstr  (ct1, ct2) ->
+            iter_core_type ct1;
+            iter_core_type ct2
+      end;
+      Iter.leave_class_type_field ctf
+    
+    and iter_core_type ct =
+      Iter.enter_core_type ct;
+      begin
+        match ct.ctyp_desc with
+          Ttyp_any -> ()
+        | Ttyp_var s -> ()
+        | Ttyp_arrow (label, ct1, ct2) ->
+            iter_core_type ct1; 
+            iter_core_type ct2
+        | Ttyp_tuple list -> List.iter iter_core_type list
+        | Ttyp_constr (path, list) ->
+            List.iter iter_core_type list
+        | Ttyp_object list ->
+            List.iter iter_core_field_type list
+        | Ttyp_class (path, list, labels) ->
+            List.iter iter_core_type list
+        | Ttyp_alias (ct, s) ->
+            iter_core_type ct
+        | Ttyp_variant (list, bool, labels) ->
+            List.iter iter_row_field list
+        | Ttyp_poly (list, ct) -> iter_core_type ct
+        | Ttyp_package pack -> iter_package_type pack
+      end;
+      Iter.leave_core_type ct;
+    
+    and iter_core_field_type cft =
+      Iter.enter_core_field_type cft;
+      begin match cft.field_desc with
+          Tcfield_var -> ()
+        | Tcfield (s, ct) -> iter_core_type ct
+      end;
+      Iter.leave_core_field_type cft;
+    
+    and iter_class_structure cs =
+      Iter.enter_class_structure cs;
+      iter_pattern cs.cstr_pat;
+      List.iter iter_class_field cs.cstr_fields;
+      Iter.leave_class_structure cs;
+      
+    
+    and iter_row_field rf =
+      match rf with
+        Ttag (label, bool, list) -> 
+          List.iter iter_core_type list
+      | Tinherit ct -> iter_core_type ct
+    
+    and iter_class_field cf =
+      Iter.enter_class_field cf;
+      begin
+        match cf.cf_desc with
+          Tcf_inher (ovf, cl, super, _vals, _meths) ->
+          iter_class_expr cl
+      | Tcf_constr (cty, cty') ->
+          iter_core_type cty;
+          iter_core_type cty'
+      | Tcf_val (lab, mut, _, Tcfk_virtual cty, override) ->
+          iter_core_type cty
+      | Tcf_val (lab, mut, _, Tcfk_concrete exp, override) ->
+          iter_expression exp
+      | Tcf_meth (lab, priv, Tcfk_virtual cty, override) ->
+          iter_core_type cty
+      | Tcf_meth (lab, priv, Tcfk_concrete exp, override) ->
+          iter_expression exp
+      | Tcf_let (rec_flag, bindings, _) ->
+          iter_bindings Nonrecursive bindings
+      | Tcf_init exp -> 
+          iter_expression exp
+      end;
+      Iter.leave_class_field cf;
+
+  end
+  
+module DefaultIteratorArgument = struct
+    
+      let enter_structure _ = ()
+      let enter_value_description _ = ()
+      let enter_type_declaration _ = ()
+      let enter_exception_declaration _ = ()
+      let enter_pattern _ = ()
+      let enter_expression _ = ()
+      let enter_package_type _ = ()
+      let enter_signature _ = ()
+      let enter_signature_item _ = ()
+      let enter_modtype_declaration _ = ()
+      let enter_module_type _ = ()
+      let enter_module_expr _ = ()
+      let enter_with_constraint _ = ()
+      let enter_class_expr _ = ()
+      let enter_class_signature _ = ()
+      let enter_class_description _ = ()
+      let enter_class_type_declaration _ = ()
+      let enter_class_infos _ = ()
+      let enter_class_type _ = ()
+      let enter_class_type_field _ = ()
+      let enter_core_type _ = ()
+      let enter_core_field_type _ = ()
+      let enter_class_structure _ = ()
+    let enter_class_field _ = ()
+    let enter_structure_item _ = ()
+      
+          
+      let leave_structure _ = ()
+      let leave_value_description _ = ()
+      let leave_type_declaration _ = ()
+      let leave_exception_declaration _ = ()
+      let leave_pattern _ = ()
+      let leave_expression _ = ()
+      let leave_package_type _ = ()
+      let leave_signature _ = ()
+      let leave_signature_item _ = ()
+      let leave_modtype_declaration _ = ()
+      let leave_module_type _ = ()
+      let leave_module_expr _ = ()
+      let leave_with_constraint _ = ()
+      let leave_class_expr _ = ()
+      let leave_class_signature _ = ()
+      let leave_class_description _ = ()
+      let leave_class_type_declaration _ = ()
+      let leave_class_infos _ = ()
+      let leave_class_type _ = ()
+      let leave_class_type_field _ = ()
+      let leave_core_type _ = ()
+      let leave_core_field_type _ = ()
+      let leave_class_structure _ = ()
+    let leave_class_field _ = ()
+    let leave_structure_item _ = ()
+
+    let enter_binding _ _ = ()
+    let leave_binding _ _ = ()
+
+    let enter_bindings _ = ()
+    let leave_bindings _ = ()
+      
+  end
+  
\ No newline at end of file
diff --git a/ocaml-binary-annot/typing/typedtree.mli b/ocaml-binary-annot/typing/typedtree.mli
index 0a05f74333..503e5b68fc 100644
--- a/ocaml-binary-annot/typing/typedtree.mli
+++ b/ocaml-binary-annot/typing/typedtree.mli
@@ -380,3 +380,80 @@ type saved_type =
 val get_saved_types : unit -> saved_type list
 val set_saved_types : saved_type list -> unit
 val add_saved_type : saved_type -> unit
+
+  
+module type IteratorArgument = sig
+    val enter_structure : structure -> unit
+    val enter_value_description : value_description -> unit
+    val enter_type_declaration : type_declaration -> unit
+    val enter_exception_declaration :
+      exception_declaration -> unit
+    val enter_pattern : pattern -> unit
+    val enter_expression : expression -> unit
+    val enter_package_type : package_type -> unit
+    val enter_signature : signature -> unit
+    val enter_signature_item : signature_item -> unit
+    val enter_modtype_declaration : modtype_declaration -> unit
+    val enter_module_type : module_type -> unit
+    val enter_module_expr : module_expr -> unit
+    val enter_with_constraint : with_constraint -> unit
+    val enter_class_expr : class_expr -> unit
+    val enter_class_signature : class_signature -> unit
+    val enter_class_description : class_description -> unit
+    val enter_class_type_declaration :
+      class_type_declaration -> unit
+    val enter_class_infos : 'a class_infos -> unit
+    val enter_class_type : class_type -> unit
+    val enter_class_type_field : class_type_field -> unit
+    val enter_core_type : core_type -> unit
+    val enter_core_field_type : core_field_type -> unit
+    val enter_class_structure : class_structure -> unit
+    val enter_class_field : class_field -> unit
+    val enter_structure_item : structure_item -> unit
+
+      
+      val leave_structure : structure -> unit
+    val leave_value_description : value_description -> unit
+    val leave_type_declaration : type_declaration -> unit
+    val leave_exception_declaration :
+      exception_declaration -> unit
+    val leave_pattern : pattern -> unit
+    val leave_expression : expression -> unit
+    val leave_package_type : package_type -> unit
+    val leave_signature : signature -> unit
+    val leave_signature_item : signature_item -> unit
+    val leave_modtype_declaration : modtype_declaration -> unit
+    val leave_module_type : module_type -> unit
+    val leave_module_expr : module_expr -> unit
+    val leave_with_constraint : with_constraint -> unit
+    val leave_class_expr : class_expr -> unit
+    val leave_class_signature : class_signature -> unit
+    val leave_class_description : class_description -> unit
+    val leave_class_type_declaration :
+      class_type_declaration -> unit
+    val leave_class_infos : 'a class_infos -> unit
+    val leave_class_type : class_type -> unit
+    val leave_class_type_field : class_type_field -> unit
+    val leave_core_type : core_type -> unit
+    val leave_core_field_type : core_field_type -> unit
+    val leave_class_structure : class_structure -> unit
+    val leave_class_field : class_field -> unit
+    val leave_structure_item : structure_item -> unit
+      
+    val enter_bindings : rec_flag -> unit      
+    val enter_binding : pattern -> expression -> unit
+    val leave_binding : pattern -> expression -> unit
+    val leave_bindings : rec_flag -> unit
+
+      end
+  
+module MakeIterator : 
+  functor
+  (Iter : IteratorArgument) ->
+           sig
+             val iter_structure : structure -> unit
+             val iter_signature : signature -> unit
+           end
+
+module DefaultIteratorArgument : IteratorArgument
+  
\ No newline at end of file
diff --git a/ocaml-binary-annot/typing/typemod.ml b/ocaml-binary-annot/typing/typemod.ml
index b77cf30275..b668e1e8e1 100644
--- a/ocaml-binary-annot/typing/typemod.ml
+++ b/ocaml-binary-annot/typing/typemod.ml
@@ -70,7 +70,7 @@ let type_open env loc lid =
 
 (* Record a module type *)
 let rm node =
-  Stypes.record (Stypes.Ti_mod node);
+  Stypes.record (Stypes.Ti_mod node); (* moved to genannot *)
   node
 
 (* Forward declaration, to be filled in by type_module_type_of *)
@@ -1035,7 +1035,7 @@ and type_structure funct_body anchor env sstr scope =
          final_env)
   in
   if !Clflags.annotations
-  then List.iter (function {pstr_loc = l} -> Stypes.record_phrase l) sstr;
+  then List.iter (function {pstr_loc = l} -> Stypes.record_phrase l) sstr; (* moved to genannot *)
   let previous_saved_types = Typedtree.get_saved_types () in
   let (items, sg, finalenv) = type_struct env sstr in
   let str = { str_items = items; str_type = sg } in
@@ -1181,6 +1181,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
         output_value oc [| Saved_implementation str |];
         close_out oc;
 
+(*
         let oc = open_out (outputprefix ^ "_ast2src.ml") in
         let ppf = Format.formatter_of_out_channel oc in
         Pprintast.print_structure ppf ast;
@@ -1193,7 +1194,7 @@ let type_implementation sourcefile outputprefix modulename initial_env ast =
         Pprintast.print_structure ppf (Untypeast.untype_structure str);
         Format.pp_print_flush ppf ();
         close_out oc;
-
+*)
       end;
     (str, coercion)
   with e ->