# HG changeset patch # User Malcolm # Date 1738957164 -3600 # Fri Feb 07 20:39:24 2025 +0100 # Node ID a8e39ff533bd92f3b0a1b9a87a51935d63d4db13 # Parent bd30eeeb3e85b4b8490853ac2282d3c1b4ad1540 ADD Content based hashing diff --git a/files/build_Makefile.tmpl b/files/build_Makefile.tmpl --- a/files/build_Makefile.tmpl +++ b/files/build_Makefile.tmpl @@ -65,6 +65,4 @@ include ../../../Ocamlrules.mk.in -$(native_cmx) $(byte_cmo) $(neutral_cmi): ../../../pds.conf - -include .d diff --git a/files/pds.mk.tmpl b/files/pds.mk.tmpl --- a/files/pds.mk.tmpl +++ b/files/pds.mk.tmpl @@ -38,7 +38,7 @@ test-@type@: $(tests_@type@) @#tests-@ -@type@_@build_name@: @#deps@test-@type@_@dep_name@ @/deps@ +test-@type@_@build_name@: @#deps@@type@_@dep_name@ @/deps@ @/tests-@ @/builds-@ diff --git a/pds.mk b/pds.mk --- a/pds.mk +++ b/pds.mk @@ -1,69 +1,76 @@ .PHONY: all test clean docs -.PHONY: $(projects_release) $(projects_debug) $(projects_profile) +.PHONY: $(projects_release) +.PHONY: $(projects_clean_release) +.PHONY: $(tests_release) +.PHONY: $(tests_clean_release) +.PHONY: $(projects_debug) +.PHONY: $(projects_clean_debug) +.PHONY: $(tests_debug) +.PHONY: $(tests_clean_debug) +.PHONY: $(projects_profile) +.PHONY: $(projects_clean_profile) +.PHONY: $(tests_profile) +.PHONY: $(tests_clean_profile) .PHONY: $(projects_install) $(projects_doc) -.PHONY: $(tests_release) $(tests_debug) $(tests_profile) -.PHONY: $(projects_clean_release) $(projects_clean_debug) $(projects_clean_profile) -.PHONY: $(tests_clean_release) $(tests_clean_debug) $(tests_clean_profile) RELEASE_PROJECTS=pds pds_template snabela +RELEASE_TESTS= DEBUG_PROJECTS=pds pds_template snabela +DEBUG_TESTS= PROFILE_PROJECTS=pds pds_template snabela - -RELEASE_TESTS= -DEBUG_TESTS= PROFILE_TESTS= projects_release = $(RELEASE_PROJECTS:%=release_%) +projects_clean_release = $(RELEASE_PROJECTS:%=clean-release_%) projects_debug = $(DEBUG_PROJECTS:%=debug_%) +projects_clean_debug = $(DEBUG_PROJECTS:%=clean-debug_%) projects_profile = $(PROFILE_PROJECTS:%=profile_%) +projects_clean_profile = $(PROFILE_PROJECTS:%=clean-profile_%) + projects_install = $(RELEASE_PROJECTS:%=install_%) projects_docs = $(RELEASE_PROJECTS:%=docs_%) projects_remove = $(RELEASE_PROJECTS:%=remove_%) -projects_clean_release = $(RELEASE_PROJECTS:%=clean-release_%) -projects_clean_debug = $(DEBUG_PROJECTS:%=clean-debug_%) -projects_clean_profile = $(PROFILE_PROJECTS:%=clean-profile_%) -tests_release = $(RELEASE_TESTS:%=test-release_%) -tests_debug = $(DEBUG_TESTS:%=test-debug_%) -tests_profile = $(PROFILE_TESTS:%=test-profile_%) -tests_clean_release = $(RELEASE_TESTS:%=test-clean-release_%) -tests_clean_debug = $(DEBUG_TESTS:%=test-clean-debug_%) -tests_clean_profile = $(PROFILE_TESTS:%=test-clean-profile_%) +test_release = $(RELEASE_PROJECTS:%=test-release_%) +test_clean_release = $(RELEASE_PROJECTS:%=test-clean-release_%) +test_debug = $(DEBUG_PROJECTS:%=test-debug_%) +test_clean_debug = $(DEBUG_PROJECTS:%=test-clean-debug_%) +test_profile = $(PROFILE_PROJECTS:%=test-profile_%) +test_clean_profile = $(PROFILE_PROJECTS:%=test-clean-profile_%) all: release -release_snabela: +release: $(projects_release) + +release_pds: release_pds_template release_snabela release_pds_template: -release_pds: release_pds_template release_snabela +release_snabela: + +test-release: $(tests_release) + +debug: $(projects_debug) + +debug_pds: debug_pds_template debug_snabela + +debug_pds_template: debug_snabela: -debug_pds_template: - -debug_pds: debug_pds_template debug_snabela +test-debug: $(tests_debug) -profile_snabela: - -profile_pds_template: +profile: $(projects_profile) profile_pds: profile_pds_template profile_snabela -release: $(projects_release) - -debug: $(projects_debug) - -profile: $(projects_profile) +profile_pds_template: -install: $(projects_install) - -test: $(tests_release) - -test-debug: $(tests_debug) +profile_snabela: test-profile: $(tests_profile) + docs: $(projects_docs) remove: $(projects_remove) @@ -71,9 +78,9 @@ clean: -rm -rf build/docs -clean: $(projects_clean_release) $(projects_clean_debug) $(projects_clean_profile) +clean: $(projects_clean_release) $(projects_clean_debug) $(projects_clean_profile) -clean: $(tests_clean_release) $(tests_clean_debug) $(tests_clean_profile) +clean: $(tests_clean_release) $(tests_clean_debug) $(tests_clean_profile) $(projects_release): $(MAKE) \ @@ -85,13 +92,14 @@ $(MAKE) \ OCAMLPATH=$(shell pwd)/build/debug:$(OCAMLPATH) \ BUILD_DIR=$(shell pwd)/build/debug/$(patsubst debug_%,%,$@) \ - -C build/debug/$(patsubst debug_%,%,$@) debug + -C build/debug/$(patsubst debug_%,%,$@) $(projects_profile): $(MAKE) \ OCAMLPATH=$(shell pwd)/build/profile:$(OCAMLPATH) \ BUILD_DIR=$(shell pwd)/build/profile/$(patsubst profile_%,%,$@) \ - -C build/profile/$(patsubst profile_%,%,$@) profile + -C build/profile/$(patsubst profile_%,%,$@) + $(projects_install): $(projects_release) $(MAKE) -C build/release/$(patsubst install_%,%,$@) install @@ -99,13 +107,13 @@ $(tests_release): $(MAKE) \ OCAMLPATH=$(shell pwd)/build/release:$(OCAMLPATH) \ - BUILD_DIR=$(shell pwd)/build/test-release/$(patsubst profile_%,%,$@) \ + BUILD_DIR=$(shell pwd)/build/test-release/$(patsubst release_%,%,$@) \ -C build/test-release/$(patsubst test-release_%,%,$@) $(tests_debug): $(MAKE) \ OCAMLPATH=$(shell pwd)/build/debug:$(OCAMLPATH) \ - BUILD_DIR=$(shell pwd)/build/test-debug/$(patsubst profile_%,%,$@) \ + BUILD_DIR=$(shell pwd)/build/test-debug/$(patsubst debug_%,%,$@) \ -C build/test-debug/$(patsubst test-debug_%,%,$@) $(tests_profile): @@ -114,6 +122,7 @@ BUILD_DIR=$(shell pwd)/build/test-profile/$(patsubst profile_%,%,$@) \ -C build/test-profile/$(patsubst test-profile_%,%,$@) + $(projects_docs): $(projects_release) mkdir -p $(shell pwd)/build/docs/$(patsubst docs_%,%,$@) $(MAKE) \ @@ -142,6 +151,7 @@ BUILD_DIR=$(shell pwd)/build/profile/$(patsubst clean-profile_%,%,$@) \ -C build/profile/$(patsubst clean-profile_%,%,$@) clean + $(tests_clean_release): $(MAKE) \ OCAMLPATH=$(shell pwd)/build/release:$(OCAMLPATH) \ @@ -159,3 +169,4 @@ OCAMLPATH=$(shell pwd)/build/profile:$(OCAMLPATH) \ BUILD_DIR=$(shell pwd)/build/test-profile/$(patsubst test-clean-profile_%,%,$@) \ -C build/test-profile/$(patsubst test-clean-profile_%,%,$@) test-clean + diff --git a/src/pds/pds.ml b/src/pds/pds.ml --- a/src/pds/pds.ml +++ b/src/pds/pds.ml @@ -22,6 +22,113 @@ C.Arg.(value & flag & info [ "f"; "format" ] ~doc) end +module Hash_db = struct + let db_path = Filename.concat "build" "pds.db" + + let update_and_apply path_hashes = + let db = Sqlite3.db_open db_path in + let rc = + Sqlite3.exec + db + "create table if not exists hashes (path text primary key, hash text, modified_at text)" + in + assert (Sqlite3.Rc.is_success rc); + let rc = + Sqlite3.exec + db + "create table if not exists last_run (path text primary key, hash text, modified_at text)" + in + assert (Sqlite3.Rc.is_success rc); + List.iter + (fun (path, hash) -> + let hash = + Digest.to_hex @@ Digest.string ((Digest.to_hex @@ Digest.file path) ^ ":" ^ hash) + in + let modified_at = (Unix.stat path).Unix.st_mtime in + let stmt = + Sqlite3.prepare + db + "insert or replace into last_run (path, hash, modified_at) values (?, ?, \ + strftime('%FT%T', ?, 'unixepoch')) " + in + let rc = Sqlite3.bind_text stmt 1 path in + assert (Sqlite3.Rc.is_success rc); + let rc = Sqlite3.bind_text stmt 2 hash in + assert (Sqlite3.Rc.is_success rc); + let rc = Sqlite3.bind_double stmt 3 modified_at in + assert (Sqlite3.Rc.is_success rc); + let rc = Sqlite3.step stmt in + assert (Sqlite3.Rc.is_success rc); + ()) + path_hashes; + let stmt = + Sqlite3.prepare + db + "select lr.path, hashes.modified_at from last_run as lr inner join hashes on hashes.path = \ + lr.path where hashes.hash = lr.hash and lr.modified_at <> hashes.modified_at" + in + let rc, rows = + Sqlite3.fold + stmt + ~f:(fun acc row -> + match row with + | Sqlite3.Data.[| TEXT path; TEXT modified_at |] -> (path, modified_at) :: acc + | _ -> assert false) + ~init:[] + in + assert (Sqlite3.Rc.is_success rc); + List.iter + (fun (path, modified_at) -> + ignore (Unix.system (sprintf "touch -d '%s' %S" modified_at path))) + rows; + let stmt = Sqlite3.prepare db "select strftime('%FT%T')" in + let rc, rows = + Sqlite3.fold + stmt + ~f:(fun acc row -> + match row with + | Sqlite3.Data.[| TEXT datetime |] -> datetime :: acc + | _ -> assert false) + ~init:[] + in + assert (Sqlite3.Rc.is_success rc); + let datetime = + match rows with + | datetime :: _ -> datetime + | [] -> assert false + in + let stmt = + Sqlite3.prepare + db + "select lr.path from last_run as lr left join hashes on hashes.path = lr.path where \ + hashes.hash <> lr.hash" + in + let rc, rows = + Sqlite3.fold + stmt + ~f:(fun acc row -> + match row with + | Sqlite3.Data.[| TEXT path |] -> path :: acc + | _ -> assert false) + ~init:[] + in + assert (Sqlite3.Rc.is_success rc); + if rows <> [] then + ignore + (Unix.system + (sprintf "touch -d '%s' " datetime ^ String.concat " " (List.map (sprintf "%S") rows))); + let rc = + Sqlite3.exec + db + "insert or replace into hashes select lr.path as path, lr.hash as hash, lr.modified_at as \ + modified_at from last_run as lr left join hashes on hashes.path = lr.path where \ + hashes.path is null or lr.hash <> hashes.hash" + in + assert (Sqlite3.Rc.is_success rc); + ignore (Sqlite3.db_close db); + () +end + module Build = struct module Src = struct type typ = @@ -50,6 +157,53 @@ project_type : project_type; typ : typ; } + + let to_hash + { + build; + build_name; + build_type; + compile_deps; + deps; + extra_compiler_opts; + extra_makefile_lines; + extra_ocamldep_opts; + files; + install; + meta_linkopts; + project_type; + typ; + } = + Digest.to_hex + @@ Digest.string + @@ String.concat + ":" + [ + Bool.to_string build; + build_name; + build_type; + String.concat "," compile_deps; + String.concat "," deps; + extra_compiler_opts; + String.concat "\n" extra_makefile_lines; + extra_ocamldep_opts; + String.concat "," files; + Bool.to_string install; + meta_linkopts; + (match project_type with + | Ocaml -> "ocaml" + | Third_party -> "third-party"); + (match typ with + | Exec { install_cmd; remove_cmd } -> + String.concat + ":" + [ + "exec"; + Option.value ~default:"" install_cmd; + Option.value ~default:"" remove_cmd; + ] + | Library -> "library"); + ] end module Test = struct @@ -62,6 +216,22 @@ extra_makefile_lines : string list; files : string list; } + + let to_hash + { build; build_name; build_type; deps; extra_compiler_opts; extra_makefile_lines; files } = + Digest.to_hex + @@ Digest.string + @@ String.concat + ":" + [ + Bool.to_string build; + build_name; + build_type; + String.concat "," deps; + extra_compiler_opts; + String.concat "\n" extra_makefile_lines; + String.concat "," files; + ] end type t = { @@ -71,7 +241,11 @@ } let readdir dir = - Sys.readdir dir |> Array.to_list |> List.map (Filename.concat dir) |> List.sort String.compare + Sys.readdir dir + |> Array.to_list + |> List.map (Filename.concat dir) + |> List.filter Sys.is_regular_file + |> List.sort String.compare let compute_selector builds_conf = let path = Toml.Lenses.(key "global" |-- table |-- key "selector" |-- array |-- strings) in @@ -237,7 +411,7 @@ let lookup ~k conf = lookup ~selector ~global_prefix:"test-" ~build_type ~base:"tests" ~build_name:name ~k conf in - let files = readdir (Filename.concat src_dir name) in + let files = readdir (Filename.concat tests_dir name) in let module L = Toml.Lenses in let k k v = L.(v |-- k) in let build = lu true (lookup ~k:(k L.(key "build" |-- bool)) build_conf) in @@ -457,11 +631,11 @@ @@ String_set.of_list @@ List.filter (String.ends_with ~suffix:".mli") src_files in - let deps = String_set.of_list (deps @ compile_deps) in + let all_deps = String_set.of_list (deps @ compile_deps) in let internal_deps = - List.filter (fun { Build.Src.build_name; _ } -> String_set.mem build_name deps) srcs + List.filter (fun { Build.Src.build_name; _ } -> String_set.mem build_name all_deps) srcs in - let deps = String_set.to_list deps in + let deps = String_set.to_list @@ String_set.of_list deps in let external_targets = calculate_external_targets ".." internal_deps in let lib_modules = calculate_lib_modules mli_files in let non_lib_modules = calculate_non_lib_modules ml_files mli_files in @@ -597,7 +771,24 @@ (String_map.find build_type tests_by_type)) build_types; emit_pds_mk builds; - emit_ocamlrules_mk () + emit_ocamlrules_mk (); + let path_hashes = + List.flatten + @@ List.flatten + @@ [ + List.map + (fun ({ Build.Src.files; _ } as src) -> + let hash = Build.Src.to_hash src in + List.map (fun file -> (file, hash)) files) + srcs; + List.map + (fun ({ Build.Test.files; _ } as test) -> + let hash = Build.Test.to_hash test in + List.map (fun file -> (file, hash)) files) + tests; + ] + in + Hash_db.update_and_apply path_hashes let emit_formatted_builds { Build.srcs; _ } = List.iter @@ -628,7 +819,6 @@ tests let emit_formatted pds_conf = - emit_build pds_conf; let builds = Build.load pds_conf in emit_formatted_builds builds; emit_formatted_tests builds @@ -648,675 +838,3 @@ let main () = exit @@ Cmdliner.Cmd.eval cmd let () = main () - -(* module Lookup = struct *) -(* type t = { *) -(* build_type : string; *) -(* selector : string option; *) -(* builds_conf : Toml.Types.table; *) -(* } *) - -(* let rec lookup c = function *) -(* | [] -> None *) -(* | x :: xs -> ( *) -(* match Toml.Lenses.get c x with *) -(* | Some v -> Some v *) -(* | None -> lookup c xs) *) - -(* let build_lookup use_global test t build_name k typ = *) -(* let src_or_tests = if test then "tests" else "src" in *) -(* let selector = *) -(* (\* The variables for release builds do not have a build type in their key. *\) *) -(* match t.selector with *) -(* | Some selector when t.build_type = "release" -> *) -(* Toml.Lenses. *) -(* [ *) -(* key src_or_tests *) -(* |-- table *) -(* |-- key build_name *) -(* |-- table *) -(* |-- key "selector" *) -(* |-- table *) -(* |-- key selector *) -(* |-- table *) -(* |-- key k *) -(* |-- typ; *) -(* ] *) -(* | Some selector -> *) -(* (\* Search first with the specific build type, then the release selector *\) *) -(* Toml.Lenses. *) -(* [ *) -(* key src_or_tests *) -(* |-- table *) -(* |-- key build_name *) -(* |-- table *) -(* |-- key "selector" *) -(* |-- table *) -(* |-- key selector *) -(* |-- table *) -(* |-- key t.build_type *) -(* |-- table *) -(* |-- key k *) -(* |-- typ; *) -(* key src_or_tests *) -(* |-- table *) -(* |-- key build_name *) -(* |-- table *) -(* |-- key "selector" *) -(* |-- table *) -(* |-- key selector *) -(* |-- table *) -(* |-- key k *) -(* |-- typ; *) -(* ] *) -(* | None -> [] *) -(* in *) -(* let global_build_type = if test then "test-" ^ t.build_type else t.build_type in *) -(* let global = *) -(* Toml.Lenses.[ key "global" |-- table |-- key global_build_type |-- table |-- key k |-- typ ] *) -(* in *) -(* let default = *) -(* match t.build_type with *) -(* | "release" -> *) -(* Toml.Lenses.( *) -(* [ key src_or_tests |-- table |-- key build_name |-- table |-- key k |-- typ ] *) -(* @ if use_global then global else []) *) -(* | build_type -> *) -(* List.flatten *) -(* Toml.Lenses. *) -(* [ *) -(* [ *) -(* key src_or_tests *) -(* |-- table *) -(* |-- key build_name *) -(* |-- table *) -(* |-- key build_type *) -(* |-- table *) -(* |-- key k *) -(* |-- typ; *) -(* ]; *) -(* (if use_global then global else []); *) -(* [ key src_or_tests |-- table |-- key build_name |-- table |-- key k |-- typ ]; *) -(* ] *) -(* in *) -(* List.flatten [ selector; default ] *) - -(* let strings ?(use_global = false) ?(test = false) t build_name k = *) -(* lookup *) -(* t.builds_conf *) -(* (build_lookup use_global test t build_name k Toml.Lenses.(array |-- strings)) *) - -(* let string ?(use_global = false) ?(test = false) t build_name k = *) -(* lookup t.builds_conf (build_lookup use_global test t build_name k Toml.Lenses.string) *) - -(* let bool ?(use_global = false) ?(test = false) t build_name k = *) -(* lookup t.builds_conf (build_lookup use_global test t build_name k Toml.Lenses.bool) *) -(* end *) - -(* let apply_and_write_template tmpl_name out_name kv = *) -(* let tmpl = *) -(* Pds_template.read tmpl_name *) -(* |> CCOption.get_exn_or tmpl_name *) -(* |> Snabela.Template.of_utf8_string *) -(* |> CCResult.get_exn *) -(* |> CCFun.flip Snabela.of_template [] *) -(* in *) -(* match Snabela.apply tmpl kv with *) -(* | Ok s -> *) -(* let oc = open_out out_name in *) -(* output_string oc s; *) -(* close_out oc *) -(* | Error err -> *) -(* let err = Snabela.show_err err in *) -(* Printf.eprintf "Failed to apply template and write %s:\n" out_name; *) -(* Printf.eprintf "%s" err; *) -(* exit 1 *) - -(* let value_opt ~default = function *) -(* | Some v -> v *) -(* | None -> default *) - -(* let value_exn ~msg = function *) -(* | Some v -> v *) -(* | None -> failwith msg *) - -(* let endswith suffix str = *) -(* let suffix_len = String.length suffix in *) -(* let str_len = String.length str in *) -(* if str_len >= suffix_len then suffix = String.sub str (str_len - suffix_len) suffix_len else false *) - -(* let prepend_dir d fs = List.map (Filename.concat d) fs *) - -(* let path_concat = function *) -(* | [] -> assert false *) -(* | p :: ps -> List.fold_left Filename.concat p ps *) - -(* let mkdir_p = function *) -(* | [] -> assert false *) -(* | ds -> *) -(* ignore *) -(* (List.fold_left *) -(* (fun acc d -> *) -(* let acc = Filename.concat acc d in *) -(* try *) -(* Unix.mkdir acc 0o744; *) -(* acc *) -(* with Unix.Unix_error (Unix.EEXIST, "mkdir", _) -> acc) *) -(* "." *) -(* ds) *) - -(* let load_builds_conf pds_conf = *) -(* if Sys.file_exists pds_conf then Toml.Parser.(from_filename pds_conf |> unsafe) *) -(* else failwith (sprintf "Build config file, %s, must exist" pds_conf) *) - -(* let get_dirs d = *) -(* Sys.readdir d |> Array.to_list |> List.filter (fun f -> Sys.is_directory (Filename.concat d f)) *) - -(* (\* *) -(* * Builds are directories in the src directory *) -(* *\) *) -(* let get_builds () = Build_set.of_list (get_dirs src_dir) *) - -(* (\* *) -(* * Tests are directories in the tests dir *) -(* *\) *) -(* let get_tests () = *) -(* if Sys.file_exists tests_dir then Build_set.of_list (get_dirs tests_dir) else Build_set.empty *) - -(* (\* *) -(* * Project types can be third-party, which involves doing nothing wiht them *) -(* * or ocaml which pds generates configs for. *) -(* *\) *) -(* let get_project_type builds_conf build = *) -(* let project_type = *) -(* Toml.Lenses.(key "src" |-- table |-- key build |-- table |-- key "project_type" |-- string) *) -(* in *) -(* match Toml.Lenses.get builds_conf project_type with *) -(* | Some "third-party" -> `Third_party *) -(* | Some "ocaml" | None -> `Ocaml *) -(* | Some project_type -> *) -(* failwith (sprintf "Unknown project type %s for build %s" project_type build) *) - -(* (\* *) -(* * For ocaml projects, a build can be a library or an executable *) -(* *\) *) -(* let get_project_target_type builds_conf build = *) -(* let build_type = *) -(* Toml.Lenses.(key "src" |-- table |-- key build |-- table |-- key "type" |-- string) *) -(* in *) -(* match get_project_type builds_conf build with *) -(* | `Ocaml -> ( *) -(* match Toml.Lenses.get builds_conf build_type with *) -(* | Some "exec" -> `Exec *) -(* | Some "library" | None -> `Library *) -(* | Some build_type -> failwith (sprintf "Unknown build type %s for build %s" build_type build)) *) -(* | `Third_party -> failwith (sprintf "Third party project %s has no build type" build) *) - -(* let string_of_project_target_type = function *) -(* | `Exec -> "exec" *) -(* | `Library -> "library" *) - -(* let string_of_project_type = function *) -(* | `Ocaml -> "ocaml" *) -(* | `Third_party -> "third-party" *) - -(* let string_of_deps = String.concat "," *) - -(* let compute_selector builds_conf = *) -(* let path = Toml.Lenses.(key "global" |-- table |-- key "selector" |-- array |-- strings) in *) -(* match Toml.Lenses.(get builds_conf path) with *) -(* | Some (cmd :: args) -> ( *) -(* match Process.read_stdout cmd (Array.of_list args) with *) -(* | [] -> failwith "Selector produced empty output" *) -(* | [ selector; "" ] | [ selector ] -> *) -(* (\* TODO Verify the selector has a valid name *\) *) -(* Some selector *) -(* | _ -> failwith "Selector produced more than one line of output.") *) -(* | Some [] -> failwith "Selector cannot be an empty list." *) -(* | None -> None *) - -(* (\* *) -(* * A "lib module" is one which has a .mli file. Since any .mli file needs to *) -(* * have a .ml file associated with it, we just take the .mli files and replace *) -(* * the end with .ml. *) -(* *\) *) -(* let calculate_lib_modules mli_files = *) -(* mli_files |> File_set.elements |> List.map (fun f -> Filename.chop_extension f ^ ".ml") *) - -(* let calculate_non_lib_modules ml_files mli_files = *) -(* let lib_modules_set = File_set.of_list (calculate_lib_modules mli_files) in *) -(* File_set.elements (File_set.diff ml_files lib_modules_set) *) - -(* let calculate_byte_target name = function *) -(* | `Library -> name ^ ".cma" *) -(* | `Exec -> name ^ ".byte" *) - -(* let calculate_native_target name = function *) -(* | `Library -> name ^ ".cmxa" *) -(* | `Exec -> name ^ ".native" *) - -(* let get_ocaml_targets builds_conf b = *) -(* match get_project_type builds_conf b with *) -(* | `Ocaml -> *) -(* let build_type = get_project_target_type builds_conf b in *) -(* [ calculate_byte_target b build_type; calculate_native_target b build_type ] *) -(* | `Third_party -> [] *) - -(* let calculate_external_targets build_base_dir builds_conf internal_deps = *) -(* internal_deps *) -(* |> Build_set.elements *) -(* |> List.map (fun b -> (b, get_ocaml_targets builds_conf b)) *) -(* |> List.map (fun (b, targets) -> *) -(* let path = Filename.concat build_base_dir b in *) -(* List.map (Filename.concat path) targets) *) -(* |> List.concat *) -(* |> File_set.of_list *) - -(* let get_should_build ?test lookup build = *) -(* value_opt ~default:true (Lookup.bool ?test lookup build "build") *) - -(* let get_build_deps lookup build = *) -(* Build_set.of_list (value_opt ~default:[] (Lookup.strings lookup build "deps")) *) - -(* let get_compile_build_deps lookup build = *) -(* Build_set.of_list (value_opt ~default:[] (Lookup.strings lookup build "compile_deps")) *) - -(* let get_meta_linkopts lookup build = *) -(* value_opt ~default:"" (Lookup.string ~use_global:true lookup build "meta_linkopts") *) - -(* let get_test_deps lookup test = *) -(* Build_set.of_list (value_opt ~default:[] (Lookup.strings ~test:true lookup test "deps")) *) - -(* (\* Takes the type of the build (release, debug, etc) and the project type (exec *) -(* or library), and the entire build configuration, and finally the name of the *) -(* build being processed. *) - -(* The output of this is a makefile in the appropriate build directory *) -(* (build///Makefile). *\) *) -(* let emit_ocaml_build lookup project_type build = *) -(* (\* This is the directory we will use to build the makefile *\) *) -(* let src_path = path_concat [ src_dir; build ] in *) -(* (\* This is the directory that will appear in the makefile *\) *) -(* let src_dir = path_concat [ ".."; ".."; ".."; src_dir; build ] in *) -(* let build_base_dir = Filename.concat build_dir lookup.Lookup.build_type in *) -(* let build_output_dir = Filename.concat build_base_dir build in *) -(* let src_files = Array.to_list (Sys.readdir src_path) in *) -(* let ml_files = File_set.of_list (List.filter (endswith ".ml") src_files) in *) -(* let mli_files = File_set.of_list (List.filter (endswith ".mli") src_files) in *) -(* let deps = get_build_deps lookup build in *) -(* let internal_deps = Build_set.inter deps (get_builds ()) in *) -(* let external_targets = calculate_external_targets ".." lookup.Lookup.builds_conf internal_deps in *) -(* let lib_modules = calculate_lib_modules mli_files in *) -(* let non_lib_modules = calculate_non_lib_modules ml_files mli_files in *) -(* let byte_target = calculate_byte_target build project_type in *) -(* let native_target = calculate_native_target build project_type in *) -(* let extra_compiler_opts = *) -(* value_opt ~default:"" (Lookup.string ~use_global:true lookup build "extra_compiler_opts") *) -(* in *) -(* let extra_ocamldep_opts = *) -(* value_opt ~default:"" (Lookup.string ~use_global:true lookup build "extra_ocamldep_opts") *) -(* in *) -(* let meta_linkopts = get_meta_linkopts lookup build in *) -(* let packages_str = String.concat " " (Build_set.elements deps) in *) -(* let packages = *) -(* List.map (fun n -> Snabela.Kv.(Map.of_list [ ("name", string n) ])) (Build_set.elements deps) *) -(* in *) -(* let non_lib_modules = *) -(* List.map (fun n -> Snabela.Kv.(Map.of_list [ ("name", string n) ])) non_lib_modules *) -(* in *) -(* let lib_modules = *) -(* List.map (fun n -> Snabela.Kv.(Map.of_list [ ("name", string n) ])) lib_modules *) -(* in *) -(* let external_deps = *) -(* List.map *) -(* (fun n -> Snabela.Kv.(Map.of_list [ ("name", string n) ])) *) -(* (File_set.elements external_targets) *) -(* in *) -(* let install = *) -(* value_exn *) -(* ~msg:(Printf.sprintf "%s is missing an 'install' key, which is required" build) *) -(* (Lookup.bool lookup build "install") *) -(* in *) -(* let project_target_type = get_project_target_type lookup.Lookup.builds_conf build in *) -(* let install_cmd = *) -(* match (project_target_type, install) with *) -(* | `Exec, true -> *) -(* value_exn *) -(* ~msg:"Installing executables requires an install_cmd" *) -(* (Lookup.string lookup build "install_cmd") *) -(* | _ -> "" *) -(* in *) -(* let remove_cmd = *) -(* match (project_target_type, install) with *) -(* | `Exec, true -> *) -(* value_exn *) -(* ~msg:"Installing executables requires a remove_cmd" *) -(* (Lookup.string lookup build "remove_cmd") *) -(* | _ -> "" *) -(* in *) -(* let extra_makefile_lines = *) -(* List.map *) -(* (fun l -> Snabela.Kv.(Map.of_list [ ("line", string l) ])) *) -(* (value_opt ~default:[] (Lookup.strings lookup build "extra_makefile_lines")) *) -(* in *) -(* let kv = *) -(* Snabela.Kv.( *) -(* Map.of_list *) -(* [ *) -(* ("native_byte_in_serial", bool (non_lib_modules <> [])) *) -(* (\* If there are any non_lib_modules then make the build *) -(* native and byte in serial. This is because *) -(* generating .cmi's will conflict if they are *) -(* generated in parallel. *\); *) -(* ("src_dir", string src_dir); *) -(* ("packages", list packages); *) -(* ("packages_str", string packages_str); *) -(* ("lib_modules", list lib_modules); *) -(* ("non_lib_modules", list non_lib_modules); *) -(* ("external_deps", list external_deps); *) -(* ("byte_target", string byte_target); *) -(* ("native_target", string native_target); *) -(* ("extra_compiler_opts", string extra_compiler_opts); *) -(* ("extra_ocamldep_opts", string extra_ocamldep_opts); *) -(* ( "target_type", *) -(* string *) -(* (string_of_project_target_type *) -(* (get_project_target_type lookup.Lookup.builds_conf build)) ); *) -(* ("meta_linkopts", string meta_linkopts); *) -(* ("install", bool install); *) -(* ("library", bool (project_target_type = `Library)); *) -(* ("exec", bool (project_target_type = `Exec)); *) -(* ("install_cmd", string install_cmd); *) -(* ("remove_cmd", string remove_cmd); *) -(* ("extra_makefile_lines", list extra_makefile_lines); *) -(* ]) *) -(* in *) -(* apply_and_write_template build_makefile_tmpl (Filename.concat build_output_dir "Makefile") kv *) - -(* let emit_third_party_build lookup build = *) -(* let src_dir = path_concat [ ".."; ".."; ".."; src_dir; build ] in *) -(* let oc = open_out (path_concat [ "build"; lookup.Lookup.build_type; build; "Makefile" ]) in *) -(* output_string oc (String.concat "\n\n" [ "SRC_DIR=" ^ src_dir; "include $(SRC_DIR)/Makefile" ]); *) -(* close_out oc *) - -(* let emit_build lookup build = *) -(* match get_project_type lookup.Lookup.builds_conf build with *) -(* | `Third_party -> *) -(* mkdir_p [ "build"; lookup.Lookup.build_type; build ]; *) -(* emit_third_party_build lookup build *) -(* | `Ocaml -> *) -(* mkdir_p [ "build"; lookup.Lookup.build_type; build ]; *) -(* emit_ocaml_build lookup (get_project_target_type lookup.Lookup.builds_conf build) build *) - -(* let emit_builds lookup = *) -(* let src = *) -(* value_exn *) -(* ~msg:"Missing 'src' section of config" *) -(* Toml.Lenses.(get lookup.Lookup.builds_conf (key "src" |-- table)) *) -(* in *) -(* Toml.Types.Table.( *) -(* iter *) -(* (fun build _ -> *) -(* if get_should_build lookup (Key.to_string build) then *) -(* emit_build lookup (Key.to_string build)) *) -(* src) *) - -(* let test_build_name s = "test-" ^ s *) - -(* (\* *) -(* * Emit a test Makefile. Like emiting an ocaml makefile, this does some *) -(* * dependency calculation, specifically so th test gets rebuilt if one of the *) -(* * things it depends on changes. *) -(* *\) *) -(* let emit_test_makefile lookup test = *) -(* let src_dir = path_concat [ ".."; ".."; ".."; tests_dir; test ] in *) -(* let src_path = Filename.concat tests_dir test in *) -(* let files = Sys.readdir src_path |> Array.to_list |> List.filter (endswith ".ml") in *) -(* let deps = get_test_deps lookup test in *) -(* let internal_deps = Build_set.inter deps (get_builds ()) in *) -(* let external_targets = *) -(* calculate_external_targets *) -(* (path_concat [ ".."; ".."; lookup.Lookup.build_type ]) *) -(* lookup.Lookup.builds_conf *) -(* internal_deps *) -(* in *) -(* let extra_compiler_opts = *) -(* value_opt ~default:"" (Lookup.string ~test:true lookup test "extra_compiler_opts") *) -(* in *) -(* let packages_str = String.concat " " (Build_set.elements deps) in *) -(* let packages = *) -(* List.map (fun n -> Snabela.Kv.(Map.of_list [ ("name", string n) ])) (Build_set.elements deps) *) -(* in *) -(* let files = List.map (fun n -> Snabela.Kv.(Map.of_list [ ("name", string n) ])) files in *) -(* let external_deps = *) -(* List.map *) -(* (fun n -> Snabela.Kv.(Map.of_list [ ("name", string n) ])) *) -(* (File_set.elements external_targets) *) -(* in *) -(* let extra_makefile_lines = *) -(* List.map *) -(* (fun l -> Snabela.Kv.(Map.of_list [ ("line", string l) ])) *) -(* (value_opt ~default:[] (Lookup.strings ~test:true lookup test "extra_makefile_lines")) *) -(* in *) -(* let kv = *) -(* Snabela.Kv.( *) -(* Map.of_list *) -(* [ *) -(* ("src_dir", string src_dir); *) -(* ("packages", list packages); *) -(* ("packages_str", string packages_str); *) -(* ("test_modules", list files); *) -(* ("external_deps", list external_deps); *) -(* ("extra_compiler_opts", string extra_compiler_opts); *) -(* ("extra_makefile_lines", list extra_makefile_lines); *) -(* ]) *) -(* in *) -(* apply_and_write_template *) -(* test_makefile_tmpl *) -(* (path_concat [ "build"; test_build_name lookup.Lookup.build_type; test; "Makefile" ]) *) -(* kv *) - -(* let emit_tests lookup tests = *) -(* Build_set.iter *) -(* (fun test -> *) -(* if get_should_build ~test:true lookup test then ( *) -(* mkdir_p [ "build"; test_build_name lookup.Lookup.build_type; test ]; *) -(* emit_test_makefile lookup test)) *) -(* tests *) - -(* let make_pds_mk_builds_kv lookup builds = *) -(* Build_set.fold *) -(* (fun b acc -> *) -(* let deps = get_build_deps lookup b in *) -(* let internal_deps = Build_set.inter deps (get_builds ()) in *) -(* let all_deps = Build_set.union internal_deps (get_compile_build_deps lookup b) in *) -(* let deps_list = *) -(* List.map *) -(* (fun d -> *) -(* let name = sprintf "%s_%s" lookup.Lookup.build_type d in *) -(* Snabela.Kv.(Map.of_list [ ("name", string name) ])) *) -(* (Build_set.elements all_deps) *) -(* in *) -(* let build = *) -(* Snabela.Kv.( *) -(* Map.of_list *) -(* [ *) -(* ("build", string (sprintf "%s_%s" lookup.Lookup.build_type b)); *) -(* ("deps", list deps_list); *) -(* ]) *) -(* in *) -(* build :: acc) *) -(* builds *) -(* [] *) - -(* let make_pds_mk_tests_kv lookup tests = *) -(* Build_set.fold *) -(* (fun t acc -> *) -(* let deps = get_test_deps lookup t in *) -(* let internal_deps = Build_set.inter deps (get_builds ()) in *) -(* let deps_list = *) -(* List.map *) -(* (fun d -> *) -(* let name = sprintf "%s_%s" lookup.Lookup.build_type d in *) -(* Snabela.Kv.(Map.of_list [ ("name", string name) ])) *) -(* (Build_set.elements internal_deps) *) -(* in *) -(* let test = *) -(* Snabela.Kv.( *) -(* Map.of_list *) -(* [ *) -(* ("build", string (sprintf "test-%s_%s" lookup.Lookup.build_type t)); *) -(* ("deps", list deps_list); *) -(* ]) *) -(* in *) -(* test :: acc) *) -(* tests *) -(* [] *) - -(* let compute_projects ?(test = false) lookup builds = *) -(* List.map *) -(* (fun n -> *) -(* let build = value_opt ~default:true (Lookup.bool ~test lookup n "build") in *) -(* Snabela.Kv.(Map.of_list [ ("name", string n); ("build", bool build) ])) *) -(* (Build_set.elements builds) *) - -(* (\* *) -(* * pds.mk orchestrate running tests and building. This contains all of the *) -(* * dependency information between builds, which order they should be built in, *) -(* * etc. *) -(* *\) *) -(* let emit_pds_mk builds_conf selector = *) -(* let builds = get_builds () in *) -(* let tests = get_tests () in *) -(* let release_builds, test_release_builds = *) -(* let lookup = Lookup.{ build_type = "release"; selector; builds_conf } in *) -(* (make_pds_mk_builds_kv lookup builds, make_pds_mk_tests_kv lookup tests) *) -(* in *) -(* let debug_builds, test_debug_builds = *) -(* let lookup = Lookup.{ build_type = "debug"; selector; builds_conf } in *) -(* (make_pds_mk_builds_kv lookup builds, make_pds_mk_tests_kv lookup tests) *) -(* in *) -(* let profile_builds, test_profile_builds = *) -(* let lookup = Lookup.{ build_type = "profile"; selector; builds_conf } in *) -(* (make_pds_mk_builds_kv lookup builds, make_pds_mk_tests_kv lookup tests) *) -(* in *) -(* let release_projects, release_tests = *) -(* let lookup = Lookup.{ build_type = "release"; selector; builds_conf } in *) -(* (compute_projects lookup builds, compute_projects ~test:true lookup tests) *) -(* in *) -(* let debug_projects, debug_tests = *) -(* let lookup = Lookup.{ build_type = "debug"; selector; builds_conf } in *) -(* (compute_projects lookup builds, compute_projects ~test:true lookup tests) *) -(* in *) -(* let profile_projects, profile_tests = *) -(* let lookup = Lookup.{ build_type = "profile"; selector; builds_conf } in *) -(* (compute_projects lookup builds, compute_projects ~test:true lookup tests) *) -(* in *) -(* let kv = *) -(* Snabela.Kv.( *) -(* Map.of_list *) -(* [ *) -(* ("release_projects", list release_projects); *) -(* ("debug_projects", list debug_projects); *) -(* ("profile_projects", list profile_projects); *) -(* ("release_tests", list release_tests); *) -(* ("debug_tests", list debug_tests); *) -(* ("profile_tests", list profile_tests); *) -(* ("release_builds", list release_builds); *) -(* ("debug_builds", list debug_builds); *) -(* ("profile_builds", list profile_builds); *) -(* ("test_release_builds", list test_release_builds); *) -(* ("test_debug_builds", list test_debug_builds); *) -(* ("test_profile_builds", list test_profile_builds); *) -(* ]) *) -(* in *) -(* apply_and_write_template pds_mk_tmpl "pds.mk" kv *) - -(* let emit_ocamlrules_mk () = *) -(* let oc = open_out ocamlrules_mk in *) -(* output_string oc (value_exn ~msg:"Could not load Ocamlrules.mk" (Pds_template.read ocamlrules_mk)); *) -(* close_out oc *) - -(* let assert_builds_in_builds_conf builds builds_conf = *) -(* Build_set.iter *) -(* (fun b -> *) -(* ignore *) -(* (value_exn *) -(* ~msg:(sprintf "Missing build %s in config" b) *) -(* Toml.Lenses.(get builds_conf (key "src" |-- table |-- key b |-- table)))) *) -(* builds *) - -(* let emit_makefiles pds_conf = *) -(* let builds_conf = load_builds_conf pds_conf in *) -(* let selector = compute_selector builds_conf in *) -(* let builds = get_builds () in *) -(* let tests = get_tests () in *) -(* assert_builds_in_builds_conf builds builds_conf; *) -(* List.iter *) -(* (fun build_type -> *) -(* let lookup = Lookup.{ build_type; selector; builds_conf } in *) -(* emit_builds lookup; *) -(* emit_tests lookup tests) *) -(* [ "release"; "debug"; "profile" ]; *) -(* emit_pds_mk builds_conf selector; *) -(* emit_ocamlrules_mk () *) - -(* let emit_formatted_builds builds_conf selector = *) -(* let builds = get_builds () in *) -(* Build_set.iter *) -(* (fun b -> *) -(* let project_target_type_str = *) -(* match get_project_type builds_conf b with *) -(* | `Ocaml -> string_of_project_target_type (get_project_target_type builds_conf b) *) -(* | `Third_party -> "" *) -(* in *) -(* let lookup = Lookup.{ build_type = "release"; selector; builds_conf } in *) -(* if get_should_build lookup b then *) -(* print_endline *) -(* (String.concat *) -(* "\t" *) -(* [ *) -(* "src"; *) -(* b; *) -(* project_target_type_str; *) -(* string_of_project_type (get_project_type builds_conf b); *) -(* string_of_deps (Build_set.elements (get_build_deps lookup b)); *) -(* ])) *) -(* builds *) - -(* let emit_formatted_tests builds_conf selector = *) -(* let tests = get_tests () in *) -(* let lookup = Lookup.{ build_type = "release"; selector; builds_conf } in *) -(* Build_set.iter *) -(* (fun t -> *) -(* if get_should_build ~test:true lookup t then *) -(* print_endline *) -(* (String.concat *) -(* "\t" *) -(* [ "test"; t; string_of_deps (Build_set.elements (get_test_deps lookup t)) ])) *) -(* tests *) - -(* let emit_formatted pds_conf = *) -(* emit_makefiles pds_conf; *) -(* let builds_conf = load_builds_conf pds_conf in *) -(* let selector = compute_selector builds_conf in *) -(* emit_formatted_builds builds_conf selector; *) -(* emit_formatted_tests builds_conf selector *) - -(* let generate_makefiles = function *) -(* | true -> *) -(* (\* Format *\) *) -(* emit_formatted "pds.conf" *) -(* | false -> *) -(* (\* Don't format *\) *) -(* emit_makefiles "pds.conf" *) - -(* let cmd = *) -(* let doc = "Emit build configs" in *) -(* Cmdliner.( *) -(* Cmd.v *) -(* (Cmd.info "pds" ~doc ~exits:Cmd.Exit.defaults) *) -(* Term.(const generate_makefiles $ Cmdline.format)) *) - -(* let main () = exit @@ Cmdliner.Cmd.eval cmd *) -(* let () = main () *)