Commits

camlspotter  committed 4b4e6ba

Env.t with Annot.Type but it contains lazy closures

  • Participants
  • Parent commits 5523ccf
  • Branches ocamlspot

Comments (0)

Files changed (18)

File ocamlspot/.depend

     ../typing/path.cmi ../typing/ident.cmi ../typing/env.cmi \
     ../typing/annot.cmi
 treeset.cmi: xset.cmi
+typeexpand.cmi: ../typing/types.cmi ../typing/env.cmi
 utils.cmi:
 xmain.cmi:
 xset.cmi:
     ../typing/env.cmx dotfile.cmx ../typing/annot.cmi spotfile.cmi
 treeset.cmo: xset.cmi treeset.cmi
 treeset.cmx: xset.cmx treeset.cmi
+typeexpand.cmo: ../typing/types.cmi ../typing/env.cmi ../typing/ctype.cmi \
+    typeexpand.cmi
+typeexpand.cmx: ../typing/types.cmx ../typing/env.cmx ../typing/ctype.cmx \
+    typeexpand.cmi
 utils.cmo: utils.cmi
 utils.cmx: utils.cmi
 xmain.cmo: ../typing/spot.cmi xmain.cmi

File ocamlspot/Makefile

 # Various commands and dir
 ##########################
 CAMLRUN=../boot/ocamlrun
-OCAMLC   = ../ocamlcomp.sh -annot -w Ae -warn-error Ae
+OCAMLC   = ../ocamlcomp.sh -annot -w Ae -warn-error Ae-9-27
 OCAMLOPT = ../ocamlcompopt.sh
 OCAMLDEP = $(CAMLRUN) ../tools/ocamldep
 OCAMLLEX = $(CAMLRUN) ../boot/ocamllex
 # Requires unix!
 COMPFLAGS= $(INCLUDES_DEP) -I $(OTHERS)/unix
 
-MODULES= utils dotfile xset treeset command \
+MODULES= utils dotfile xset treeset command typeexpand \
 	spotapi spoteval spotconfig_intf spotconfig spotfile pathreparse xmain ocamlspot
 
 UTILS=utils/misc utils/tbl utils/config \

File ocamlspot/ocamlspot.ml

   ;;
 
   let rannots_full file = 
-    Format.eprintf "@[<2>rannots =@ @[<v>%a@]@]@."
+    eprintf "@[<2>rannots =@ @[<v>%a@]@]@."
       (Format.list "; " (Regioned.format Annot.format))
       file.File.rannots
   ;;
   
   let rannots_summary file = 
-    Format.eprintf "@[<2>rannots =@ @[<v>%a@]@]@."
+    eprintf "@[<2>rannots =@ @[<v>%a@]@]@."
       (Format.list "; " (Regioned.format Annot.summary))
       file.File.rannots
   ;;
   ;;
 
   let top file = 
-    Format.eprintf "@[<2>top =@ @[%a@]@]@." 
+    eprintf "@[<2>top =@ @[%a@]@]@." 
       Abstraction.format_structure file.File.top;
     let str = 
       Eval.structure (File.empty_env file) file.File.top
       let module Enforcer = Value.Enforcer(struct end) in
       Enforcer.structure str;
     end;
-    Format.eprintf "==>@.@[%a@]@." Value.Format.structure str
+    eprintf "==>@.@[%a@]@." Value.Format.structure str
   ;;
 
   let flat file = 
-    Format.eprintf "@[<2>flat =@ @[%a@]@]@." 
+    eprintf "@[<2>flat =@ @[%a@]@]@." 
       Abstraction.format_structure file.File.flat;
     let str = 
       let env = File.invalid_env file in
       let module Enforcer = Value.Enforcer(struct end) in
       Enforcer.structure str;
     end;
-    Format.eprintf "==>@.@[%a@]@." Value.Format.structure str;
+    eprintf "==>@.@[%a@]@." Value.Format.structure str;
   ;;
 end
 
 module Main = struct
 
   let bye return =
-    Format.printf "BYE!@.";
+    printf "BYE!@.";
     exit return
 
   let load path =
     if C.dump_flat then Dump.flat file;
 
     if C.print_file_info then
-      Format.printf "Compile: %s@."
+      printf "Compile: %s@."
         (String.concat " " 
             (List.map Command.escaped_for_shell 
                 (Array.to_list file.File.argv)));
 
     if C.print_file_info then
-      Format.printf "@[<v2>Included_dirs:@ %a@]@."
-        (Format.list "" Format.pp_print_string)
+      printf "@[<v2>Included_dirs:@ %a@]@."
+        (Format.list "" pp_print_string)
         file.File.load_paths;
 
     file
   ;;
 
   let print_query_result kind = function
-    | None -> Format.printf "Spot: no spot@."
+    | None -> printf "Spot: no spot@."
     | Some (pident, res) -> match res with
 	| File.File_itself ->
-            Format.printf "Spot: <%s:all>@." pident.PIdent.path
+            printf "Spot: <%s:all>@." pident.PIdent.path
 	| File.Found_at region ->
-            Format.printf "Spot: <%s:%s>@."
+            printf "Spot: <%s:%s>@."
               pident.PIdent.path
               (Region.to_string region)
 	| File.Predefined ->
-            Format.printf "Spot: %a: predefined %s@."
+            printf "Spot: %a: predefined %s@."
               PIdent.format pident
               (Kind.name kind);
   ;;
 	  | Some (annots, r) -> annots, r
 	in
 	  
-        List.iter (fun annot -> 
-	  Format.printf "%a@." Annot.format annot) annots;
+        List.iter (printf "%a@." Annot.format) annots;
 
 	(* Tree is an older format. XTree is a newer which is the same as one for Spot *)
-        Format.printf "Tree: %s@." (Region.to_string r);
-        Format.printf "XTree: <%s:%s>@." file.File.path (Region.to_string r);
+        printf "Tree: %s@." (Region.to_string r);
+        printf "XTree: <%s:%s>@." file.File.path (Region.to_string r);
 
 	(* Find the innermost module *)
         let rec find_module_path = function
               id :: find_module_path ls
           | _ :: ls -> find_module_path ls
         in
-        Format.printf "In_module: %s@."
+        printf "In_module: %s@."
           (String.concat "." (List.map Ident0.name (List.rev (find_module_path treepath))));
 
         (* print "Val: val name : type" if it is a Str: val *)
           in
           match find_type annots, find_str_value annots with
           | Some typ, Some id ->
-              Format.printf "Val: val %s : @[%a@]@."
+              printf "Val: val %s : @[%a@]@."
                 (Ident0.name id)
                 (Printtyp.type_scheme ~with_pos:false) typ
           | _ -> ()
         in
         print_sig_entry annots;
 
+        (* print_type_decl: if one Type is found *)
+        if C.print_type_declaration then begin
+          match List.filter (function Annot.Type _ -> true | _ -> false) annots with
+          | [Annot.Type typ] -> ()
+              
+              
+          | [] -> ()
+          | _ -> eprintf "More than one Annot.Type found. Disabled --print-type-decl.@."
+        end;
+
 	annots
   ;;
 
     let path = File.spot_of_file path in
     let file = load path in
 
+    let query_kind_path k path = print_query_result k (query_by_kind_path file k path) in
+
     begin match spec with
-    | C.SearchSpec.Kind (k,path) -> 
-        print_query_result k (query_by_kind_path file k path)
+    | C.SearchSpec.Kind (k,path) -> query_kind_path k path
     | C.SearchSpec.Pos pos -> 
 	let annots = query_by_pos file pos in
         if not C.no_definition_analysis then begin
           List.iter (function
-            | Annot.Use (kind, path) -> 
-		print_query_result kind (query_by_kind_path file kind path)
+            | Annot.Use (k, path) -> query_kind_path k path
             | _ -> ()) annots
         end
     end;
   let query file spec =
     try query file spec with
     | Failure s ->
-        Format.eprintf "Error: %s@." s;
+        eprintf "Error: %s@." s;
         bye 1
     | File.Old_spot (_spot, source) ->
-        Format.eprintf "Error: source %s is newer than the spot@." source;
+        eprintf "Error: source %s is newer than the spot@." source;
         bye 1
     | e ->
-        Format.eprintf "uncaught exception: %s@." (Printexc.to_string e);
+        eprintf "uncaught exception: %s@." (Printexc.to_string e);
         bye 1
 
   let use path spec targets =
 	    | { Regioned.region= region; value= Annot.Use (k', path'); } when k = k' && base = base_ident path' ->
 	      begin match query_by_kind_path file k' path' with
 	      | Some found' when found = found' ->
-		  Format.printf "<%s:%s>: %s@." 
+		  printf "<%s:%s>: %s@." 
 		    file.File.path
 		    (Region.to_string region)
 		    (Path.name path)
       let res = query_by_kind_path file k path in
       print_query_result k res;
       match res with
-      | None -> Format.printf "No query result found.@.";
+      | None -> printf "No query result found.@.";
       | Some found -> find_by_kind_path k path found
     in
 
     let by_pos file pos = 
-      Format.eprintf "Searching %s:%s ...@." 
+      eprintf "Searching %s:%s ...@." 
 	file.File.path 
 	(Position.to_string pos);
       match List.find_map_opt (function 
 	| Annot.Use (kind, path) -> Some (`Use (kind, path))
 	| _ -> None) (query_by_pos file pos)
       with
-      | Some (`Def (k, id)) -> by_kind_path file k (Path.Pident id)
+      | Some (`Def (k, id))   -> by_kind_path file k (Path.Pident id)
       | Some (`Use (k, path)) -> by_kind_path file k path
       | None -> ()
     in
 
     begin match spec with
     | C.SearchSpec.Kind (k,path) -> by_kind_path file k path
-    | C.SearchSpec.Pos pos -> by_pos file pos
+    | C.SearchSpec.Pos pos       -> by_pos file pos
     end;
     bye 0
   ;;
       let path = File.spot_of_file mlpath in
       let file = File.load ~load_paths: ["."] path in
     
-      Format.printf "Compile: %s@."
+      printf "Compile: %s@."
         (String.concat " " 
           (List.map Command.escaped_for_shell 
             (Array.to_list file.File.argv)));
 
   let main () = 
     match C.mode with
-    | `Dump path -> ignore (load path)
-    | `Query (path, spec) -> query path spec
-    | `Typecheck args -> typecheck args
-    | `Recheck args -> recheck args
-    | `Use ((path, spec), targets)-> use path spec targets
+    | `Dump path                   -> ignore (load path)
+    | `Query (path, spec)          -> query path spec
+    | `Typecheck args              -> typecheck args
+    | `Recheck args                -> recheck args
+    | `Use ((path, spec), targets) -> use path spec targets
 end
 
 let _ = Main.main ()

File ocamlspot/spotapi.ml

 (***********************************************************************)
 
 open Utils
-
 open Spot
 
-let magic_number = Spot.magic_number
+open Format
+
+let magic_number  = Spot.magic_number
 let ocaml_version = Spot.ocaml_version
-let version = Spot.version
+let version       = Spot.version
 
 module Longident = struct
   (* extend the original module *)
     in
     to_path (Longident.parse s)
 
-  let format ppf p = Format.pp_print_string ppf (name p)
+  let format ppf p = pp_print_string ppf (name p)
 end
 
 module TypeFix : sig
   include Abstraction
 
   let ident_of_structure_item : structure_item -> (Kind.t * Ident.t) option = function
-    | Str_value id -> Some (Kind.Value, id)
-    | Str_type id -> Some (Kind.Type, id)
-    | Str_exception id -> Some (Kind.Exception, id) 
-    | Str_module (id, _) -> Some (Kind.Module, id)
+    | Str_value id        -> Some (Kind.Value, id)
+    | Str_type (id, _)    -> Some (Kind.Type, id)
+    | Str_exception id    -> Some (Kind.Exception, id) 
+    | Str_module (id, _)  -> Some (Kind.Module, id)
     | Str_modtype (id, _) -> Some (Kind.Module_type, id)
-    | Str_class id -> Some (Kind.Class, id)
-    | Str_cltype id -> Some (Kind.Class_type, id)
-    | Str_include _ -> None
+    | Str_class id        -> Some (Kind.Class, id)
+    | Str_cltype id       -> Some (Kind.Class_type, id)
+    | Str_include _       -> None
 
-  open Format
-  
   let rec format_module_expr ppf = function
     | Mod_ident p -> fprintf ppf "%s" (Path.name p)
     | Mod_packed s -> fprintf ppf "packed(%s)" s
       
   and format_structure_item ppf = function
     | Str_value id -> fprintf ppf "val %s" (Ident.name id)
-    | Str_type id -> fprintf ppf "type %s" (Ident.name id)
+    | Str_type (id, _) -> fprintf ppf "type %s" (Ident.name id) (* CR jfuruse: todo *)
     | Str_exception id -> fprintf ppf "exception %s" (Ident.name id)
     | Str_module (id, mexp) -> 
         fprintf ppf "@[<v4>module %s = %a@]" 
 	Printtyp.reset ();
 	Printtyp.mark_loops typ;
         (* CR jfuruse: not fancy having @. *)
-	Format.fprintf ppf "Type: %a@ " (Printtyp.type_scheme ~with_pos:false) typ;
-	Format.fprintf ppf "XType: %a" (Printtyp.type_scheme ~with_pos:true) typ
+	fprintf ppf "Type: %a@ " (Printtyp.type_scheme ~with_pos:false) typ;
+	fprintf ppf "XType: %a" (Printtyp.type_scheme ~with_pos:true) typ
     | Mod_type mty -> 
-	Format.fprintf ppf "Type: %a@ " (Printtyp.modtype ~with_pos:false) mty;
-	Format.fprintf ppf "XType: %a" (Printtyp.modtype ~with_pos:true) mty
+	fprintf ppf "Type: %a@ " (Printtyp.modtype ~with_pos:false) mty;
+	fprintf ppf "XType: %a" (Printtyp.modtype ~with_pos:true) mty
     | Str str ->
-	Format.fprintf ppf "Str: %a"
+	fprintf ppf "Str: %a"
 	  Abstraction.format_structure_item str
     | Use (use, path) ->
-	Format.fprintf ppf "Use: %s, %s" 
+	fprintf ppf "Use: %s, %s" 
 	  (String.capitalize (Kind.name use)) (Path.name path)
     | Module mexp ->
-	Format.fprintf ppf "Module: %a"
+	fprintf ppf "Module: %a"
           Abstraction.format_module_expr mexp
     | Functor_parameter id ->
-	Format.fprintf ppf "Functor_parameter: %s" (Ident.name id)
+	fprintf ppf "Functor_parameter: %s" (Ident.name id)
     | Non_expansive b ->
-        Format.fprintf ppf "Non_expansive: %b" b
+        fprintf ppf "Non_expansive: %b" b
 
   let summary ppf = function
     | Type _typ -> 
         (* CR jfuruse: not fancy having @. *)
-	Format.fprintf ppf "Type: ...@ ";
-	Format.fprintf ppf "XType: ..."
+	fprintf ppf "Type: ...@ ";
+	fprintf ppf "XType: ..."
     | Mod_type _mty -> 
-	Format.fprintf ppf "Type: ...@ ";
-	Format.fprintf ppf "XType: ..."
+	fprintf ppf "Type: ...@ ";
+	fprintf ppf "XType: ..."
     | Str _str ->
-	Format.fprintf ppf "Str: ..."
+	fprintf ppf "Str: ..."
     | Use (use, path) ->
-	Format.fprintf ppf "Use: %s, %s" 
+	fprintf ppf "Use: %s, %s" 
 	  (String.capitalize (Kind.name use)) (Path.name path)
     | Module _mexp ->
-	Format.fprintf ppf "Module: ..."
+	fprintf ppf "Module: ..."
     | Functor_parameter id ->
-	Format.fprintf ppf "Functor_parameter: %s" (Ident.name id)
+	fprintf ppf "Functor_parameter: %s" (Ident.name id)
     | Non_expansive b ->
-        Format.fprintf ppf "Non_expansive: %b" b
+        fprintf ppf "Non_expansive: %b" b
 
   let dummy = Use (Kind.Value, Path.Pident (Ident.create_persistent "dummy"))
 end 
       { region = r12; value = v }) 
 
   let format f ppf { region = r; value = v } =
-    Format.fprintf ppf "@[<2>%s: %a@]" 
+    fprintf ppf "@[<2>%s: %a@]" 
       (Region.to_string r) 
       f v
 end
   open Regioned
 
   type t = Annot.t Regioned.t
-  let split = Regioned.split
+  let split   = Regioned.split
   let compare = Regioned.compare
-  let format = Regioned.format Annot.format
+  let format  = Regioned.format Annot.format
 end
 
 module Tree = struct
   let dump t = 
     iter_elem (fun ~parent rrspot ->
 	let format_parent ppf = function
-	  | None -> Format.fprintf ppf "ROOT"
+	  | None -> fprintf ppf "ROOT"
 	  | Some rrspot -> RAnnot.format ppf rrspot
 	in
-	Format.eprintf "@[<2>%a =>@ %a@]@."
+	eprintf "@[<2>%a =>@ %a@]@."
 	  format_parent parent
 	  RAnnot.format rrspot) t
 end

File ocamlspot/spotapi.mli

 module Abstraction : sig
 
   type module_expr = Spot.Abstraction.module_expr =
-      | Mod_ident of Path.t
-      | Mod_packed of string
-      | Mod_structure of structure
-      | Mod_functor of Ident.t * Types.module_type * module_expr
-      | Mod_apply of module_expr * module_expr
+      | Mod_ident      of Path.t
+      | Mod_packed     of string
+      | Mod_structure  of structure
+      | Mod_functor    of Ident.t * Types.module_type * module_expr
+      | Mod_apply      of module_expr * module_expr
       | Mod_constraint of module_expr * Types.module_type
-      | Mod_unpack of module_expr
+      | Mod_unpack     of module_expr
       | Mod_abstract
 
   and structure = structure_item list
 
   and structure_item = Spot.Abstraction.structure_item =
-      | Str_value of Ident.t
-      | Str_type of Ident.t
+      | Str_value     of Ident.t
+      | Str_type      of Ident.t * Types.type_declaration
       | Str_exception of Ident.t
-      | Str_module of Ident.t * module_expr
-      | Str_modtype of Ident.t * module_expr
-      | Str_class of Ident.t
-      | Str_cltype of Ident.t
-      | Str_include of module_expr * (Kind.t * Ident.t) list
+      | Str_module    of Ident.t * module_expr
+      | Str_modtype   of Ident.t * module_expr
+      | Str_class     of Ident.t
+      | Str_cltype    of Ident.t
+      | Str_include   of module_expr * (Kind.t * Ident.t) list
 
   val ident_of_structure_item : structure_item -> (Kind.t * Ident.t) option
 

File ocamlspot/spotconfig.ml

   Printf.sprintf "%s for ocaml %s" app_version Spot.ocaml_version
 
 let print_version () =
-  Format.eprintf "ocamlspot %s@." version
+  eprintf "ocamlspot %s@." version
     
-let rev_anonargs = ref []
-let dump_file = ref false
-let dump_rannots = ref `None
-let dump_tree = ref false
-let dump_top = ref false
-let dump_flat = ref false
-let eager_dump = ref false
+let rev_anonargs           = ref []
+let dump_file              = ref false
+let dump_rannots           = ref `None
+let dump_tree              = ref false
+let dump_top               = ref false
+let dump_flat              = ref false
+let eager_dump             = ref false
 let no_definition_analysis = ref false
-let strict_time_stamp = ref false
-let print_file_info = ref false
-let print_interface = ref false
-let rest_args_rev = ref []
+let strict_time_stamp      = ref false
+let print_file_info        = ref false
+let print_interface        = ref false
+let print_type_declaration = ref false
+let rest_args_rev          = ref []
 
 let _ = 
   Arg.parse 
-    [ "--version", Arg.Unit print_version, "\t: print version information";
-      "-version", Arg.Unit print_version, "\t: (deprecated)";
+    [ "--version", 
+      Arg.Unit print_version, "\t: print version information";
 
-      "-n", Arg.Set no_definition_analysis, "\t: no definition analysis";
-      "--no-analysis", Arg.Set no_definition_analysis, "\t: no definition analysis";
+      "-version", 
+      Arg.Unit print_version, "\t: (deprecated)";
+
+      "-n", 
+      Arg.Set no_definition_analysis, "\t: no definition analysis";
+
+      "--no-analysis", 
+      Arg.Set no_definition_analysis, "\t: no definition analysis";
       
-      "-i", Arg.Set print_file_info, "\t: print file information";
-      "--info", Arg.Set print_file_info, "\t: print file information";
+      "-i", 
+      Arg.Set print_file_info, "\t: print file information";
 
-      "--strict-time-stamp", Arg.Set strict_time_stamp, "\t: error at newer source files than their spots";
+      "--info", 
+      Arg.Set print_file_info, "\t: print file information";
 
-      "--interface", Arg.Set print_interface, 
-      "\t: show the interface rather than the definition (experimental)";
+      "--strict-time-stamp", 
+      Arg.Set strict_time_stamp, "\t: error at newer source files than their spots";
 
-      "--debug", Arg.Set Debug.on, "\t: print debug information";
-      "-debug", Arg.Set Debug.on, "\t: (deprecated)";
-      "--dump-file", Arg.Set dump_file, "\t: dump spot file"; 
-      "--dump-rannots", Arg.Unit (fun () -> dump_rannots := `Full), "\t: dump loc-annots";
-      "--dump-rannots-summary", Arg.Unit (fun () -> dump_rannots := `Summary), "\t: dump loc-annots";
-      "--dump-tree", Arg.Set dump_tree, "\t: dump annot tree";
-      "--dump-top", Arg.Set dump_top, "\t: dump top"; 
-      "--dump-flat", Arg.Set dump_flat, "\t: dump flat"; 
-      "--eager-dump", Arg.Set eager_dump, "\t: eager evaluation at dump";
+      "--interface", 
+      Arg.Set print_interface, "\t: show the interface rather than the definition (experimental)";
+
+      "--show-typedecl",
+      Arg.Set print_type_declaration, "\t: show corresponding type declaration (experimental)";
+
+      "--debug", 
+      Arg.Set Debug.on, "\t: print debug information";
+
+      "-debug", 
+      Arg.Set Debug.on, "\t: (deprecated)";
+
+      "--dump-file", 
+      Arg.Set dump_file, "\t: dump spot file"; 
+
+      "--dump-rannots", 
+      Arg.Unit (fun () -> dump_rannots := `Full), "\t: dump loc-annots";
+
+      "--dump-rannots-summary", 
+      Arg.Unit (fun () -> dump_rannots := `Summary), "\t: dump loc-annots";
+
+      "--dump-tree", 
+      Arg.Set dump_tree, "\t: dump annot tree";
+
+      "--dump-top", 
+      Arg.Set dump_top, "\t: dump top"; 
+
+      "--dump-flat", 
+      Arg.Set dump_flat, "\t: dump flat"; 
+
+      "--eager-dump", 
+      Arg.Set eager_dump, "\t: eager evaluation at dump";
     ]
     (fun s -> rev_anonargs := s :: !rev_anonargs)
     (Printf.sprintf 
 Options:"
         version)
 
-let dump_file = !dump_file
-let dump_rannots = !dump_rannots
-let dump_tree = !dump_tree
-let dump_top  = !dump_top 
-let dump_flat = !dump_flat
-let eager_dump = !eager_dump
+let dump_file              = !dump_file
+let dump_rannots           = !dump_rannots
+let dump_tree              = !dump_tree
+let dump_top               = !dump_top 
+let dump_flat              = !dump_flat
+let eager_dump             = !eager_dump
 let no_definition_analysis = !no_definition_analysis
-let strict_time_stamp = !strict_time_stamp
-let print_file_info = !print_file_info
-let print_interface = !print_interface
+let strict_time_stamp      = !strict_time_stamp
+let print_file_info        = !print_file_info
+let print_interface        = !print_interface
+let print_type_declaration = !print_type_declaration
 
 let dump_any = 
   dump_file || dump_rannots <> `None || dump_tree || dump_top || dump_flat
     | _ -> failwith "You cannot specify mode with --dump"
   end else begin
     Debug.format "anonargs = [%a]@." 
-      (Format.list " " Format.pp_print_string) 
+      (Format.list " " pp_print_string) 
       anonargs;
     match anonargs with
-    | [ "query"; spec ] -> `Query (SearchSpec.parse spec)
+    | [ "query"; spec ]        -> `Query (SearchSpec.parse spec)
     | "use" :: spec :: targets -> `Use (SearchSpec.parse spec, targets)
-    | "typecheck" :: rest -> `Typecheck rest
-    | "recheck" :: rest -> `Recheck rest
-    | [ spec ] -> `Query (SearchSpec.parse spec)
-    | _ -> failwith "At most one search spec is allowed"
+    | "typecheck" :: rest      -> `Typecheck rest
+    | "recheck" :: rest        -> `Recheck rest
+    | [ spec ]                 -> `Query (SearchSpec.parse spec)
+    | _                        -> failwith "At most one search spec is allowed"
   end

File ocamlspot/spotconfig.mli

 include Spotconfig_intf.S
-(*
-val app_version : string
-
-val version : string
-val print_version : unit -> unit
-
-val dump_file : bool
-val dump_rannots : bool
-val dump_tree : bool
-val dump_top : bool
-val dump_flat : bool
-val dump_any : bool
-val eager_dump : bool
-
-val no_definition_analysis : bool
-
-val strict_time_stamp : bool
-
-val print_file_info : bool
-val print_interface : bool
-
-module SearchSpec : sig
-  type t =
-    | Pos of Spotapi.Position.t
-    | Kind of Spotapi.Kind.t * Spotapi.Path.t
-  val parse : string -> string * t
-  val to_string : t -> string
-end
-
-val mode : [ `Dump of string
-           | `Query of string * SearchSpec.t
-	   | `Use of (string * SearchSpec.t) * string list
-	   | `Recheck of string list
-	   | `Typecheck of string list ]
-*)

File ocamlspot/spotconfig_intf.ml

 module type S = sig
-  val app_version : string
+  val app_version            : string
   
-  val version : string
-  val print_version : unit -> unit
+  val version                : string
+  val print_version          : unit -> unit
   
-  val dump_file : bool
-  val dump_rannots : [ `None | `Full | `Summary ]
-  val dump_tree : bool
-  val dump_top : bool
-  val dump_flat : bool
-  val dump_any : bool
-  val eager_dump : bool
+  val dump_file              : bool
+  val dump_rannots           : [ `None | `Full | `Summary ]
+  val dump_tree              : bool
+  val dump_top               : bool
+  val dump_flat              : bool
+  val dump_any               : bool
+  val eager_dump             : bool
   
   val no_definition_analysis : bool
   
-  val strict_time_stamp : bool
+  val strict_time_stamp      : bool
   
-  val print_file_info : bool
-  val print_interface : bool
-  
+  val print_file_info        : bool
+  val print_interface        : bool
+  val print_type_declaration : bool
+
   module SearchSpec : sig
     type t =
-      | Pos of Spotapi.Position.t
+      | Pos  of Spotapi.Position.t
       | Kind of Spotapi.Kind.t * Spotapi.Path.t
     val parse : string -> string * t
     val to_string : t -> string
   end
   
-  val mode : [ `Dump of string
-             | `Query of string * SearchSpec.t
-  	   | `Use of (string * SearchSpec.t) * string list
-  	   | `Recheck of string list
-  	   | `Typecheck of string list ]
+  val mode : [ `Dump      of string
+             | `Query     of string * SearchSpec.t
+             | `Use       of (string * SearchSpec.t) * string list
+             | `Recheck   of string list
+             | `Typecheck of string list ]
 end
 

File ocamlspot/spoteval.ml

   }
 
   let format ppf id =
-    Format.fprintf ppf "%s%s" 
+    fprintf ppf "%s%s" 
       (if id.path = "" then ""
         else 
           (let len = String.length id.path in
     include Format
 
     let rec t ppf = function
-      | Ident id -> Format.fprintf ppf "Ident(%a)" PIdent.format id
-      | Parameter id -> Format.fprintf ppf "Parameter(%a)" PIdent.format id
+      | Ident id -> fprintf ppf "Ident(%a)" PIdent.format id
+      | Parameter id -> fprintf ppf "Parameter(%a)" PIdent.format id
       | Structure (pid, str, None) -> 
-            Format.fprintf ppf "@[<v2>Module(%a)@ %a None@]"
+            fprintf ppf "@[<v2>Module(%a)@ %a None@]"
               PIdent.format pid
             structure str
       | Structure (pid, str, Some str') -> 
-            Format.fprintf ppf "@[<v2>Module(%a)@ %a (Some %a)@]"
+            fprintf ppf "@[<v2>Module(%a)@ %a (Some %a)@]"
               PIdent.format pid
             structure str
             structure str'
       | Closure (pid, _, id, _mty, module_expr) ->
-            Format.fprintf ppf "(@[<2>(%a =)fun %s ->@ @[%a@]@])" 
+            fprintf ppf "(@[<2>(%a =)fun %s ->@ @[%a@]@])" 
               PIdent.format pid
               (Ident.name id)
               Abstraction.format_module_expr module_expr
-      | Error (Failure s) -> Format.fprintf ppf "ERROR(%s)" s
-      | Error exn -> Format.fprintf ppf "ERROR(%s)" (Printexc.to_string exn)
+      | Error (Failure s) -> fprintf ppf "ERROR(%s)" s
+      | Error exn -> fprintf ppf "ERROR(%s)" (Printexc.to_string exn)
             
     and env ppf env = 
-      Format.fprintf ppf "{ @[path=%s;@,@[<2>load_paths=@,[@[%a@]];@]@,@[<2>structure=@,@[%a@]@]@] }"
+      fprintf ppf "{ @[path=%s;@,@[<2>load_paths=@,[@[%a@]];@]@,@[<2>structure=@,@[%a@]@]@] }"
         env.path
-        (Format.list "; " (fun ppf s -> Format.fprintf ppf "%S" s)) env.load_paths
+        (Format.list "; " (fun ppf s -> fprintf ppf "%S" s)) env.load_paths
         binding env.binding
         
     and binding ppf b = 
       match !b with
-      | None -> Format.fprintf ppf "PREM"
+      | None -> fprintf ppf "PREM"
       | Some str -> structure ppf str
 
     and structure ppf =
-      Format.fprintf ppf "{ @[<v>%a@] }"
+      fprintf ppf "{ @[<v>%a@] }"
         (Format.list "; " (fun ppf (id, (kind, t)) ->
-            Format.fprintf ppf "@[<2>%s %s =@ %a@]" 
+            fprintf ppf "@[<2>%s %s =@ %a@]" 
               (String.capitalize (Kind.to_string kind))
             (Ident.name id) z t))
         
             str
           with
           | e -> 
-              Format.eprintf "LOAD FAILIURE %s: %s@." (Ident.name id) (Printexc.to_string e);
+              eprintf "LOAD FAILIURE %s: %s@." (Ident.name id) (Printexc.to_string e);
               Error e
           end
         else begin 
     List.fold_left (fun str sitem ->
       match sitem with
       | Str_value id 
-      | Str_type id
+      | Str_type (id, _) (* CR jfuruse: correct? *)
       | Str_exception id
       | Str_class id
       | Str_cltype id ->

File ocamlspot/spotfile.ml

   }
 
   let dump_file file =
-    Format.eprintf "@[<2>{ path= %S;@ cwd= %S;@ load_paths= [ @[%a@] ];@ version= %S,%S;@ argv= [| @[%a@] |]; ... }@]@."
+    eprintf "@[<2>{ path= %S;@ cwd= %S;@ load_paths= [ @[%a@] ];@ version= %S,%S;@ argv= [| @[%a@] |]; ... }@]@."
       (match file.path with 
       | "" -> "NONE"
       | s -> s)
       file.cwd
-      (Format.list "; " (fun ppf s -> Format.fprintf ppf "%S" s)) file.load_paths
+      (Format.list "; " (fun ppf s -> fprintf ppf "%S" s)) file.load_paths
       (fst file.version) (snd file.version)
-      (Format.list "; " (fun ppf s -> Format.fprintf ppf "%S" s)) (Array.to_list file.argv)
+      (Format.list "; " (fun ppf s -> fprintf ppf "%S" s)) (Array.to_list file.argv)
 
   (* xxx.{ml,cmo,cmx,spot} => xxx.spot 
      xxx.{mli,cmi,spit} => xxx.spit
         List.iter (fun { Regioned.region = loc; value = annot } ->
           match annot with
           | Annot.Str ( Abstraction.Str_value id
-            | Abstraction.Str_type id
-            | Abstraction.Str_exception id
-            | Abstraction.Str_modtype (id, _)
-            | Abstraction.Str_class id
-            | Abstraction.Str_cltype id   
-            | Abstraction.Str_module (id, _) )  ->
+                      | Abstraction.Str_type (id, _) (* CR jfuruse: ? *)
+                      | Abstraction.Str_exception id
+                      | Abstraction.Str_modtype (id, _)
+                      | Abstraction.Str_class id
+                      | Abstraction.Str_cltype id   
+                      | Abstraction.Str_module (id, _) )  ->
               Hashtbl.add tbl id loc
           | Annot.Str ( Abstraction.Str_include _ ) -> ()
           | Annot.Functor_parameter id ->
                       if Spotconfig.strict_time_stamp then 
                         raise (Old_spot (path, source))
                       else
-                        Format.eprintf "Warning: source %s is newer than the spot@." source
+                        eprintf "Warning: source %s is newer than the spot@." source
                 end;
                 Hashtbl.replace cache path file;
                 file
     let load ~load_paths spotname : file =
       Debug.format "@[<2>spot searching %s in@ paths [@[%a@]]@]@." 
           spotname
-          (Format.list "; " (fun ppf x -> Format.fprintf ppf "%S" x)) 
+          (Format.list "; " (fun ppf x -> fprintf ppf "%S" x)) 
           load_paths;
         let body, ext = Filename.split_extension spotname in
       let path = find_in_path load_paths body ext in
                 Hashtbl.find file.id_def_regions id
               with
               | Not_found ->
-                  Format.eprintf "Error: find location of id %a failed@."
+                  eprintf "Error: find location of id %a failed@."
                     PIdent.format pid;
                   raise Not_found
               end
   let _ = Eval.packed := eval_packed
 
   let dump_elem = function
-    | Source_path (Some s) -> Format.eprintf "Source_path: %s@." s
-    | Source_path None -> Format.eprintf "Source_path: None@." 
-    | Cwd s -> Format.eprintf "Cwd: %s@." s 
+    | Source_path (Some s) -> eprintf "Source_path: %s@." s
+    | Source_path None -> eprintf "Source_path: None@." 
+    | Cwd s -> eprintf "Cwd: %s@." s 
     | Load_paths ds -> 
-        Format.eprintf "Load_paths: @[%a@]@."
-          (Format.list "; " (fun ppf s -> Format.fprintf ppf "%S" s)) ds
+        eprintf "Load_paths: @[%a@]@."
+          (Format.list "; " (fun ppf s -> fprintf ppf "%S" s)) ds
     | Argv argv ->
-        Format.eprintf "Argv: @[%a@]@."
-          (Format.list "; " (fun ppf s -> Format.fprintf ppf "%S" s)) 
+        eprintf "Argv: @[%a@]@."
+          (Format.list "; " (fun ppf s -> fprintf ppf "%S" s)) 
             (Array.to_list argv)
-    | Top None -> Format.eprintf "Top None@."
+    | Top None -> eprintf "Top None@."
     | Top (Some str) -> 
-        Format.eprintf "@[<2>Top@ %a@]@."
+        eprintf "@[<2>Top@ %a@]@."
           format_structure str
-    | Annots _ -> Format.eprintf "Annots [...]@."
+    | Annots _ -> eprintf "Annots [...]@."
 
   let dump_elems elems = List.iter dump_elem elems
 end

File ocamlspot/tests/Makefile

 
 .PHONY: clean install installopt beforedepend depend
 
+ocamlspot:
+	ln -s ../ocamlspot ocamlspot
+
 include .depend

File ocamlspot/typeexpand.ml

+(***********************************************************************)
+(*                                                                     *)
+(*                            ocamlspotter                             *)
+(*                                                                     *)
+(*                             Jun FURUSE                              *)
+(*                                                                     *)
+(*   Copyright 2008, 2009 Jun Furuse. All rights reserved.             *)
+(*   This file is distributed under the terms of the GNU Library       *)
+(*   General Public License, with the special exception on linking     *)
+(*   described in file LICENSE.                                        *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* expansion(?) of expr/pattern by type *)
+
+open Asttypes
+open Types
+open Format
+open Utils
+
+type t =
+  | Function of (label * type_expr) list * type_expr
+  | Tuple of type_expr list
+  | Variant of (string * type_expr list) list
+  | Record of (string * type_expr) list
+  | Polyvar of (label * row_field) list
+  | Abstract
+
+let format_as_expr ppf = function
+  | Function (label_typ_list, _) ->
+      fprintf ppf "(fun @[%a@] -> assert false)"
+        (Format.list " " (fun ppf (l, _typ) -> 
+          if l = "" then fprintf ppf "_"
+          else fprintf ppf "%s" (if l.[0] = '?' then l else "~" ^ l)))
+        label_typ_list
+  | Tuple typs ->
+      fprintf ppf "(@[%a@])" (Format.list ", " (fun ppf _ -> fprintf ppf "_")) typs
+  | Variant args ->
+      fprintf ppf "assert false (* @[%a@] *)" 
+        (Format.list "| " (fun ppf -> 
+          function
+            | (name, []) -> fprintf ppf "%s" name
+            | (name, args) -> 
+                fprintf ppf "%s (@[%a@])"
+                  name
+                  (Format.list ", " (fun ppf _ -> fprintf ppf "assert false" )) args))
+        args
+  | Record label_typ_list -> 
+      fprintf ppf "{ @[%a@] }"
+        (Format.list "; " (fun ppf (l, _ty) ->
+          fprintf ppf "%s = assert false" l)) 
+        label_typ_list
+  | Polyvar l_field_list ->
+      fprintf ppf "assert false (* @[%a@] | ... *)" 
+        (Format.list "| " (fun ppf (name, row_field) -> 
+          match row_field with
+          | Rabsent | Rpresent None -> fprintf ppf "`%s" name
+          | Rpresent (Some _) -> fprintf ppf "`%s (assert false)" name
+          (* CR jfuruse: not sure... *)
+          | Reither (true, [], _, _) -> fprintf ppf "`%s" name
+          | Reither (true, _, _, _) -> fprintf ppf "`%s (assert false)" name
+          | Reither (false, _, true, { contents = None }) -> fprintf ppf "`%s" name
+          | Reither (false, _, true, { contents = Some _ }) -> fprintf ppf "`%s (assert false)" name
+          | Reither (false, _, false, _) -> fprintf ppf "`%s (* ??? *)" name))
+        l_field_list
+  | Abstract -> fprintf ppf "assert false (* abstract *)"
+
+let rec expand env typ = 
+  match (Ctype.repr typ).desc with
+  | Tarrow (label, typ_arg, typ_body, _) -> expand_arrow [label, typ_arg] typ_body
+  | Ttuple typs -> Tuple typs
+  | Tconstr (path, typs_param, _) ->
+      begin try 
+        let tdesc = Ctype.instance_declaration (Env.find_type path env) in
+        assert (List.length typs_param = tdesc.type_arity);
+        (* Should success *)
+        List.iter2 (Ctype.unify_var env) tdesc.type_params typs_param;
+        match tdesc.type_kind with
+        | Type_variant label_args -> Variant label_args
+        | Type_record (fields, _) -> 
+            Record (List.map (fun (name, _, ty) -> (name, ty)) fields)
+        | Type_abstract ->
+            match tdesc.type_manifest with
+            | None -> Abstract
+            | Some typ -> expand env typ
+      with
+      | Not_found -> Abstract (* pity *)
+      end
+  | Tvariant row_desc -> Polyvar row_desc.row_fields
+  | Tpoly (typ, _) -> expand env typ (* CR jfuruse: ? *)
+  | Tvar | Tnil | Tobject (_, _) | Tfield (_, _, _, _) | Tpackage _ -> Abstract
+  | Tlink _ -> assert false
+  | Tsubst _ -> assert false
+  | Tunivar -> assert false
+
+and expand_arrow st typ =
+  match (Ctype.repr typ).desc with
+  | Tarrow (label, typ_arg, typ_body, _) -> 
+      expand_arrow ((label, typ_arg) :: st) typ_body
+  | _ -> Function (List.rev st, typ)

File ocamlspot/typeexpand.mli

+(***********************************************************************)
+(*                                                                     *)
+(*                            ocamlspotter                             *)
+(*                                                                     *)
+(*                             Jun FURUSE                              *)
+(*                                                                     *)
+(*   Copyright 2008, 2009 Jun Furuse. All rights reserved.             *)
+(*   This file is distributed under the terms of the GNU Library       *)
+(*   General Public License, with the special exception on linking     *)
+(*   described in file LICENSE.                                        *)
+(*                                                                     *)
+(***********************************************************************)
+
+(* expansion(?) of expr/pattern by type *)
+
+open Asttypes
+open Types
+
+type t 
+
+val expand : Env.t -> type_expr -> t
+
+val format_as_expr : Format.formatter -> t -> unit

File ocamlspot/utils.ml

 (*                                                                     *)
 (***********************************************************************)
 
+open Format
+
 module List = struct
   include List
 
 *)
 
   let format fmt = 
-    if !on then Format.eprintf fmt
+    if !on then eprintf fmt
     else Format.ifprintf Format.err_formatter fmt
 end
 
 	  (list sep f) xs
 
   let option f ppf = function
-    | None -> Format.fprintf ppf "None"
-    | Some v -> Format.fprintf ppf "Some(%a)" f v 
+    | None -> fprintf ppf "None"
+    | Some v -> fprintf ppf "Some(%a)" f v 
 
   let lazy_ p ppf v =
     if Lazy.is_val v then p ppf (Lazy.Open.(!!) v)
-    else Format.fprintf ppf "lazy"
+    else fprintf ppf "lazy"
 end
 
 module Option = struct

File typing/spot.ml

 
 let magic_number = "OCamlSpot"
 let ocaml_version = "3.12.1"
-let version = "1.3.0"
+let version = "1.4.0"
 
 module Location_bound = struct
   open Location
 
   (* CR jfuruse: types may be incompatible between compiler versions *)
   type module_expr = 
-    | Mod_ident of Path.t (* module M = N *)
-    | Mod_packed of string (* full path *)
+    | Mod_ident      of Path.t (* module M = N *)
+    | Mod_packed     of string (* full path *)
         (* -pack overrides load paths: ocamlc -pack dir1/dir2/dir3/x.cmo *)
-    | Mod_structure of structure (* module M = struct ... end *)
-    | Mod_functor of Ident.t * Types.module_type * module_expr (* module M(I:S) = *)
-    | Mod_apply of module_expr * module_expr (* module M = N(O) *)
+    | Mod_structure  of structure (* module M = struct ... end *)
+    | Mod_functor    of Ident.t * Types.module_type * module_expr (* module M(I:S) = *)
+    | Mod_apply      of module_expr * module_expr (* module M = N(O) *)
     | Mod_constraint of module_expr * Types.module_type
-    | Mod_unpack of module_expr
+    | Mod_unpack     of module_expr
     | Mod_abstract (* used for Tmodtype_abstract *)
 
   (* structure abstraction : name - defloc asoc list *)
      same name *) 
 
   and structure_item = 
-    | Str_value of Ident.t
-    | Str_type of Ident.t
+    | Str_value     of Ident.t
+    | Str_type      of Ident.t
     | Str_exception of Ident.t
-    | Str_module of Ident.t * module_expr
-    | Str_modtype of Ident.t * module_expr
-    | Str_class of Ident.t
-    | Str_cltype of Ident.t
-    | Str_include of module_expr * (Kind.t * Ident.t) list
+    | Str_module    of Ident.t * module_expr
+    | Str_modtype   of Ident.t * module_expr
+    | Str_class     of Ident.t
+    | Str_cltype    of Ident.t
+    | Str_include   of module_expr * (Kind.t * Ident.t) list
 
   module Module_expr = struct
     (* cache key is Typedtree.module_expr *)
       let equal s1 s2 =
 	match s1, s2 with
 	| Str_value id1, Str_value id2 
-	| Str_type id1, Str_type id2 
+	| Str_type id1, Str_type id2
 	| Str_exception id1, Str_exception id2
 	| Str_class id1, Str_class id2
 	| Str_cltype id1, Str_cltype id2 -> id1 = id2
   let included_sig_identifier_table = Hashtbl.create 31
 
   let kident_of_sigitem = function
-    | Tsig_value (id, _) -> Kind.Value, id
+    | Tsig_value (id, _)     -> Kind.Value, id
     | Tsig_exception (id, _) -> Kind.Exception, id
-    | Tsig_module (id, _, _) ->  Kind.Module, id
-    | Tsig_class (id, _, _) -> Kind.Class, id
-    | Tsig_type (id, _, _) -> Kind.Type, id
-    | Tsig_modtype (id, _) -> Kind.Module_type, id
+    | Tsig_module (id, _, _) -> Kind.Module, id
+    | Tsig_class (id, _, _)  -> Kind.Class, id
+    | Tsig_type (id, _, _)   -> Kind.Type, id
+    | Tsig_modtype (id, _)   -> Kind.Module_type, id
     | Tsig_cltype (id, _, _) -> Kind.Class_type, id
 
   let rec module_expr mexp =
 	List.map (fun id -> Str_value id) (let_bound_idents pat_exps)
     | Tstr_primitive (id, _vdesc) -> 
 	[Str_value id]
-    | Tstr_type (id_descs) -> 
-	List.map (fun (id, _) -> Str_type id) id_descs 
+    | Tstr_type id_descs -> List.map (fun (id, _) -> Str_type id) id_descs
     | Tstr_exception (id ,_) ->
 	[Str_exception id]
     | Tstr_exn_rebind (id, _path) -> (* CR jfuruse: path? *)
 	
   and signature_item_sub = function
     | Tsig_value (id, _) -> Str_value id
-    | Tsig_type (id, _, _) -> Str_type id
+    | Tsig_type (id, _tdesc, _) -> Str_type id
     | Tsig_exception (id, _) -> Str_exception id
     | Tsig_module (id, mty , _) -> Str_module (id, module_type mty)
     | Tsig_modtype (id, mty_decl) -> (* todo *) Str_modtype (id, modtype_declaration mty_decl)
     
 module Annot = struct
   type t =
-    | Type of Types.type_expr (* sub-expression's type *)
+    | Type of Types.type_expr * Env.t (* sub-expression's type *)
     | Str of Abstraction.structure_item 
     | Use of Kind.t * Path.t
     | Module of Abstraction.module_expr
 
   let equal t1 t2 =
     match t1, t2 with
-    | Type t1, Type t2 -> t1 == t2
+    | Type (t1, _), Type (t2, _) -> t1 == t2
     | Mod_type mty1, Mod_type mty2 -> mty1 == mty2
     | Str sitem1, Str sitem2 -> Abstraction.Structure_item.equal sitem1 sitem2
     | Module mexp1, Module mexp2 -> mexp1 == mexp2

File typing/spot.mli

 
   (* module definition abstraction *)
   type module_expr = (* private *)
-    | Mod_ident of Path.t (* module M = N *)
-    | Mod_packed of string (* full path *)
+    | Mod_ident      of Path.t (* module M = N *)
+    | Mod_packed     of string (* full path *)
         (* -pack overrides load paths: ocamlc -pack dir1/dir2/dir3/x.cmo *)
-    | Mod_structure of structure (* module M = struct ... end *)
-    | Mod_functor of Ident.t * Types.module_type * module_expr (* module M(I:S) = *)
-    | Mod_apply of module_expr * module_expr (* module M = N(O) *)
+    | Mod_structure  of structure (* module M = struct ... end *)
+    | Mod_functor    of Ident.t * Types.module_type * module_expr (* module M(I:S) = *)
+    | Mod_apply      of module_expr * module_expr (* module M = N(O) *)
     | Mod_constraint of module_expr * Types.module_type
-    | Mod_unpack of module_expr
+    | Mod_unpack     of module_expr
     | Mod_abstract (* used for Tmodtype_abstract *)
 
   (* structure abstraction : name - defloc asoc list *)
   and structure = structure_item list
 
   and structure_item = 
-    | Str_value of Ident.t
-    | Str_type of Ident.t
+    | Str_value     of Ident.t
+    | Str_type      of Ident.t
     | Str_exception of Ident.t
-    | Str_module of Ident.t * module_expr
-    | Str_modtype of Ident.t * module_expr
-    | Str_class of Ident.t
-    | Str_cltype of Ident.t
-    | Str_include of module_expr * (Kind.t * Ident.t) list
+    | Str_module    of Ident.t * module_expr
+    | Str_modtype   of Ident.t * module_expr
+    | Str_class     of Ident.t
+    | Str_cltype    of Ident.t
+    | Str_include   of module_expr * (Kind.t * Ident.t) list
 
 end
 
 module Annot : sig
   type t =
-    | Type of Types.type_expr (* sub-expression's type *)
+    | Type of Types.type_expr * Env.t (* sub-expression's type *)
     | Str of Abstraction.structure_item 
     | Use of Kind.t * Path.t
     | Module of Abstraction.module_expr

File typing/typecore.ml

 (***********************************************************************)
 (*                                                                     *)
-(*                           Objective Caml                            *)
+(*                           objective Caml                            *)
 (*                                                                     *)
 (*            Xavier Leroy, projet Cristal, INRIA Rocquencourt         *)
 (*                                                                     *)
 *)
 let re node =
   Stypes.record (Stypes.Ti_expr node);
-  Spot.Annot.record node.exp_loc (Spot.Annot.Type node.exp_type);
+  Spot.Annot.record node.exp_loc (Spot.Annot.Type (node.exp_type, node.exp_env));
   node
 ;;
 let rp node =
   Stypes.record (Stypes.Ti_pat node);
-  Spot.Annot.record node.pat_loc (Spot.Annot.Type node.pat_type);
+  Spot.Annot.record node.pat_loc (Spot.Annot.Type (node.pat_type, node.pat_env));
   node
 ;;
 

File typing/typemod.ml

             Spot.Annot.record item.psig_loc
               (Spot.Annot.Str (Spot.Abstraction.Str_value id));
             Spot.Annot.record item.psig_loc
-              (Spot.Annot.Type desc.val_type);
+              (Spot.Annot.Type (desc.val_type, env));
 	    (* CR jfuruse : or, (Spot.Annot.Use (Spot.Kind.Value, ...)) ?? *) 
             let rem = transl_sig newenv srem in
             if List.exists (Ident.equal id) (get_values rem) then rem
             (* CR jfuruse: dup code at type_structure *)
             (* Sometimes, [List.length sdecls <> List.length decls] due to
                introductions of [t#row]. *)
-            List.iter (fun (id, _decl) ->
+            List.iter (fun (id, decl) ->
               try
                 let sdecl = List.assoc (Ident.name id) sdecls in
 	        let loc = sdecl.Parsetree.ptype_loc in
           enrich_type_decls anchor decls env newenv in
         (* Sometimes, [List.length sdecls <> List.length decls] due to
            introductions of [t#row]. *)
-        List.iter (fun (id, _decl) ->
+        List.iter (fun (id, decl) ->
           try
             let sdecl = List.assoc (Ident.name id) sdecls in
 	    let loc = sdecl.Parsetree.ptype_loc in