Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 277 lines (248 sloc) 9.875 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
19 (**
20 Common library for any Js compiler
21
22 @author Mathieu Barbin
23 @author Maxime Audouin
24 *)
25
26 (* depends *)
27 module List = Base.List
28
29 (* alias *)
30 module J = Qml2jsOptions
31
32 (** some type are shared with qml2ocaml, some not *)
33
34 type env_js_output =
35 {
36 generated_files : (string * string) list ; (** path/name without build directory * contents *)
37 }
38
39 (**
40 PASSES :
41 -------
42 // Command line passes
43 returns a : env_bsl, env_blender
44
45 val js_generation : argv_options -> env_js_input -> env_js_output
46 val js_treat : argv_options -> env_js_output -> int
47
48 NEEDED from any instance of a js-compiler :
49 val qml_to_js : qml_to_js
50 *)
51
52 module JsTreat :
53 sig
54 val js_bslfilesloading : Qml2jsOptions.t -> BslLib.env_bsl -> (string * string) list * JsAst.code
55 val js_generation : Qml2jsOptions.t -> (string * string) list -> J.env_js_input -> env_js_output
56 val js_treat : Qml2jsOptions.t -> env_js_output -> int
57 end =
58 struct
59 open Qml2jsOptions
60
61 let take_n n =
62 let rec aux acc i rest =
63 if i >= n then List.rev acc, rest else
64 match rest with
65 | [] -> List.rev acc, []
66 | t::q -> aux (t::acc) (succ i) q
67 in aux [] 0
68
69 let js_bslfilesloading env_opt env_bsl =
70 (* 1) extra libraries *)
71 let generated_files = [] in
72 let generated_files =
73 let fold acc (extra_lib, conf) =
74 let () =
75 (*
76 TODO: refactor so that conf is not ignored,
77 and optimization pass applied
78 *)
79 ignore conf
80 in
81 let get t =
82 let contents = File.content t in
83 (File.from_pattern "%b.js" t, contents)::acc
84 in
85 match File.get_locations env_opt.extra_path extra_lib with
86 | [] ->
87 OManager.error (
88 "Cannot find extra-lib @{<bright>%s@} in search path@\n"^^
89 "@[<2>@{<bright>Hint@}:@\nPerhaps a missing @{<bright>-I@} ?@]" ) extra_lib
90 | [t] -> get t
91 | (t::_) as all ->
92 OManager.warning ~wclass:WarningClass.bsl_loading (
93 "extra-lib @{<bright>%s@} is found in several places@\n%s\n"^^
94 "I will use this one : @{<bright>%s@}" ) extra_lib (String.concat " " all) t ;
95 get t
96 in
97 List.fold_left fold generated_files env_opt.extra_lib
98 in
99
100 (* 2) loaded bsl containing js files
101 order : since the generated code contains call to bypass of bsl, it is too dangerous to
102 put the extra-libs between bsl and the generated code *)
103 let generated_files =
104 let filter_bsl =
105 if env_opt.command_line then
106 fun (filename, content, conf) ->
107 let filename = Filename.basename filename in
108 let b:bool = List.for_all
109 (fun s -> not (String.is_contained s filename))
110 ["bslClient.js"; "bslClientOnly.js"; "bslJson.js"; "syslog.js";
111 "jquery"; "jQuery"; "Anchors";
112 "json2.js"; "ojs.js"]
113 (* every file that need functionality that won't be available in
114 * js or rhino should end up in this match *)
115 in if b then
116 let ppjs =
117 let ppenv = Pprocess.fill_with_sysenv Pprocess.empty_env in
118 (* TODO modifier ppenv avec des choses *)
119 let ppopt = Pprocess.default_options ppenv in
120 Pprocess.process Pplang.js_description ppopt in
121 let content = ppjs content in
122 let () =
123 (*
124 TODO: refactor so that conf is not ignored,
125 and optimization pass applied
126 *)
127 ignore conf
128 in
129 Some (filename, content)
130 else None
131 else
132 fun (filename, content, _conf) -> Some (filename, content)
133 in
134 let fold acc loader =
135 List.rev_filter_map_append filter_bsl loader.BslPluginInterface.js_code acc
136 in
137 List.fold_left fold generated_files env_bsl.BslLib.plugins
138 in
139 let ast = List.flatten (List.rev_map (
140 fun (_,content) ->
141 (*
142 TODO: we must take care about conf,
143 and not parse file tagged as Verbatim
144 *)
145 JsParse.String.code content
146 ) generated_files) in
147 List.rev generated_files, ast
148
149 let js_generation env_opt generated_files env_js_input =
150 let name_generation ?index () =
151 match index with
152 | None -> env_opt.target
153 | Some (i, n) -> Printf.sprintf "js_%d_%s" (i * n) env_opt.target
154 in
155
156 let generated_files = List.rev generated_files in
157
158 (* some more init given by the specific implementation of the backen (bypass projection : bsl_js_init.js) *)
159 let generated_files =
160 let map (name, elts) =
161 name, (
162 match elts with
163 | `ast elts ->
164 let code = List.map snd elts in
165 JsPrint.code code
166 | `string s -> s
167 )
168 in
169 List.rev_map_append map env_js_input.js_init_contents generated_files
170 in
171
172 let generated_files =
173 match env_opt.split_js_value with
174 | None ->
175 let file = name_generation (), JsPrint.code env_js_input.js_code in
176 file::generated_files
177 | Some n ->
178 let rec aux acc i rest =
179 let filename = name_generation ~index:(i, n) () in
180 match take_n n rest with
181 | code, rest ->
182 let acc =
183 let file = filename, JsPrint.code code in
184 file::acc in
185 begin
186 match rest with
187 | [] -> acc
188 | _ :: _ -> aux acc (succ i) rest
189 end
190 in
191 aux generated_files 1 env_js_input.js_code
192 in
193 let last =
194 match generated_files with
195 | (last,_)::_ -> last
196 | [] -> Filename.concat env_opt.compilation_directory "empty.js" in
197
198 let generated_files = List.rev generated_files in
199
200 (* keep split, or merge them all *)
201 let generated_files =
202 if env_opt.split then generated_files else
203 begin
204 OManager.verbose "append files into %s" last ;
205 let fold buf (filename, contents) =
206 OManager.verbose "append -- @{<bright>%s@}" filename;
207 FBuffer.addln buf contents in
208 let buf = FBuffer.create 1048 in
209 let buf = List.fold_left fold buf generated_files in
210 [ last, FBuffer.contents buf ]
211 end
212 in
213
214 let _ =
215 let write (filename, contents) =
216 let filename = Filename.concat env_opt.compilation_directory filename in
217 OManager.verbose "writing file @{<bright>%s@}" filename ;
218 let success = File.output filename contents in
219 if not success then OManager.error "cannot write file @{<bright>%S@}" filename
220 in
221 let caller_wd = Sys.getcwd () in
222 let build_dir = Filename.concat caller_wd env_opt.compilation_directory in
223 OManager.verbose "create/enter directory @{<bright>%s@}" build_dir ;
224 let success = File.check_create_path build_dir in
225 let _ = if not success then OManager.error "cannot create or enter in directory @{<bright>%s@}" build_dir in
226 List.iter write generated_files
227 in
228 { generated_files = generated_files }
229
230 let js_treat env_opt env_js_output =
231 if not env_opt.exe_run
232 then 0
233 else
234 let prog = env_opt.js_exe in
235 let args = env_opt.exe_argv in
236 let args = args @ ( List.map fst env_js_output.generated_files ) in
237 OManager.verbose "building finished, will run @{<bright>%s@}" prog ;
238 OManager.verbose "going to directory @{<bright>%s@}" env_opt.compilation_directory ;
239 Sys.chdir env_opt.compilation_directory ;
240 let command = String.concat " " (prog::args) in
241 OManager.verbose "exec$ %s" command ;
242 let args = Array.of_list (prog::args) in
243 let run () = Unix.execvp prog args in
244 Unix.handle_unix_error run ()
245 end
246
247 module Sugar :
248 sig
249 val for_opa : val_:(string -> QmlAst.ident) ->
250 ?bsl:JsAst.code ->
251 closure_map:Ident.t IdentMap.t ->
252 renaming_server:QmlRenamingMap.t ->
253 renaming_client:QmlRenamingMap.t ->
254 (module Qml2jsOptions.JsBackend) ->
255 Qml2jsOptions.t ->
256 BslLib.env_bsl ->
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
257 QmlTyper.env ->
258 QmlAst.code ->
fccc685 Initial open-source release
MLstate authored
259 J.env_js_input
260 val dummy_for_opa : (module Qml2jsOptions.JsBackend) -> unit
261 end
262 =
263 struct
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
264 let for_opa ~val_ ?bsl:bsl_code ~closure_map ~renaming_server ~renaming_client back_end argv env_bsl env_typer code =
fccc685 Initial open-source release
MLstate authored
265 let module M = (val back_end : Qml2jsOptions.JsBackend) in
1a910b2 [cleanup] blender: reduce dependency to the Blender
Mathieu Barbin authored
266 let env_js_input = M.compile ~val_ ?bsl:bsl_code ~closure_map ~renaming_server ~renaming_client argv env_bsl env_typer code in
fccc685 Initial open-source release
MLstate authored
267 env_js_input
268 let dummy_for_opa backend =
269 let module M = (val backend : Qml2jsOptions.JsBackend) in
270 M.dummy_compile ()
271 end
272
273
274 let wclass =
275 let doc = "Javascript compiler warnings" in
276 WarningClass.create ~name:"jscompiler" ~doc ~err:false ~enable:true ()
Something went wrong with that request. Please try again.