[stags] support for ocaml code

Summary:
Another wrapper around graph_code, this time not to generate a prolog
DB but to generate an emacs (or vi) TAGS file.

Test Plan:
$ cd ~/pfff; make tags
then under emacs
M-x List. TAB
list all the functions in list.ml and selecting one jump to the right place.

Reviewers: pieter

Reviewed By: pieter

CC: julienv, mathieubaudet, platform-diffs@lists, erling

Differential Revision: https://phabricator.fb.com/D653086

Makefile

@@ -638,7 +638,7 @@ website:
 .PHONY:: tags db graph visual layers   tests test
 
 tags:
-	./stags -verbose -lang ml .
+	./stags -lang cmt .
 db:
 	./pfff_db -verbose  -lang ml -o DB_LIGHT.marshall .
 graph:

h_program-lang/Makefile

@@ -14,7 +14,7 @@ SRC= programming_language.ml \
      refactoring_code.ml \
      layer_code.ml database_code.ml \
      graph_code.ml graph_code_opti.ml dependencies_matrix_code.ml \
-     graph_code_prolog.ml tags_file.ml \
+     graph_code_prolog.ml tags_file.ml graph_code_tags.ml \
      statistics_code.ml statistics_parsing.ml layer_parse_errors.ml \
      coverage_code.ml layer_coverage.ml \
      overlay_code.ml big_grep.ml pleac.ml info_code.ml \

h_program-lang/graph_code_tags.ml

@@ -0,0 +1,101 @@
+(* Yoann Padioleau
+ *
+ * Copyright (C) 2012 Facebook
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public License
+ * version 2.1 as published by the Free Software Foundation, with the
+ * special exception on linking described in file license.txt.
+ * 
+ * This library is distributed in the hope that it will be useful, but
+ * WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
+ * license.txt for more details.
+ *)
+open Common
+
+module G = Graph_code
+module E = Database_code
+
+(*****************************************************************************)
+(* Prelude *)
+(*****************************************************************************)
+(* Generating a set of TAGS from a graph_code.
+ * 
+ * alternatives:
+ *  - could start from the prolog facts (themselves generated from graph_code)
+ *    to factorize some code, but for TAGS we are only interested
+ *    in position and the only predicate that matters, at/3, does not 
+ *    actually contain enough information such as the byte offset in the file,
+ *    so let's copy paste for now.
+ *)
+
+(*****************************************************************************)
+(* Helpers *)
+(*****************************************************************************)
+
+(*****************************************************************************)
+(* Main entry point *)
+(*****************************************************************************)
+
+(* quite similar to graph_code_prolog *)
+let defs_of_graph_code ?(verbose=false) g =
+
+  (* we use the multi-values-to-same-key property of Hashtbl.add and
+   * Hashtbl.find_all
+   *)
+  let hfile_to_tags = Hashtbl.create 101 in
+
+  let hmemo_file_array = Hashtbl.create 101 in
+
+
+  g +> G.iter_nodes (fun n ->
+    let (str, kind) = n in
+    (try 
+      let nodeinfo = G.nodeinfo n g in
+      let file = nodeinfo.G.pos.Parse_info.file in
+      let line = nodeinfo.G.pos.Parse_info.line in
+      let text = 
+        try 
+          let array = Common.memoized hmemo_file_array file (fun () ->
+            Common.cat_array file
+          )
+          in
+          (* not sure why, but can't put an empty string for 
+           * tag_definition_text; Emacs is then getting really confused
+           *)
+          array.(line)
+        with
+        | Invalid_argument _out_of_bound ->
+          pr2 (spf "PB accessing line %d of %s" line file);
+          ""
+        | Sys_error _no_such_file ->
+          pr2 (spf "PB accessing file %s" file);
+          ""
+      in
+      let tag = { Tags_file.
+         tagname = str;
+         line_number = nodeinfo.G.pos.Parse_info.line;
+         byte_offset = nodeinfo.G.pos.Parse_info.charpos;
+         kind = kind;
+         tag_definition_text = text;
+      }
+      in
+      Hashtbl.add hfile_to_tags file tag;
+      (* when add a tag for List.foo, also add foo.List *)
+      let reversed_tagname = 
+        Common.split "\\." str +> List.rev +> Common.join "." in
+      Hashtbl.add hfile_to_tags file 
+        { tag with Tags_file.tagname = reversed_tagname }
+
+    with Not_found -> ()
+    )
+  );
+  Common.hkeys hfile_to_tags +> List.map (fun file ->
+    file, 
+    Hashtbl.find_all hfile_to_tags file 
+    +> List.map (fun tag -> tag.Tags_file.byte_offset, tag)
+    +> Common.sort_by_key_lowfirst
+    +> List.map snd
+  )
+

h_program-lang/graph_code_tags.mli

@@ -0,0 +1,5 @@
+
+val defs_of_graph_code:
+  ?verbose:bool ->
+  Graph_code.graph ->
+  (Common.filename * Tags_file.tag list) list

lang_ml/analyze/graph_code_cmt.ml

@@ -149,14 +149,14 @@ let add_node_and_edge_if_defs_mode ?(dupe_ok=false) env name_node loc =
     else begin
       env.g +> G.add_node node;
       env.g +> G.add_edge (env.current, node) G.Has;
-      let (_file, line, char) = Location.get_pos_info 
-        loc.Asttypes.loc.Location.loc_start in
+      let lexing_pos = loc.Asttypes.loc.Location.loc_start in
       let file = env.source_file in
       let nodeinfo = { Graph_code.
          pos = { Parse_info.
             str ="";
-            charpos = char;
-            line; column = 0;
+            line = lexing_pos.Lexing.pos_lnum; 
+            charpos = lexing_pos.Lexing.pos_cnum;
+            column = lexing_pos.Lexing.pos_cnum - lexing_pos.Lexing.pos_bol;
             file;
          };
          props = [];
@@ -964,7 +964,7 @@ and
 (* Main entry point *)
 (*****************************************************************************)
 
-let build ?(verbose=true) dir_or_file skip_list =
+let build ?(verbose=false) dir_or_file skip_list =
   let root = Common.realpath dir_or_file in
   let all_files = Lib_parsing_ml.find_cmt_files_of_dir_or_files [root] in
 

main_stags.ml

@@ -91,6 +91,14 @@ let rec defs_of_files_or_dirs lang xs =
       | [x] -> Tags_java.defs_of_dir_or_file ~verbose x skip_list
       | _ -> failwith "the java option accept only a single dir or file"
       )
+  | "cmt" ->
+      (match xs with
+      | [root] -> 
+          let g = Graph_code_cmt.build root skip_list in
+          Graph_code_tags.defs_of_graph_code ~verbose g
+
+      | _ -> failwith "the cmt option accept only a single dir or file"
+      )
 
   | _ -> failwith ("language not supported: " ^ lang)