Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 81 lines (69 sloc) 3.261 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
293dd4c [cleanup] open: remove Base in tool
Raja authored
19 (* depends *)
20 module String = BaseString
21
22 (** Simplier version of ofile + retourned type is an option (safer) *)
fccc685 Initial open-source release
MLstate authored
23
24 let extension = "of"
a9f8d34 [cleanup] Base: remove sprintf
Raja authored
25 let error s = prerr_endline (Printf.sprintf "[!] ofile : %s" s); exit 1
fccc685 Initial open-source release
MLstate authored
26 let do_verbose = ref false
27 let verbose s =
a9f8d34 [cleanup] Base: remove sprintf
Raja authored
28 if !do_verbose then prerr_endline (Printf.sprintf "ofile : %s" s)
fccc685 Initial open-source release
MLstate authored
29
30 let safe_content file =
31 try (String.escaped (File.content file))
a9f8d34 [cleanup] Base: remove sprintf
Raja authored
32 with Unix.Unix_error(e,s0,s1) -> error (Printf.sprintf "cannot load \"%s\" from \"%s\" [%s,%s,%s]" file (Sys.getcwd ()) (Unix.error_message e) s0 s1)
fccc685 Initial open-source release
MLstate authored
33
34 let win2unix f =
35 let res = String.copy f in
36 let n = String.length res in
37 for i = 0 to n-1 do
38 if res.[i] = '\\' then res.[i] <- '/'
39 done;
40 res
41
42 let iter_of path file =
43 if File.extension file <> extension
a9f8d34 [cleanup] Base: remove sprintf
Raja authored
44 then error (Printf.sprintf "input file \"%s\" must have .%s extension" file extension)
fccc685 Initial open-source release
MLstate authored
45 else
46 if Sys.file_exists file && not (Sys.is_directory file)
47 then
48 let buf = FBuffer.create 1024 in
49 let buf = FBuffer.addln buf "let get_file = function" in
50 let files_list = List.rev
51 (File.lines_fold
52 (fun acc line -> let t = String.trim line in if t = "" then acc else t::acc)
53 [] file) in
54 let portable_path _path file =
55 let path_file =(*_path^*)file in
56 (Mlstate_platform.platform_dependent
57 ~unix:PathTransform.string_to_unix
58 ~windows:PathTransform.string_to_windows ()) path_file
59 in
60 let buf = List.fold_left
a9f8d34 [cleanup] Base: remove sprintf
Raja authored
61 (fun buf t -> FBuffer.addln buf (Printf.sprintf " | %S -> Some \"%s\"" t (safe_content (portable_path path t) ))) buf files_list in
fccc685 Initial open-source release
MLstate authored
62 let buf = FBuffer.addln buf " | _ -> None\n" in
63 let buf = FBuffer.addln buf "let file_list =" in
a9f8d34 [cleanup] Base: remove sprintf
Raja authored
64 let buf = FBuffer.addln buf (String.concat_map ~left:"[" ~right:"]" "; " (fun f -> Printf.sprintf "%S" f) files_list) in
fccc685 Initial open-source release
MLstate authored
65 let out = (File.chop_extension file)^".ml" in
66 if File.output out (FBuffer.contents buf)
a9f8d34 [cleanup] Base: remove sprintf
Raja authored
67 then verbose (Printf.sprintf "write file \"%s\"" out)
68 else error (Printf.sprintf "cannot write file \"%s\" from \"%s\"" out (Sys.getcwd ()))
fccc685 Initial open-source release
MLstate authored
69
70 let _ =
71 (** please, keep the possibility of this option for other potential users of this generic application *)
72 let path = ref "" and empty = ref true in
73 Arg.parse
74 [ "-v", Arg.Set do_verbose, " verbose";
75 "-path", Arg.Set_string path, "<dir> prefix directory for files"
76 ]
77 (fun t -> iter_of !path t; empty := false)
a9f8d34 [cleanup] Base: remove sprintf
Raja authored
78 (Printf.sprintf "%s : embedded file ocaml preprocessor" Sys.argv.(0));
fccc685 Initial open-source release
MLstate authored
79 if !empty
a9f8d34 [cleanup] Base: remove sprintf
Raja authored
80 then error (Printf.sprintf "no input files (give me some \"%s\" file)" extension)
Something went wrong with that request. Please try again.