ligo/js-utils/gen_install.ml

103 lines
2.7 KiB
OCaml
Raw Normal View History

2016-01-12 21:20:06 +04:00
(* Generate <package>.install from setup.log *)
#use "install_tags.ml"
module String_map = Map.Make(String)
let string_map_of_list =
List.fold_left
(fun acc (k, v) ->
assert (not (String_map.mem k acc));
String_map.add k v acc)
String_map.empty
let lines_of_file fn =
let ic = open_in fn in
let rec loop acc =
match input_line ic with
| exception End_of_file ->
close_in ic;
List.rev acc
| line ->
loop (line :: acc)
in
loop []
let read_setup_log () =
lines_of_file "setup.log"
|> List.map (fun line -> Scanf.sscanf line "%S %S" (fun tag arg -> (tag, arg)))
let read_setup_data () =
lines_of_file "setup.data"
|> List.map (fun line -> Scanf.sscanf line "%[^=]=%S" (fun k v -> (k, v)))
let remove_cwd =
let prefix = Sys.getcwd () ^ "/" in
let len_prefix = String.length prefix in
fun fn ->
let len = String.length fn in
if len >= len_prefix && String.sub fn 0 len_prefix = prefix then
String.sub fn len_prefix (len - len_prefix)
else
fn
let gen_section oc name files =
let pr fmt = Printf.fprintf oc (fmt ^^ "\n") in
pr "%s: [" name;
List.iter
(fun (src, dst) ->
let src = remove_cwd src in
let dst =
match dst with
| None -> Filename.basename src
| Some fn -> fn
in
if src = dst then
pr " %S" src
else
pr " %S {%S}" src dst)
files;
pr "]"
let rec filter_log tags log acc =
match log with
| [] -> acc
| (tag, fname) :: rest ->
match String_map.find tag tags with
| exception Not_found -> filter_log tags rest acc
| dst -> filter_log tags rest ((fname, dst) :: acc)
let () =
let log = read_setup_log () in
let setup_data = read_setup_data () in
let ext_dll =
match List.assoc "ext_dll" setup_data with
| ext -> ext
| exception Not_found -> ".so"
in
let merge name files map =
match String_map.find name map with
| files' -> String_map.add name (files @ files') map
| exception Not_found -> String_map.add name files map
in
let sections =
List.fold_left
(fun acc (name, tags, extra_files) ->
let tags = string_map_of_list tags in
let files = filter_log tags log [] @ extra_files in
if name = "lib" then
let stubs, others =
List.partition
(fun (fn, _) -> Filename.check_suffix fn ext_dll)
files
in
merge "lib" others (merge "stublibs" stubs acc)
else
merge name files acc)
String_map.empty sections
|> String_map.bindings
|> List.filter (fun (_, l) -> l <> [])
in
let oc = open_out (package_name ^ ".install") in
List.iter (fun (name, files) -> gen_section oc name files) sections;
close_out oc