1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
|
(**pp -syntax camlp5o -ppopt -pa_ppx_regexp-nostatic -package bos *)
open Rresult
open Bos
open Fpath
let ( let* ) x f = Rresult.(>>=) x f ;;
module L = struct
let sub l n = List.nth !l n
let push l x = (l := x :: !l)
let pop l =
match !l with
[] -> failwith "pop: empty list"
| h::t -> l := t ; h
let len l = List.length !l
end
let read_ic_fully ?(msg="") ?(channel=stdin) () =
let fd = Unix.descr_of_in_channel channel in
if Unix.isatty fd && msg <> "" then
Fmt.(pf stdout "%s\n%!" msg) ;
let b = Buffer.create 23 in
let rec rrec () =
match input_char channel with
exception End_of_file -> Buffer.contents b
| c -> Buffer.add_char b c ; rrec ()
in
rrec()
let write_fully ~mode ofile txt =
OS.File.write ~mode (v ofile) txt |> R.failwith_error_msg
let capturex cmd =
let channel = Unix.open_process_in cmd in
let txt = read_ic_fully ~channel () in close_in channel; txt
let join s l = String.concat s l
let chomp s =
[%subst {|\n+$|} / {||} / s] s
;;
let usage_msg = {|
Options:
-I <dir> Add directory in search path for object files
-verbose verbosely print command executed, pass along to ocamlfind/ocamlc
-random-pid use PID as random number for generated tmpfile
-preserve preserve temp-files
-opt same as invoking "mkcamlp5.opt": create opt executable instead of bytecode
-n no-execute, just print command
All options of ocamlc (and ocamlfind) are also available
Files:
.cmi file Add visible interface for possible future loading
.cmo file Load this file in core
.cma file Load this file in core
|} ;;
let usage () = Fmt.(pf stdout "%s" usage_msg)
let toremove = ref []
let ocaml_version = chomp (capturex("ocamlc -version"))
let ocaml_lib = chomp (capturex("ocamlc -where"))
let verbose = ref false
let preserve = ref false
let noexecute = ref false
let rev_interfaces = ref []
let rev_options = ref []
let rev_predicates = ref ["preprocessor"; "syntax"]
let rev_packages = ref ["camlp5"]
let randpid = ref (Unix.getpid())
let opt = ref false
let main cmd args =
opt := ([%match {|mkcamlp5.opt$|}/pred] cmd) ;
Stdlib.at_exit (fun () ->
!toremove
|> List.iter (fun f ->
(let* existsp = OS.File.exists (v f) in
if existsp then
if !preserve then
Ok (Fmt.(pf stderr "Preserving tmpfile %s\n%!" f))
else
OS.Path.delete (v f)
else Ok()) |> ignore
)
)
;
let rec parec = function
"-help"::l ->
usage() ;
exit 0
| "-verbose"::l ->
verbose := true ;
parec l
| "-random-pid"::pid::l ->
randpid := int_of_string pid ;
parec l
| "-preserve"::l ->
preserve := true ;
parec l
| "-opt"::l ->
opt := true ;
parec l
| "-n"::l ->
noexecute := true ;
parec l
| "-package"::s::l ->
List.iter (L.push rev_packages) ([%split {|,|}] s) ;
parec l
| "-predicates"::s::l ->
List.iter (L.push rev_predicates) ([%split {|,|}] s) ;
parec l
| s::l ->
(match ([%match {|([^\./]+)\.cmi$|}/strings !1] s) with
Some s ->
if !opt then failwith Fmt.(str "%s: cannot specify .cmi file for %s" cmd cmd) ;
L.push rev_interfaces (String.capitalize_ascii s)
| None ->
L.push rev_options s) ;
parec l
| [] -> ()
in
parec args ;
if !opt then
L.push rev_predicates "native"
else
L.push rev_predicates "byte" ;
let interfaces = List.rev !rev_interfaces in
let options = List.rev !rev_options in
let packages = List.rev !rev_packages in
let predicates = List.rev !rev_predicates in
let link =
if not !opt then begin
let stringified = Fmt.(str "%a" (list ~sep:(const string "; ") (quote string)) interfaces) in
let txt = [%pattern {|Dynlink.set_allowed_units [
${stringified}
] ;;
|}] in
let linkbase = Fmt.(str "link%04d" !randpid) in
List.iter (L.push toremove) [[%pattern {|${linkbase}.ml|}]; [%pattern {|${linkbase}.cmi|}]; [%pattern {|${linkbase}.cmo|}]; [%pattern {|${linkbase}.cmx|}]] ;
write_fully ~mode:0o755 [%pattern {|${linkbase}.ml|}] txt ;
[[%pattern {|${linkbase}.ml|}]]
end
else [] in
let cmd = ["ocamlfind"]
@[if !opt then "ocamlopt" else "ocamlc"]
@["-predicates"; join"," predicates]
@["-package"; join "," packages]
@(if !verbose then ["-verbose"] else [])
@["-linkall"; "-linkpkg"; "-I" ; "+dynlink"]
@ link @ options
@[if !opt then "odyl.cmx" else "odyl.cmo"] in
if !verbose then Fmt.(pf stderr "%a\n%!" (list ~sep:(const string " ") string) cmd) ;
if not !noexecute then
match Unix.system (Filename.quote_command (List.hd cmd) (List.tl cmd)) with
WEXITED 0 -> ()
| WEXITED n ->
Fmt.(pf stderr "Maybe an error? Command exited with code %d\n%!" n) ;
Stdlib.exit n
| WSIGNALED n ->
Fmt.(pf stderr "Maybe an error? Command signaled (??) with code %d\n%!" n) ;
Stdlib.exit (-1)
| WSTOPPED n ->
Fmt.(pf stderr "Maybe an error? Command stopped (??) with code %d\n%!" n) ;
Stdlib.exit (-1)
(*
Unix.execvp "ocamlfind" (Array.of_list cmd)
*)
;;
let cmd = Sys.argv.(0) ;;
let argv = List.tl (Array.to_list Sys.argv) ;;
main cmd argv ;;
|
