Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 126 lines (108 sloc) 5.033 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 type relevant_options =
19 { back_end : OpaEnv.available_back_end
20 ; js_back_end : string
21 ; closure : bool
22 ; cps : bool
23 ; cps_client : bool
24 ; cps_toplevel_concurrency : bool
25 ; explicit_instantiation : bool
26 ; value_restriction : [`disabled | `normal | `strict] }
27
28 module S =
29 struct
30 type t = relevant_options
31 let pass = "CheckOptionsConsistency"
32 let pp f _ = Format.pp_print_string f "<dummy>"
33 end
34
35 module R = ObjectFiles.Make(S)
36
37 let project options =
38 { back_end = options.OpaEnv.back_end
39 ; js_back_end =
40 (let module B = (val options.OpaEnv.js_back_end : Qml2jsOptions.JsBackend) in
41 B.name)
42 ; closure = options.OpaEnv.closure
43 ; cps = options.OpaEnv.cps
44 ; cps_client = options.OpaEnv.cps_client
45 ; cps_toplevel_concurrency = options.OpaEnv.cps_toplevel_concurrency
46 ; explicit_instantiation = options.OpaEnv.explicit_instantiation
47 ; value_restriction = options.OpaEnv.value_restriction }
48
49 let with_or_without = function
50 | true -> "with"
51 | false -> "without"
52 let would = function
53 | true -> "wouldn't"
54 | false -> "would"
55
56
57
58 (* ************************************************************************** *)
59 (** {b Descr}: String representing the status of the {b --value-restriction}
60 option invoked when a package is built. This function is used to report
61 inconsistency errors when some packages are compiled with different values
62 of the {b --value-restriction} option.
63 {b Visibility}: Not exported outside this module. *)
64 (* ************************************************************************** *)
65 let value_restiction_option_status = function
66 | `disabled -> "disabled"
67 | `normal -> "normal"
68 | `strict -> "strict"
69
70
71
72 let diff package options1 options2 (*current options*) =
73 if options1.back_end <> options2.back_end then
74 OManager.serror "The package %s was compiled for backend %s, the current package would be compiled for %s@."
75 package
76 (OpaEnv.string_of_available_back_end options1.back_end)
77 (OpaEnv.string_of_available_back_end options2.back_end);
78 if options1.js_back_end <> options2.js_back_end then
79 OManager.serror "The package %s was compiled for the js backend %s, the current package would be compiled for %s@."
80 package
81 options1.js_back_end
82 options2.js_back_end;
83 if options1.closure <> options2.closure then
84 OManager.serror "The package %s was compiled %s closure, the current package %s."
85 package
86 (with_or_without options1.closure) (would options1.closure);
87 if options1.cps <> options2.cps then
88 OManager.serror "The package %s was compiled %s cps, the current package %s."
89 package
90 (with_or_without options1.cps) (would options1.cps);
91 if options1.cps_client <> options2.cps_client then
92 OManager.serror "The package %s was compiled %s client cps, the current package %s."
93 package
94 (with_or_without options1.cps_client) (would options1.cps_client);
95 if options1.cps_toplevel_concurrency <> options2.cps_toplevel_concurrency then
96 OManager.serror "The package %s was compiled %s toplevel concurrency for cps, the current package %s."
97 package
98 (with_or_without options1.cps_toplevel_concurrency) (would options1.cps_toplevel_concurrency);
99 if options1.explicit_instantiation <> options2.explicit_instantiation then
100 OManager.serror "The package %s was compiled %s ei, the current package %s."
101 package
102 (with_or_without options1.explicit_instantiation) (would options1.explicit_instantiation);
103 (* Check that the value restriction option was identically set in all the
104 compiled packages. *)
105 if options1.value_restriction <> options2.value_restriction then
106 OManager.serror
107 ("The package %s was compiled with value restriction set to %s, " ^^
108 "the current package with %s." ^^
109 "@[<2>@{<bright>Hint@}:@\n" ^^
110 "Set --value-restriction option to the same value for all packages.@]")
111 package
112 (value_restiction_option_status options1.value_restriction)
113 (value_restiction_option_status options2.value_restriction)
114
115
116
117 let process_code ~options:options env =
118 let my_options = project options in
119 R.iter_with_name ~deep:true ~packages:true
120 (fun (package,_) options ->
121 if options <> my_options then
122 diff package options my_options
123 );
124 R.save my_options;
125 env
Something went wrong with that request. Please try again.