Source file namespaced.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
type p = Paths.S.t
type t = { namespace: p; name: Unitname.t; }
type namespaced = t


let pp ppf n =
  if n.namespace = [] then
    Unitname.pp_as_modname ppf n.name
  else
    Pp.fp ppf "%a.%a" Paths.S.pp n.namespace Unitname.pp_as_modname n.name



let pp_as_filepath ppf n =
  if n.namespace = [] then
    Unitname.pp_as_filepath ppf n.name
  else
    Pp.fp ppf "%a%s%s"
      Pp.(list ~sep:(const Filename.dir_sep) string) n.namespace Filename.dir_sep
      (Unitname.filename n.name)

let reflect  ppf n =
  let es ppf = Pp.fp ppf {|"%s"|} in
  Pp.fp ppf "{name=%a;namespace=[%a];}"
    Unitname.reflect n.name
    Pp.(list ~sep:(const "; ") es) n.namespace

let cons prefix n = { n with namespace = prefix @ n.namespace }

let to_string = Format.asprintf "%a" pp
let filepath r = Unitname.filepath r.name

let make ?(nms=[]) file = { namespace = nms; name= Unitname.modulize file }

let flatten n = n.namespace @ [Modname.to_string (Unitname.modname n.name)]
let fileview_flatten n = n.namespace @ [Unitname.filename n.name]


let of_path l =
  let rec split l = function
    | [a] -> l, a
    | a :: q -> split (a::l) q
    | [] -> raise @@ Invalid_argument("Namespaced.of_path: empty path")
  in
  let p, file = split [] l in
  let name = Unitname.modulize file in
  { namespace = List.rev p; name; }

let head = function
  | {namespace=a :: _ ; _ } -> a
  | {namespace=[]; name } -> Unitname.filename name

let sch =
  let open Schematic in
  custom (Array String)
    (fun x -> flatten x)
    (fun x -> of_path x)

let fileview_sch =
  let open Schematic in
  custom (Array String)
    (fun x -> fileview_flatten x)
    (fun x -> of_path x)

let compare a b =
  let v = compare a.namespace b.namespace in
  if v = 0 then Unitname.compare_as_modnames a.name b.name
  else v

module Ordered = struct
  type nonrec t = t
  let compare = compare
end

module Map = Support.Map.Make(Ordered)
type 'a map = 'a Map.t

module Set = struct
  include Set.Make(Ordered)
    let pp ppf s = Pp.(clist pp) ppf (elements s)
    let sch = let open Schematic in
      custom (Array sch)
        elements
        (List.fold_left (fun s x -> add x s) empty)
end
type set = Set.t


let module_path_of_filename ?(nms=[]) filename =
  let name = Unitname.modulize filename in
  match List.rev (Support.split_on_dirs filename) with
  | [] -> raise @@ Invalid_argument "Invalid name for a compilation unit"
  | _ ->
    { namespace = nms ;
      name;
    }

let filepath_of_filename ?(nms=[]) filename =
  let name = Unitname.modulize filename in
  match List.rev (Support.split_on_dirs filename) with
  | [] -> raise @@ Invalid_argument "Invalid name for a compilation unit"
  | _filename :: r ->
    { namespace = nms @ List.rev r ;
      name;
    }

let module_name x = Unitname.modname x.name

let change_file_extension f p =
  { p with name = Unitname.change_file_extension f p.name }