Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

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