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
(** Format type *)
type format =
| Src (** standard source file *)
| M2l (** M2l serialized file *)
| Parsetree (** parsetree ast file *)
| Cmi
(** Extend M2l.kind to include the format of read file *)
type kind = { format: format; kind: M2l.kind }
type ocaml_parsing_error = Syntax of Syntaxerr.error | Lexer of Lexer.error
type error = Ocaml of ocaml_parsing_error | Serialized of Schematic.Ext.error
let name str = Unitname.modulize str
let ok x = Ok x
let parse_implementation input =
try
Pparse_compat.implementation input
with
| Syntaxerr.Error _ ->
let ast = Parse.use_file (Lexing.from_channel @@ open_in input) in
let drop_directive x l = match x with
| Parsetree.Ptop_def x -> x @ l
| Ptop_dir _ -> l in
List.(fold_right drop_directive ast [])
let source_file kind filename =
Location.input_name := filename;
let input_file = Pparse.preprocess filename in
let code = try ok @@
match kind with
| M2l.Structure ->
Ast_converter.structure @@ parse_implementation input_file
| M2l.Signature ->
Ast_converter.signature @@
Pparse_compat.interface input_file
with
| Syntaxerr.Error msg -> Error (Ocaml (Syntax msg))
| Lexer.Error(e,_) -> Error (Ocaml (Lexer e))
in
Pparse.remove_preprocessed input_file;
code
let file {format;kind} filename =
match format with
| Src | Parsetree -> source_file kind filename
| M2l ->
let file = open_in filename in
let lex = Lexing.from_channel file in
begin
match Schematic.Ext.strict Schema.m2l @@ Sparser.main Slex.main lex with
| Ok m2l -> close_in file; ok m2l
| Error e -> close_in file; Error (Serialized e)
| exception Parsing.Parse_error -> close_in file;
Error (Serialized Schematic.Ext.Unknown_format)
end
| Cmi -> ok @@ Cmi.m2l filename