Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 296 lines (266 sloc) 7.928 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 (* depends *)
19 module Arg = BaseArg
20 module Format = BaseFormat
21 module String = BaseString
22
23 (* - *)
24
25 type properties = {
26 cclib : string list ;
27 ccopt : string list ;
28 mlcopt : string list ;
29 mllopt : string list ;
30 mlinclude : string list ;
31 mllibs : string list ;
32 }
33
34 let pp_list fmt list = Format.pp_list " ; " Format.pp_print_string fmt list
35
36 let pp_if word fmt list =
37 if list <> []
38 then
39 Format.fprintf fmt "@\n%s: [ %a ]" word pp_list list
40
41 let pp_properties fmt properties =
42 Format.fprintf fmt "@[<2>{" ;
43 pp_if "cclib" fmt properties.cclib ;
44 pp_if "ccopt" fmt properties.ccopt ;
45 pp_if "mlcopt" fmt properties.mlcopt ;
46 pp_if "mllopt" fmt properties.mllopt ;
47 pp_if "mlinclude" fmt properties.mlinclude ;
48 pp_if "mllibs" fmt properties.mllibs ;
49 Format.fprintf fmt "@]@\n}"
50
51 (*
52 <!> Beware, this type is marshaled during the bsl preprocess
53 *)
54 type conf = {
55 all_platform: properties ;
56 linux: properties option ;
57 mac:properties option ;
58 windows: properties option ;
59 cygwin: properties option ;
60 }
61
62 let pp_if word fmt opt =
63 match opt with
64 | None -> ()
65 | Some props ->
66 Format.fprintf fmt "@\n%s: %a" word pp_properties props
67
68 let pp fmt conf =
69 Format.fprintf fmt "@[<2>{" ;
70 pp_if "all-platform" fmt (Some conf.all_platform) ;
71 pp_if "linux" fmt conf.linux ;
72 pp_if "mac" fmt conf.mac ;
73 pp_if "windows" fmt conf.windows ;
74 pp_if "cygwin" fmt conf.cygwin ;
75 Format.fprintf fmt "@]@\n}"
76
77 type t = conf
78
79 let default_properties = {
80 cclib = [] ;
81 ccopt = [] ;
82 mlcopt = [] ;
83 mllopt = [] ;
84 mlinclude = [] ;
85 mllibs = [] ;
86 }
87
88 let is_default_properties def =
89 def.cclib = []
90 && def.ccopt = []
91 && def.mlcopt = []
92 && def.mllopt = []
93 && def.mlinclude = []
94 && def.mllibs = []
95
96 let is_default_properties_opt = function
97 | None -> true
98 | Some def -> is_default_properties def
99
100 let default = {
101 all_platform = default_properties ;
102 linux = None ;
103 mac = None ;
104 windows = None ;
105 cygwin = None ;
106 }
107
108 let default_conf = default
109
110 let is_default def =
111 true
112 && is_default_properties def.all_platform
113 && is_default_properties_opt def.linux
114 && is_default_properties_opt def.windows
115 && is_default_properties_opt def.cygwin
116 && is_default_properties_opt def.mac
117
118 (*
119 Parsing the file.
120 A line can be a new property, with an optional platform,
121 or contents
122 *)
123 let regexp_property = Str.regexp "\\[\\([^]:]*\\)\\(:\\([^]:]*\\)\\)?\\]$"
124 let property_platform line =
125 if Str.string_match regexp_property line 0
126 then
127 let property = Str.matched_group 1 line in
128 let platform = try Some (Str.matched_group 3 line) with Not_found -> None in
129 Some (property, platform)
130 else
131 None
132
133 let all_properties = [
134 "mlcopt" ;
135 "mllopt" ;
136 "cclib" ;
137 "ccopt" ;
138 "mlinclude" ;
139 "mllibs" ;
140 ]
141
142 let all_platform = [
143 "linux" ;
144 "windows" ;
145 "cygwin" ;
146 "mac" ;
147 ]
148
149 let check_property_platform pos property platform =
150 let (!!) fmt = OManager.error ("%a@\n"^^fmt) FilePos.pp pos in
151 let property =
152 match String.trim property with
153 | "mllopt" -> `mllopt
154 | "mlcopt" -> `mlcopt
155 | "cclib" -> `cclib
156 | "ccopt" -> `ccopt
157 | "mlinclude" -> `mlinclude
158 | "mllibs" -> `mllibs
159 | unknown -> !! "Invalid property %S@\n%a" unknown (HintUtils.pp_suggestion all_properties) unknown
160 in
161 let platform =
162 match platform with
163 | None -> `all
164 | Some platform -> (
165 match String.trim platform with
166 | "linux" -> `linux
167 | "max" -> `mac
168 | "windows" -> `windows
169 | "cygwin" -> `cygwin
170 | unknown -> !! "Invalid platform %S@\n%a" unknown (HintUtils.pp_suggestion all_properties) unknown
171 )
172 in
173 property, platform
174
175 (*
176 Convention: everything lists are reversed during the fold
177 *)
178
179 let add_args acc line =
180 let args = Arg.split line in
181 List.rev_append args acc
182
183 let add_property properties property line =
184 match property with
185 | `cclib -> {
186 properties with
187 cclib = add_args properties.cclib line
188 }
189 | `ccopt -> {
190 properties with
191 ccopt = add_args properties.ccopt line
192 }
193 | `mlcopt -> {
194 properties with
195 mlcopt = add_args properties.mlcopt line
196 }
197 | `mllopt -> {
198 properties with
199 mllopt = add_args properties.mllopt line
200 }
201 | `mlinclude -> {
202 properties with
203 mlinclude = add_args properties.mlinclude line
204 }
205 | `mllibs -> {
206 properties with
207 mllibs = add_args properties.mllibs line
208 }
209
210 let add property platform t line =
211 match platform with
212 | `all -> {
213 t with
214 all_platform = add_property t.all_platform property line
215 }
216 | `linux ->
217 let properties = Option.default default_properties t.linux in
218 { t with linux = Some (add_property properties property line) }
219 | `windows ->
220 let properties = Option.default default_properties t.windows in
221 { t with windows = Some (add_property properties property line) }
222 | `cygwin ->
223 let properties = Option.default default_properties t.cygwin in
224 { t with cygwin = Some (add_property properties property line) }
225 | `mac ->
226 let properties = Option.default default_properties t.mac in
227 { t with mac = Some (add_property properties property line) }
228
229 let fold ~filename t =
230 let () =
231 if not (File.is_regular filename) then
232 OManager.error "I/O error: @{<bright>%S@} -> No such file" filename
233 in
234 let () =
235 let content =
236 match File.content_opt filename with
237 | Some content -> content
238 | None ->
239 OManager.error "I/O error: cannot read conf file @{<bright>%S@}" filename
240 in
241 FilePos.add_file filename content
242 in
243 let fold_line (((property, platform) as props, t) as acc) line line_number =
244 let line = String.trim line in
245 if String.length line = 0 || line.[0] = '#' then acc else
246 let pos = FilePos.make_pos_from_line filename line_number in
247 match property_platform line with
248 | Some (property, platform) ->
249 let props = check_property_platform pos property platform in
250 props, t
251 | None -> (
252 match property with
253 | `none ->
254 OManager.error "%a@\nSyntax error. The conf file should start with a property." FilePos.pp pos
255 | (
256 `cclib
257 | `ccopt
258 | `mlcopt
259 | `mllopt
260 | `mlinclude
261 | `mllibs
262 ) as prop ->
263 let t = add prop platform t line in
264 props, t
265 )
266 in
267 let _, t = File.lines_foldi fold_line ((`none, `all), t) filename in
268 let () =
269 #<If:BSL_REGISTER $contains "conf">
270 OManager.printf "@[<2>@{<cyan>BslConf:@} folding file %S:@\n %a@]@\n" filename pp t ;
271 #<End>
272 in
273 t
274
275 let export t =
276 let rev = List.rev in
277 let rev_prop prop =
278 let { cclib ; ccopt ; mlcopt ; mllopt ; mlinclude ; mllibs } = prop in
279 {
280 cclib = rev cclib ;
281 ccopt = rev ccopt ;
282 mlcopt = rev mlcopt ;
283 mllopt = rev mllopt ;
284 mlinclude = rev mlinclude ;
285 mllibs = rev mllibs ;
286 } in
287 let rev_prop_opt = Option.map rev_prop in
288 let { all_platform ; linux ; mac ; windows ; cygwin } = t in
289 {
290 all_platform = rev_prop all_platform ;
291 linux = rev_prop_opt linux ;
292 mac = rev_prop_opt mac ;
293 windows = rev_prop_opt windows ;
294 cygwin = rev_prop_opt cygwin ;
295 }
Something went wrong with that request. Please try again.