Commits

Anonymous committed 0011c1e

version number + data type names

  • Participants
  • Parent commits 58b2199
  • Branches default

Comments (0)

Files changed (9)

boot/ocamlc

Binary file modified.

ocamlspot/Changes

+beta3
+-----
+
+Clean-ups:
+- Annotation data type simplification
+
+Features:
+- Spot file version number is introduced
+- New browsables: data type names to their type defs
+
+beta2p1
+-------
+
+Features:
+- New browsables: variants and record labels to their type defs
+
 beta2:
 ------
 

ocamlspot/ocamlspot.ml

 
 (* CRv2 jfuruse: lazy patterns... Not yet probably, it is too new. *)
 
+let version = "1.0beta3"
+
 module Ident0 = Ident
 module Path0 = Path
 
 module Spot = struct
 
   let magic_number = Spot.magic_number
-  let version = Spot.version
+  let version_major = Spot.version_major
+  let version_minor = Spot.version_minor
 
   module Abstraction = struct
     include Spot.Abstraction
 	  Format.fprintf Format.str_formatter "Type: %a"
 	    Printtyp.type_sch typ;
 	  Format.flush_str_formatter ()
-      | Value_def id ->
-	  Printf.sprintf "Value_def: %s" (Ident.name id)
-      | Value_use path ->
-	  Printf.sprintf "Value_use: %s" (Path.name path)
+      | Ident_def id ->
+	  Printf.sprintf "Ident_def: %s" (Ident.name id)
+      | Ident_use path ->
+	  Printf.sprintf "Ident_use: %s" (Path.name path)
       | Module _todo ->
 	  Printf.sprintf "Module: (NOT_IMPLEMENTED)" 
       | Module_def (id, _) ->
 		   (Ident.name (Types.id_of_signature_item item1))
 		   (Ident.name (Types.id_of_signature_item item2))) 
 		  sigitems_out sigitems_in))
-      | Type_def id ->
-	  Printf.sprintf "Type_def: %s" 
-	    (Ident.name id)
-      | Constr_use path ->
-	  Printf.sprintf "Constr_use: %s" (Path.name path)
       | Include (_, (Types.Tmty_functor _ | Types.Tmty_ident _)) -> "NOT_IMPLEMENTED"
   end 
 
   module LAnnot = struct
     type t = Location.t * Spot.Annot.t
     let compare (l1,_) (l2,_) = Location.compare l1 l2
-    let point pos = Location.point pos, Annot.Value_def (Ident.create_persistent "dummy") (* dummy annot *)
+    let point pos = Location.point pos, Annot.Ident_def (Ident.create_persistent "dummy") (* dummy annot *)
     let to_string (l,annot) =
       Printf.sprintf "%s:%s" 
 	(Location.to_string l) (Annot.to_string annot) 
       path : string; (* "" means no source *)
       cwd : string;
       load_paths : string list;
-      version : string;
+      version : int * int;
       argv : string array;
       implementation : Abstraction.structure;
       tree : Tree.t;
     }
 
     let dump_file file =
-      Format.eprintf "@[<2>{ path= %S;@ cwd= %S;@ load_paths= [ @[%a@] ];@ version= %s;@ argv= [| @[%a@] |]; ... }@]@."
+      Format.eprintf "@[<2>{ path= %S;@ cwd= %S;@ load_paths= [ @[%a@] ];@ version= %d.%d;@ argv= [| @[%a@] |]; ... }@]@."
         (match file.path with 
         | "" -> "NONE"
         | s -> s)
 	file.cwd
         (Format.list "; " (fun ppf s -> Format.fprintf ppf "%S" s)) file.load_paths
-        file.version
+        (fst file.version) (snd file.version)
 	(Format.list "; " (fun ppf s -> Format.fprintf ppf "%S" s)) (Array.to_list file.argv)
 
     (* xxx.ext => xxx.spot *)        
 	really_input ic buffer 0 (String.length magic_number);
 	if buffer <> magic_number then 
 	  failwith (Printf.sprintf "Error: Not a spot file: %s" file);
+	let file_version_major = input_binary_int ic in
+	let file_version_minor = input_binary_int ic in
+	if Spot.version_major <> file_version_major ||
+	   Spot.version_minor < file_version_minor then begin
+	     failwith (Printf.sprintf "Error: Incompatible spot file version %d.%d" file_version_major file_version_minor);
+	   end;
         let v = input_value ic in
         close_in ic;
-        (v : Spot.File.t)
+        (file_version_major, file_version_minor), (v : Spot.File.t)
 
       let load_directly path : file =
         Debug.format "spot loading from %s@." path;
-        let file = load_spot_file path in
-        let version = 
-	  match List.find_map_opt (function Version v -> Some v | _ -> None) file with
-	  | Some version -> version
-	  | None -> failwith "no version found"
-        in
+        let version, file = load_spot_file path in
         let annots = 
 	  match List.find_map_opt (function Annots v -> Some v | _ -> None) file with 
 	  | Some annots -> annots
 	  let tbl = Hashtbl.create 107 in
 	  List.iter (fun (loc, annot) ->
 	    match annot with
-	    | Annot.Value_def id
-	    | Annot.Module_def (id, _)
-	    | Annot.Type_def id -> Hashtbl.add tbl id loc
+	    | Annot.Ident_def id
+	    | Annot.Module_def (id, _) -> Hashtbl.add tbl id loc
 	    | _ -> ()) annots;
 	  tbl
         in
-        { path = source_path;
+        { version = version;
+	  path = source_path;
           cwd = cwd;
 	  load_paths = List.map (fun load_path -> cwd ^/ load_path) load_paths;
-	  version = version;
 	  argv = argv;
 	  implementation = implementation;
 	  tree = tree;
     let _ = Eval.str_of_packed := str_of_packed
 
     let dump_elem = function
-      | Version s -> Format.eprintf "Version: %s@." s
       | 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 
       match !path_pos with
       | Some _ -> failwith "you can specify only one path:charpos"
       | None -> path_pos := Some s)
-    "ocamlspot path:charpos";
+    (Printf.sprintf 
+       "ocamlspot path:charpos\nversion %s (spot file version %d.%d)"
+       version
+       Spot.version_major
+       Spot.version_minor);
 
   let dump_file = !dump_file in
   let dump_impl = !dump_impl in
 	  (String.concat "\n" 
 	    (List.map Spot.Annot.to_string annots));
 	List.iter (function
-	  | Spot.Annot.Value_use path 
-	  | Spot.Annot.Constr_use path 
+	  | Spot.Annot.Ident_use path 
 	  | Spot.Annot.Module (Spot.Abstraction.Mod_ident path) ->
 	      begin try 
 		  let pident, loc = Spot.File.find_path file path in

ocamlspot/tests/test13.ml

 
 let _ = x.y
 
+let _ = fun (x : t) -> x
+
    Annotations are stored in .spot with their locations
 *)
 
-let version = "1.0beta2p1"
+let version_major = 1
+let version_minor = 0
 let magic_number = "OCamlSpot"
 
 module Abstraction = struct
 module Annot = struct
   type 'a raw =
     | Type of Types.type_expr (* sub-expression's type *)
-    | Value_def of Ident.t
-    | Value_use of Path.t
+    | Ident_def of Ident.t
+    | Ident_use of Path.t
     | Module of 'a
     | Module_def of Ident.t * 'a
     | Include of Types.signature * Types.module_type
-    | Type_def of Ident.t
-    | Constr_use of Path.t
 (*
     | Type_scheme of Types.type_expr (* pattern variable's type scheme *)
     | Module_type of Types.module_type (* module's type *)
       loc, 
       match v with
       | Type t -> Type t
-      | Value_def id -> Value_def id
-      | Value_use p -> Value_use p
+      | Ident_def id -> Ident_def id
+      | Ident_use p -> Ident_use p
       | Module m ->
 	  Module (Abstraction.abstract_module_expr m)
       | Module_def (id, m) -> 
 	  Module_def (id, Abstraction.abstract_module_expr m)
-      | Include (sg, mty) -> Include (sg, mty)
-      | Type_def id -> Type_def id
-      | Constr_use p -> Constr_use p) !recorded
+      | Include (sg, mty) -> Include (sg, mty)) !recorded
 
 end
 
 module File = struct
   (* not record but list for future exetensibility *)
   type elem =
-    | Version of string
     | Argv of string array
     | Source_path of string option (* packed module has None *)
     | Cwd of string
     | Load_paths of string list
     | Implementation of Abstraction.structure option
     | Annots of (Location.t * Annot.t) list
-(*
-    | Compile_option of string list
-*)
     (* add things here at the end for future extension *)
 
   (* marshalled type *)
       | Some p -> Some (Filename.concat (Sys.getcwd ()) p)
     in
     output_string oc magic_number;
+    output_binary_int oc version_major;
+    output_binary_int oc version_minor;
     Marshal.to_channel oc 
-      [ Version version;
-	Argv Sys.argv;
+      [ Argv Sys.argv;
 	Source_path source;
         Cwd (Sys.getcwd ());
 	Load_paths !Config.load_path;
    Annotations are stored in .spot with their locations
 *)
 
-val version : string
+(* version numbers 
+   spot files can be read by ocamlspotter with the same major version and
+   the same or greater minor version of them.
+ *)
+val version_major : int
+val version_minor : int
+
 val magic_number : string
 
 module Abstraction : sig
 module Annot : sig
   type 'a raw =
     | Type of Types.type_expr (* sub-expression's type *)
-    | Value_def of Ident.t (* defined *)
-    | Value_use of Path.t
+    | Ident_def of Ident.t (* defined *)
+    | Ident_use of Path.t
     | Module of 'a
     | Module_def of Ident.t * 'a
     | Include of Types.signature * Types.module_type
-    | Type_def of Ident.t
-    | Constr_use of Path.t
 (*
     | Type_scheme of Types.type_expr (* pattern variable's type scheme *)
     | Module_type of Types.module_type (* module's type *)
 module File : sig
   (* not record but list for future exetensibility *)
   type elem =
-    | Version of string
     | Argv of string array
     | Source_path of string option
     | Cwd of string

typing/typecore.ml

   then raise(Error(loc, Multiply_bound_variable name));
   let id = Ident.create name in
   pattern_variables := (id, ty, loc) :: !pattern_variables;
-  Spot.Annot.record loc (Spot.Annot.Value_def id);
+  Spot.Annot.record loc (Spot.Annot.Ident_def id);
   begin match !pattern_scope with
   | None -> ()
   | Some s -> 
         with Not_found ->
           raise(Error(sp.ppat_loc, Unbound_constructor lid)) in
       Spot.Annot.record sp.ppat_loc 
-	(Spot.Annot.Constr_use (Spot.path_of_constr_type constr.cstr_res));
+	(Spot.Annot.Ident_use (Spot.path_of_constr_type constr.cstr_res));
       let sargs =
         match sarg with
           None -> []
       in
       let desc =Tpat_record(type_label_a_list type_label_pat lid_sp_list) in
       Spot.Annot.record sp.ppat_loc 
-	(Spot.Annot.Constr_use (Spot.path_of_constr_type ty));
+	(Spot.Annot.Ident_use (Spot.path_of_constr_type ty));
       rp {
         pat_desc = desc;
         pat_loc = sp.ppat_loc;
           with _ -> ()
         end;
         let (path, desc) = Env.lookup_value lid env in
-	Spot.Annot.record sexp.pexp_loc (Spot.Annot.Value_use path);
+	Spot.Annot.record sexp.pexp_loc (Spot.Annot.Ident_use path);
         re {
           exp_desc =
             begin match desc.val_kind with
         (label, {arg with exp_type = instance arg.exp_type}) in
       let lbl_exp_list = type_label_a_list type_label_exp lid_sexp_list in
       Spot.Annot.record sexp.pexp_loc 
-	(Spot.Annot.Constr_use (Spot.path_of_constr_type ty));
+	(Spot.Annot.Ident_use (Spot.path_of_constr_type ty));
       let rec check_duplicates seen_pos lid_sexp lbl_exp =
         match (lid_sexp, lbl_exp) with
           ((lid, _) :: rem1, (lbl, _) :: rem2) ->
         with Not_found ->
           raise(Error(sexp.pexp_loc, Unbound_label lid)) in
       Spot.Annot.record sexp.pexp_loc 
-	(Spot.Annot.Constr_use (Spot.path_of_constr_type label.lbl_res));
+	(Spot.Annot.Ident_use (Spot.path_of_constr_type label.lbl_res));
       let (_, ty_arg, ty_res) = instance_label false label in
       unify_exp env arg ty_res;
       re {
     with Not_found ->
       raise(Error(loc, Unbound_constructor lid)) in
   Spot.Annot.record loc 
-    (Spot.Annot.Constr_use (Spot.path_of_constr_type constr.cstr_res));
+    (Spot.Annot.Ident_use (Spot.path_of_constr_type constr.cstr_res));
   let sargs =
     match sarg with
       None -> []

typing/typemod.ml

     | {pstr_desc = Pstr_primitive(name, sdesc); pstr_loc = loc} :: srem ->
         let desc = Typedecl.transl_value_decl env sdesc in
         let (id, newenv) = Env.enter_value name desc env in
-	Spot.Annot.record loc (Spot.Annot.Value_def id);
+	Spot.Annot.record loc (Spot.Annot.Ident_def id);
         let (str_rem, sig_rem, final_env) = type_struct newenv srem in
         (Tstr_primitive(id, desc) :: str_rem,
          Tsig_value(id, desc) :: sig_rem,
           enrich_type_decls anchor decls env newenv in
 	List.iter2 (fun (_, sdecl) (id, _decl) ->
 	  let loc = sdecl.Parsetree.ptype_loc in
-	  Spot.Annot.record loc (Spot.Annot.Type_def id)) sdecls decls;
+	  Spot.Annot.record loc (Spot.Annot.Ident_def id)) sdecls decls;
         let (str_rem, sig_rem, final_env) = type_struct newenv' srem in
         (Tstr_type decls :: str_rem,
          map_rec' (fun rs (id, info) -> Tsig_type(id, info, rs)) decls sig_rem,

typing/typetexp.ml

           Env.lookup_type lid env
         with Not_found ->
           raise(Error(styp.ptyp_loc, Unbound_type_constructor lid)) in
+      Spot.Annot.record styp.ptyp_loc (Spot.Annot.Ident_use path);
       if List.length stl <> decl.type_arity then
         raise(Error(styp.ptyp_loc, Type_arity_mismatch(lid, decl.type_arity,
                                                            List.length stl)));