Source file archi_code_parse.ml

(* Yoann Padioleau
 *
 * Copyright (C) 2010 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

open Archi_code

(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(* 
 * The "inference" of the architecture category from a filename
 * used to be slow. The "parser" used to be a 'match' with a long series
 * of '_ when f =~ ...' but it was getting really slow when
 * applied on thousands of filenames. Then we provided a fast-path
 * for files that do not match any category, but it was still slow
 * when most of the files had a category (for instance because
 * most of the files in a project are under something like lib/ or intern/).
 * Then we used ocamllex and that was fine! 
 * 
 * Current stat of -profile on codemap.opt ~/www:
 *  Archi.source_of_filename                 :      1.690 sec     112755 count
 *)

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

let (==~) = Common2.(==~)

let re_c_yaccfile = Str.regexp "\\(.*\\).tab"

(* coupling: don't forget to extend re_auto_generated below too *)
let is_auto_generated file =
  let (d,b,e) = Common2.dbe_of_filename_noext_ok file in
  match e with
  | "ml"->
      Sys.file_exists (Common2.filename_of_dbe (d,b, "mll")) || 
      Sys.file_exists (Common2.filename_of_dbe (d,b, "mly")) ||
      Sys.file_exists (Common2.filename_of_dbe (d,b, "mlb"))

  | "mli" ->
      Sys.file_exists (Common2.filename_of_dbe (d,b, "mly"))

  | "tex" ->
      Sys.file_exists (Common2.filename_of_dbe (d,b ^ ".tex", "nw"))

  | "info" ->
      Sys.file_exists (Common2.filename_of_dbe (d,b, "texi"))

  (* Makefile.in *)
  | "in" ->
      Sys.file_exists (Common2.filename_of_dbe (d,b, "am"))

  | "c" ->
      b =$= "y.tab" ||
      Sys.file_exists (Common2.filename_of_dbe (d,b, "y")) ||
      Sys.file_exists (Common2.filename_of_dbe (d,b, "l")) ||
      (* bigloo (hmm but then conflict with s9 that have s9.c and s9.scm *)
      (* Sys.file_exists (Common2.filename_of_dbe (d,b, "scm")) || *)
      (if  b ==~ re_c_yaccfile
      then 
        let b' = Common.matched1 b in
        Sys.file_exists (Common2.filename_of_dbe (d,b', "y"))
      else false
      )
 
  | _ when b = "Makefile" && e = "NOEXT" ->
      Sys.file_exists (Common2.filename_of_dbe (d,b, "am")) ||
      Sys.file_exists (Common2.filename_of_dbe (d,b, "in")) ||
      Sys.file_exists (Common2.filename_of_dbe (d,"Imakefile", ""))

  | _ -> false

(* opti: for some fastpath *)
let re_auto_generated = Str.regexp
  "\\(.*\\.\\(ml\\|mli\\|tex\\|info\\|in\\|c\\)\\)\\|.*Makefile"

(*****************************************************************************)
(* Filename->archi *)
(*****************************************************************************)

let _hmemo_categ_dir = Hashtbl.create 101 

(* Why taking the root ? Because if the data are in /tmp/data/soft/... then
 * you would get the rule for tmp and data :( should not consider
 * directories too far away.
 * Why not passing a readable path then? Because most of the functions
 * in common expect full path, and also because I use file operations
 * like Sys.file_exists in is_auto_generated() which is used by this
 * function.
 *)
let source_archi_of_filename3 ~root file = 

  let base = Filename.basename file in
  let f = Common.readable ~root file in

  if base ==~ re_auto_generated && is_auto_generated file
  then AutoGenerated
  else
    let b = "/" ^ String.lowercase_ascii base ^ "/" in
    (* we try to give the most specialized category by first considering
     * the extension of the file, then its basename, and then its
     * directory component starting from the last one (hence the List.rev)
     *)
    let lexbuf = Lexing.from_string b in
    let categ1 = Archi_code_lexer.category lexbuf in
    
    let d = Filename.dirname f in
    (* try the directory, caching the result.
     *
     * note: should perhaps put (root, d) as the key for the memoized call
     * because when we start from a nested dir and go up, 
     * the root has changed and so what was considered Regular
     * could not be considered Intern. But then
     * when we click to go down, we can't reuse the cached
     * archi and the color may actually change which can be confusing.
     * 
     *)
    let categ2 =
      Common.memoized _hmemo_categ_dir d (fun () ->
        
        let d = String.lowercase_ascii d in
        
        let xs = Common.split "/" d in
        let xs = List.rev xs in
        let str = "/" ^ Common.join "/" xs ^ "/" in
        
        let lexbuf = Lexing.from_string str in
        Archi_code_lexer.category lexbuf
      )
    in
    (match categ1, categ2 with
    | _, (Data | AutoGenerated | ThirdParty | Ffi | Legacy) -> categ2
    | Regular, _x -> categ2
    | _, _ -> categ1
    )


let source_archi_of_filename ~root f = 
  Common.profile_code "Archi.source_of_filename" (fun () ->
    source_archi_of_filename3 ~root f)