(* * Copyright (c) 2016 - present Facebook, Inc. * All rights reserved. * * This source code is licensed under the BSD style license found in the * LICENSE file in the root directory of this source tree. An additional grant * of patent rights can be found in the PATENTS file in the same directory. *) open! Utils let count_newlines (path: string): int = let open! Core.Std in let f file = In_channel.fold_lines file ~init:0 ~f:(fun i _ -> i + 1) in In_channel.with_file path ~f type t = | Absolute of string | RelativeProjectRoot of string (* relative to project root *) | RelativeInferModel of string (* relative to infer models *) [@@deriving compare] let equal sf1 sf2 = compare sf1 sf2 = 0 module OrderedSourceFile = struct (* Don't use nonrec due to https://github.com/janestreet/ppx_compare/issues/2 *) type _t = t [@@deriving compare] type t = _t [@@deriving compare] end module Map = Map.Make(OrderedSourceFile) module Set = Set.Make(OrderedSourceFile) let rel_path_from_abs_path root fname = let relative_complemented_fname = filename_to_relative root fname in if String.is_prefix ~prefix:root fname && Filename.is_relative relative_complemented_fname then Some relative_complemented_fname else None (* The project root is not a prefix of the file name *) let from_abs_path fname = if Filename.is_relative fname then (failwithf "ERROR: Path %s is relative, when absolute path was expected .@." fname); (* try to get realpath of source file. Use original if it fails *) let fname_real = try realpath fname with Unix.Unix_error _ -> fname in let project_root_real = realpath Config.project_root in let models_dir_real = Config.models_src_dir in match rel_path_from_abs_path project_root_real fname_real with | Some path -> RelativeProjectRoot path | None -> ( match rel_path_from_abs_path models_dir_real fname_real with | Some path -> RelativeInferModel path | None -> Absolute fname (* fname is absolute already *) ) let curr_encoding = `Enc_crc let to_string fname = match fname with | RelativeInferModel path -> "INFER_MODEL/" ^ path | RelativeProjectRoot path | Absolute path -> path let pp fmt fname = Format.fprintf fmt "%s" (to_string fname) (* Checking if the path exists may be needed only in some cases, hence the flag check_exists *) let to_abs_path fname = match fname with | RelativeProjectRoot path -> Filename.concat Config.project_root path | RelativeInferModel path -> Filename.concat Config.models_src_dir path | Absolute path -> path let line_count source_file = let abs_path = to_abs_path source_file in count_newlines abs_path let to_rel_path fname = match fname with | RelativeProjectRoot path -> path | _ -> to_abs_path fname (** string encoding of a source file (including path) as a single filename *) let encoding source_file = let prefix = match source_file with | RelativeProjectRoot _ -> "P" | RelativeInferModel _ -> "MOD" | Absolute _ -> "ABS" in let source_file_s = to_string source_file in match curr_encoding with | `Enc_base -> Filename.basename source_file_s | `Enc_path_with_underscores -> prefix ^ Escape.escape_path source_file_s | `Enc_crc -> let base = Filename.basename source_file_s in let dir = prefix ^ Filename.dirname source_file_s in string_append_crc_cutoff ~key:dir base let empty = Absolute "" let is_infer_model source_file = match source_file with | RelativeProjectRoot _ | Absolute _ -> false | RelativeInferModel _ -> true (** Returns true if the file is a C++ model *) let is_cpp_model file = match file with | RelativeInferModel path -> String.is_prefix ~prefix:Config.relative_cpp_models_dir path | _ -> false let is_under_project_root = function | RelativeProjectRoot _ -> true | Absolute _ | RelativeInferModel _ -> false let exists_cache = String.Table.create ~size:256 () let path_exists abs_path = try String.Table.find_exn exists_cache abs_path with Not_found -> let result = Sys.file_exists abs_path in String.Table.set exists_cache ~key:abs_path ~data:result; result let of_header header_file = let abs_path = to_abs_path header_file in let source_exts = ["c"; "cc"; "cpp"; "cxx"; "m"; "mm"] in let header_exts = ["h"; "hh"; "hpp"; "hxx"] in let file_no_ext, ext_opt = Core.Std.Filename.split_extension abs_path in let file_opt = match ext_opt with | Some ext when IList.mem String.equal ext header_exts -> ( let possible_files = IList.map (fun ext -> file_no_ext ^ "." ^ ext) source_exts in try Some (IList.find path_exists possible_files) with Not_found -> None ) | _ -> None in Option.map from_abs_path file_opt let changed_files_set = let create_source_file path = if Filename.is_relative path then (* sources in changed-files-index may be specified relative to project root *) RelativeProjectRoot path else from_abs_path path in Option.map_default read_file None Config.changed_files_index |> Option.map ( IList.fold_left (fun changed_files line -> let source_file = create_source_file line in let changed_files' = Set.add source_file changed_files in (* Add source corresponding to changed header if it exists *) match of_header source_file with | Some src -> Set.add src changed_files' | None -> changed_files' ) Set.empty )