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
|
open Ext.Filepath
open Ext.Fugue
open Ext.Compat
type t = string
exception InvalidModuleName of string
exception EmptyModuleName
exception ModuleFilenameNotValid of string
let char_isalpha c = (c >= 'a' && c <= 'z') || (c >= 'A' && c <= 'Z')
let char_is_valid_modchar c = char_isalpha c || (c >= '0' && c <= '9') || c == '_'
let string_all p s =
let valid = ref true in
for i = 0 to String.length s - 1 do
valid := !valid && p s.[i]
done;
!valid
let wrap x =
if String.length x = 0 then
raise EmptyModuleName
else if not (string_all char_is_valid_modchar x) then
raise (InvalidModuleName x)
else if char_uppercase x.[0] <> x.[0] then
raise (InvalidModuleName x)
else
x
let of_string x = wrap x
let to_string x = x
let to_dir x = string_uncapitalize x
let to_x ext modname = fn (string_uncapitalize modname ^ ext)
let to_o = to_x ".o"
let to_directory = to_x ""
let to_filename = to_x ".ml"
let to_parser = to_x ".mly"
let to_lexer = to_x ".mll"
let atd_modname modname =
if String.length modname > 2 then
let b, e = string_splitAt (String.length modname - 2) modname in
match e with
| "_t" | "_v" | "_j" -> b
| _ -> modname
else
modname
let to_atd modname = to_x ".atd" (atd_modname modname)
let module_lookup_methods = [ to_directory; to_parser; to_lexer; to_atd; to_filename ]
let of_directory filename = wrap (string_capitalize (fn_to_string filename))
let of_filename filename =
try wrap (string_capitalize (Filename.chop_extension (fn_to_string filename))) with
| EmptyModuleName -> raise (ModuleFilenameNotValid (fn_to_string filename))
| Invalid_argument _ -> raise (ModuleFilenameNotValid (fn_to_string filename))
|
