File: modules.ml

package info (click to toggle)
lwt 2.7.1-7
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 2,436 kB
  • sloc: ml: 25,127; ansic: 4,725; makefile: 82
file content (124 lines) | stat: -rw-r--r-- 4,009 bytes parent folder | download
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
(* This script fills in debian/*.install files, based on dispatching
   of *.cma files. *)

#use "topfind";;
#require "unix";;
#require "pcre";;

let dll_dir = Sys.getenv "OCAML_DLL_DIR"
let is_native = Sys.getenv "OCAML_HAVE_OCAMLOPT" = "yes"
let has_natdynlink = Sys.getenv "OCAML_NATDYNLINK" = "yes"

let dh_verbose =
  if (try Sys.getenv "DH_VERBOSE" = "1" with Not_found -> false) then
    (fun fmt -> Printf.printf fmt)
  else
    (fun fmt -> Printf.ifprintf stderr fmt)

let is_private = function
  | "Pa_lwt_options"
  | "Lwt_log_rules"
  | "Lwt_ocaml_completion"
  | "Lwt_simple_top"
  | "Lwt_unix_jobs_generated"
  | "Lwt_config"
    -> true
  | _ -> false

let suffix = function
  | "lwt-glib" -> "-glib"
  | "lwt-react" -> ""
  | "lwt-ssl" -> "-ssl"
  | "lwt-extra" -> ""
  | "lwt-syntax-log" -> ""
  | "lwt-text" -> ""
  | "lwt-syntax-options" -> ""
  | "lwt-unix" -> ""
  | "lwt-syntax" -> ""
  | "lwt-top" -> ""
  | "lwt-preemptive" -> ""
  | "lwt-simple-top" -> ""
  | "lwt" -> ""
  | "ppx" -> ""
  | "lwt-log" -> ""
  | _ -> assert false

let chop_prefix x =
  let n = String.length x in
  assert (n > 10 && String.sub x 0 10 = "debian/tmp");
  String.sub x 10 (n-10)

exception Objinfo_error of string * Unix.process_status

let split_dll =
  let rex = Pcre.regexp " *-l" in
  fun line -> List.tl (Pcre.split ~rex line)

let print_cma cma =
  let component = suffix (Filename.chop_suffix (Filename.basename cma) ".cma") in
  let () = dh_verbose "Generating module data for %s, going to lwt%s...\n%!" cma component in
  let flags = [Open_creat; Open_append] in
  let dev = open_out_gen flags 0o644 (Printf.sprintf "debian/liblwt%s-ocaml-dev.install" component) in
  let runtime = open_out_gen flags 0o644 (Printf.sprintf "debian/liblwt%s-ocaml.install" component) in
  let () = Printf.fprintf runtime "%s\n" (chop_prefix cma) in
  let () =
    let x = Filename.chop_suffix cma ".cma" in
    if is_native then (
      Printf.fprintf dev "%s\n" (chop_prefix x ^ ".cmxa");
      Printf.fprintf dev "%s\n" (chop_prefix x ^ ".a");
    );
    if has_natdynlink then (
      Printf.fprintf runtime "%s\n" (chop_prefix x ^ ".cmxs");
    );
  in
  let dlls, modules =
    let objinfo = Printf.ksprintf Unix.open_process_in "ocamlobjinfo %s | sed -nr 's/^(Unit name|Extra dynamically.*): //p'" cma in
    let close () = match Unix.close_process_in objinfo with
      | Unix.WEXITED 0 -> ()
      | r -> raise (Objinfo_error (cma, r))
    in
    let rec slurp accu =
      match (try Some (input_line objinfo) with End_of_file -> close (); None) with
        | Some x -> slurp (x::accu)
        | None -> accu
    in match List.rev (slurp []) with
      | x::xs when String.length x > 1 && x.[0] = '-' -> split_dll x, xs
      | xs -> [], xs
  in
  let dirname = Filename.dirname cma in
  let print_module mname =
    let m = Filename.concat dirname (String.uncapitalize_ascii mname) in
    if is_native then Printf.fprintf dev "%s\n" (chop_prefix (m^".cmx"));
    if not (is_private mname) then (
      Printf.fprintf dev "%s\n" (chop_prefix (m^".cmi"));
      Printf.fprintf dev "%s\n" (chop_prefix (m^".mli"));
      Printf.fprintf dev "%s\n" (chop_prefix (m^".cmt"));
      Printf.fprintf dev "%s\n" (chop_prefix (m^".cmti"));
      Printf.fprintf dev "%s\n" (chop_prefix (m^".annot"));
    )
  in
  let print_dll m =
    let b = chop_prefix dirname in
    Printf.fprintf runtime "%s %s\n" (Filename.concat b ("dll"^m^".so")) dll_dir;
    Printf.fprintf dev "%s\n" (Filename.concat b ("lib"^m^".a"))
  in
  List.iter print_module modules;
  List.iter print_dll dlls;
  close_out dev;
  close_out runtime
;;

let find_cmas dir =
  let ic = Printf.ksprintf Unix.open_process_in "find %s -name '*.cma'" dir in
  let rec loop accu =
    match input_line ic with
    | exception End_of_file -> accu
    | line -> loop (line :: accu)
  in
  let r = loop [] in
  match Unix.close_process_in ic with
  | Unix.WEXITED 0 -> r
  | _ -> failwith "find failed"
;;

List.iter print_cma (find_cmas "debian/tmp");;