153 lines
5.4 KiB
OCaml
153 lines
5.4 KiB
OCaml
(* 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 = "/" ^ Common2.lowercase 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 = Common2.lowercase 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)
|