@ -15,13 +15,10 @@ let count_newlines (path : string) : int =
type t =
type t =
| Invalid of string
| Invalid of { ml_source_file : string }
(* ML function of origin *)
| Absolute of string
| Absolute of string
| RelativeProjectRoot of string
| RelativeProjectRoot of string (* * relative to project root *)
(* relative to project root *)
| RelativeInferModel of string (* * relative to infer models *)
| RelativeInferModel of string
(* relative to infer models *)
[ @@ deriving compare ]
[ @@ deriving compare ]
let equal = [ % compare . equal : t ]
let equal = [ % compare . equal : t ]
@ -71,8 +68,8 @@ let to_string =
let root = Utils . realpath Config . project_root in
let root = Utils . realpath Config . project_root in
fun ? ( force_relative = false ) fname ->
fun ? ( force_relative = false ) fname ->
match fname with
match fname with
| Invalid origin ->
| Invalid { ml_source_file } ->
" DUMMY from " ^ origin
" DUMMY from " ^ ml_source_file
| RelativeInferModel path ->
| RelativeInferModel path ->
" INFER_MODEL/ " ^ path
" INFER_MODEL/ " ^ path
| RelativeProjectRoot path ->
| RelativeProjectRoot path ->
@ -87,8 +84,9 @@ let pp fmt fname = Format.pp_print_string fmt (to_string fname)
let to_abs_path fname =
let to_abs_path fname =
match fname with
match fname with
| Invalid origin ->
| Invalid { ml_source_file } ->
L . ( die InternalError ) " cannot be called with Invalid source file originating in %s " origin
L . ( die InternalError )
" cannot be called with Invalid source file originating in %s " ml_source_file
| RelativeProjectRoot path ->
| RelativeProjectRoot path ->
Filename . concat Config . project_root path
Filename . concat Config . project_root path
| RelativeInferModel path ->
| RelativeInferModel path ->
@ -106,14 +104,14 @@ let to_rel_path fname =
match fname with RelativeProjectRoot path -> path | _ -> to_abs_path fname
match fname with RelativeProjectRoot path -> path | _ -> to_abs_path fname
let invalid origin = Invalid origin
let invalid ml_source_file = Invalid { ml_source_file }
let is_invalid = function Invalid _ -> true | _ -> false
let is_invalid = function Invalid _ -> true | _ -> false
let is_infer_model source_file =
let is_infer_model source_file =
match source_file with
match source_file with
| Invalid origin ->
| Invalid { ml_source_file } ->
L . ( die InternalError ) " cannot be called with Invalid source file from %s " origin
L . ( die InternalError ) " cannot be called with Invalid source file from %s " ml_source_file
| RelativeProjectRoot _ | Absolute _ ->
| RelativeProjectRoot _ | Absolute _ ->
false
false
| RelativeInferModel _ ->
| RelativeInferModel _ ->
@ -130,8 +128,8 @@ let is_cpp_model file =
let is_under_project_root = function
let is_under_project_root = function
| Invalid origin ->
| Invalid { ml_source_file } ->
L . ( die InternalError ) " cannot be called with Invalid source file from %s " origin
L . ( die InternalError ) " cannot be called with Invalid source file from %s " ml_source_file
| RelativeProjectRoot _ ->
| RelativeProjectRoot _ ->
true
true
| Absolute _ | RelativeInferModel _ ->
| Absolute _ | RelativeInferModel _ ->