Source file filename.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
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
include Stdlib.Filename

type t = string

module Extension = struct
  type t = string

  let ml = ".ml"
  let mli = ".mli"
  let vo = ".vo"
  let vos = ".vos"
  let mllib = ".mllib"
  let mlpack = ".mllib"
  let mll = ".mll"
  let mly = ".mly"
  let theory_d = ".theory.d"
  let map = ".map"
  let odocl = ".odocl"
  let deps = ".deps"
  let cma = ".cma"
  let cmx = ".cmx"
  let cmxa = ".cmxa"
  let cmxs = ".cmxs"
  let cmi = ".cmi"
  let cmo = ".cmo"
  let cmj = ".cmj"
  let cmi_dump = ".cmi.dump"
  let cmo_dump = ".cmo.dump"
  let exe = ".exe"
  let bc = ".bc"
  let bc_exe = ".bc.exe"
  let ml_gen = ".ml-gen"
  let cmt = ".cmt"
  let cmti = ".cmti"
  let cms = ".cms"
  let cmsi = ".cmsi"
  let odoc = ".odoc"
  let d = ".d"
  let all_deps = ".all-deps"
  let js = ".js"
  let h = ".h"
  let mlg = ".mlg"
  let json = ".json"

  let is_valid s =
    (not (String.is_empty s)) && Char.equal s.[0] '.' && not (String.contains s '/')
  ;;

  let of_string s = Option.some_if (is_valid s) s

  let of_string_exn s =
    match of_string s with
    | Some t -> t
    | None ->
      Code_error.raise
        "Filename.Extension.of_string_exn: invalid extension"
        [ "extension", Dyn.string s ]
  ;;

  let to_string t = t
  let compare = String.compare
  let equal = String.equal
  let hash = String.hash
  let to_dyn t = Dyn.string t
  let drop_dot t = String.drop t 1

  module T = struct
    type nonrec t = t

    let compare = compare
    let to_dyn = to_dyn
  end

  module O = Comparable.Make (T)
  module Set = O.Set
  module Map = O.Map

  module Or_empty = struct
    type t = string

    let check = String.equal

    let of_string_exn = function
      | "" -> ""
      | s when s.[0] = '.' -> s
      | s -> Code_error.raise "invalid extension" [ "s", Dyn.string s ]
    ;;

    let empty = ""
    let to_string s = s
    let is_empty s = s = empty
    let is_extension s = not (is_empty s)

    let extension = function
      | "" -> None
      | s -> Some s
    ;;

    let extension_exn = function
      | "" -> Code_error.raise "no extension" []
      | s -> s
    ;;
  end
end

let split_extension fn =
  let ext = extension fn in
  if String.is_empty ext
  then fn, Extension.Or_empty.empty
  else String.sub fn ~pos:0 ~len:(String.length fn - String.length ext), ext
;;

let split_extension_after_dot fn =
  match extension fn with
  | "" -> fn, ""
  | s -> String.split_n fn (String.length fn - String.length s + 1)
;;

type program_name_kind =
  | In_path
  | Relative_to_current_dir
  | Absolute

let analyze_program_name fn =
  if not (is_relative fn)
  then Absolute
  else if String.contains fn '/' || (Stdlib.Sys.win32 && String.contains fn '\\')
  then Relative_to_current_dir
  else In_path
;;

let compare = String.compare
let equal = String.equal
let chop_extension = `Use_remove_extension

module Set = String.Set
module Map = String.Map