From 84fae96b1692b1cd8325b31c8995f22ee9b49be4 Mon Sep 17 00:00:00 2001 From: milner Date: Sun, 24 Jul 2022 18:55:09 +0000 Subject: [PATCH] refactor(lib): delete the code nothing reaches --- bin/meowc.ml | 4 +--- lib/ast.ml | 2 -- lib/build.ml | 8 ++------ lib/diag.ml | 1 - lib/eval.ml | 12 ++---------- lib/exec.ml | 48 ------------------------------------------------ lib/graph.ml | 5 ++--- lib/parse.ml | 5 ----- lib/resolve.ml | 2 -- lib/style.ml | 1 - lib/types.ml | 3 --- 11 files changed, 7 insertions(+), 84 deletions(-) diff --git a/bin/meowc.ml b/bin/meowc.ml index dd7bc43..4c38a59 100644 --- a/bin/meowc.ml +++ b/bin/meowc.ml @@ -358,10 +358,8 @@ let cmd_targets () = banner p; List.iter (fun (t : target) -> - let tag, paint = Build.tag_of t.kind in - ignore tag; Printf.printf " %s%s%s%s\n" - (paint (Style.pad 9 (kind_name t.kind))) + (Build.paint (Build.tag_of t.kind) (Style.pad 9 (kind_name t.kind))) (Style.pad 22 t.name) (Style.pad 20 (Style.dim (Style.plural (List.length (all_srcs t)) "source"))) (Style.dim (if t.uses = [] then "" else "uses " ^ String.concat " " t.uses))) diff --git a/lib/ast.ml b/lib/ast.ml index 685427d..ae63562 100644 --- a/lib/ast.ml +++ b/lib/ast.ml @@ -41,5 +41,3 @@ type stmt = | ConfigHeader of value | Message of value * value list | Blk of block - -let v text span = { text; span; quoted = false } diff --git a/lib/build.ml b/lib/build.ml index c6182aa..94a37bf 100644 --- a/lib/build.ml +++ b/lib/build.ml @@ -89,11 +89,7 @@ let link_cmd p (t : target) objs = | Bin | Test -> Array.of_list (((driver :: objs) @ [ "-o"; out ]) @ link_libs p t @ t.ldflags @ p.tc.ldflags @ p.tc.xflags) -let tag_of = function - | Lib -> ("ar", Style.magenta) - | Shared -> ("so", Style.cyan) - | Bin -> ("ld", Style.green) - | Test -> ("ld", Style.green) +let tag_of = function Lib -> "ar" | Shared -> "so" | Bin | Test -> "ld" let is_header f = List.mem (String.lowercase_ascii (Filename.extension f)) [ ".h"; ".hh"; ".hpp"; ".hxx"; ".inc" ] @@ -128,7 +124,7 @@ let of_project p = (all_srcs t) in let out = out_of p t in - let tag, _ = tag_of t.kind in + let tag = tag_of t.kind in let ins = objs @ List.map (fun (d : target) -> out_of p d) (deps_of p t) in let label = match t.kind with Lib | Shared -> Filename.basename out | _ -> t.name in let outs = out :: Option.to_list (implib_of p t) in diff --git a/lib/diag.ml b/lib/diag.ml index 5c18933..3c668e4 100644 --- a/lib/diag.ml +++ b/lib/diag.ml @@ -16,7 +16,6 @@ let make ?(severity = Error) ?(span = Span.none) ?hint ?(notes = []) msg = let error ?span ?hint ?notes fmt = Printf.ksprintf (fun msg -> raise (Stop [ make ?span ?hint ?notes msg ])) fmt -let errorf fmt = Printf.ksprintf (fun msg -> make msg) fmt let sources : (string, string array) Hashtbl.t = Hashtbl.create 8 diff --git a/lib/eval.ml b/lib/eval.ml index 907a4a4..802a7ad 100644 --- a/lib/eval.ml +++ b/lib/eval.ml @@ -81,7 +81,6 @@ let default_tc : Types.toolchain = cc = "cc"; cxx = "c++"; ar = "ar"; - ranlib = "ranlib"; target = ""; sysroot = ""; xflags = []; @@ -119,7 +118,6 @@ let derive_cross env explicit = cc = (if set "cc" then tc.cc else pick "gcc" "cc"); cxx = (if set "cxx" then tc.cxx else pick "g++" "c++"); ar = (if set "ar" then tc.ar else prefixed "ar"); - ranlib = (if set "ranlib" then tc.ranlib else prefixed "ranlib"); } in let xflags = @@ -245,11 +243,6 @@ let show_probe env label result detail = let define env name value = env.defines <- env.defines @ [ { Types.dname = name; dvalue = value } ] -let record env ~label ~var ~macro (o : Probe.outcome) ~detail = - setvar env var [ (if o.ok then "true" else "false") ]; - define env macro (if o.ok then Some "1" else None); - if env.probe.Probe.ran > 0 then show_probe env label o.ok detail - let run_check env (c : check) = let before = env.probe.Probe.ran in let fresh () = env.probe.Probe.ran > before in @@ -335,7 +328,6 @@ let apply_toolchain env fields = | "cc" -> { tc with cc = one () } | "cxx" -> { tc with cxx = one () } | "ar" -> { tc with ar = one () } - | "ranlib" -> { tc with ranlib = one () } | "cflags" -> { tc with cflags = tc.cflags @ vs } | "cxxflags" -> { tc with cxxflags = tc.cxxflags @ vs } | "ldflags" -> { tc with ldflags = tc.ldflags @ vs } @@ -346,8 +338,8 @@ let apply_toolchain env fields = Diag.error ~span:f.kspan ~hint: (Suggest.hint k - [ "cc"; "cxx"; "ar"; "ranlib"; "cflags"; "cxxflags"; "ldflags"; "builddir"; - "target"; "sysroot" ]) + [ "cc"; "cxx"; "ar"; "cflags"; "cxxflags"; "ldflags"; "builddir"; "target"; + "sysroot" ]) "toolchain has no field %S" k)) fields; if env.tc.target <> "" then derive_cross env explicit; diff --git a/lib/exec.ml b/lib/exec.ml index ba5c9b8..4f1e041 100644 --- a/lib/exec.ml +++ b/lib/exec.ml @@ -1,7 +1,3 @@ -type job = { desc : string; cmd : string array; after : unit -> unit } - -type report = { ran : int; failures : int } - let quote s = if s <> "" && String.for_all (fun c -> not (List.mem c [ ' '; '\t'; '"'; '\''; '$'; '&'; ';' ])) s then s @@ -9,50 +5,6 @@ let quote s = let show cmd = String.concat " " (List.map quote (Array.to_list cmd)) -let run ~jobs ~verbose ~on_done js = - let queue = ref js in - let running = Hashtbl.create 8 in - let failures = ref 0 in - let ran = ref 0 in - let spawn j = - let tmp = Filename.temp_file "meowc" ".log" in - let fd = Unix.openfile tmp [ Unix.O_WRONLY; Unix.O_CREAT; Unix.O_TRUNC ] 0o600 in - let pid = - try Unix.create_process j.cmd.(0) j.cmd Unix.stdin fd fd - with Unix.Unix_error (e, _, _) -> - Unix.close fd; - Sys.remove tmp; - Diag.error "cannot run %s: %s" j.cmd.(0) (Unix.error_message e) - in - Unix.close fd; - Hashtbl.replace running pid (j, tmp) - in - let reap () = - let pid, status = Unix.wait () in - match Hashtbl.find_opt running pid with - | None -> () - | Some (j, tmp) -> - Hashtbl.remove running pid; - incr ran; - let ok = status = Unix.WEXITED 0 in - if ok then j.after () else incr failures; - let log = try Fs.read tmp with Sys_error _ -> "" in - (try Sys.remove tmp with Sys_error _ -> ()); - on_done ~ok j; - if verbose then print_endline (" " ^ Style.dim (show j.cmd)); - if String.trim log <> "" then (print_string log; flush stdout) - in - while !queue <> [] || Hashtbl.length running > 0 do - while !queue <> [] && Hashtbl.length running < jobs && !failures = 0 do - match !queue with - | j :: rest -> queue := rest; spawn j - | [] -> () - done; - if Hashtbl.length running > 0 then reap () - else if !failures > 0 then queue := [] - done; - { ran = !ran; failures = !failures } - let devnull () = Unix.openfile "/dev/null" [ Unix.O_RDONLY ] 0 let capture cmd = diff --git a/lib/graph.ml b/lib/graph.ml index b81b0a7..b7c82bf 100644 --- a/lib/graph.ml +++ b/lib/graph.ml @@ -7,7 +7,6 @@ type node = { ins : string list; depfile : string option; ords : string list; - pool : string; (* where to spill the arguments when the command line will not fit; only set for commands meowc composes itself, since an arbitrary program from a rule need not understand @file *) @@ -17,8 +16,8 @@ type node = { type t = { nodes : node array; by_output : (string, int) Hashtbl.t } -let make ~id ~tag ~label ~cmd ~outs ~ins ?depfile ?(ords = []) ?(pool = "default") ?rsp () = - { id; tag; label; cmd; outs; ins; depfile; ords; pool; rsp; deps = [] } +let make ~id ~tag ~label ~cmd ~outs ~ins ?depfile ?(ords = []) ?rsp () = + { id; tag; label; cmd; outs; ins; depfile; ords; rsp; deps = [] } let build specs = let nodes = Array.of_list specs in diff --git a/lib/parse.ml b/lib/parse.ml index 9e95a7c..886efcd 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -14,11 +14,6 @@ let kind p = (peek p).Lexer.kind let span p = (peek p).Lexer.span let advance p = if p.pos < Array.length p.toks - 1 then p.pos <- p.pos + 1 -let bump p = - let t = peek p in - advance p; - t - let rec skip_nl p = match kind p with Lexer.Newline -> advance p; skip_nl p | _ -> () let expected p what = diff --git a/lib/resolve.ml b/lib/resolve.ml index d051f6d..c96515a 100644 --- a/lib/resolve.ml +++ b/lib/resolve.ml @@ -107,7 +107,6 @@ let target_of pkgs ((b : block), base) = { name = b.bname; kind; - dir = base; srcs = []; gen_srcs = []; includes = List.map (Eval.under base) (texts (get b "include")); @@ -116,7 +115,6 @@ let target_of pkgs ((b : block), base) = cxxflags = texts (get b "cxxflags") @ pkg_cflags; ldflags = texts (get b "ldflags") @ pkg_libs; defines = texts (get b "define"); - pkgs = pkg_names; install = get1 b "install"; soname = get1 b "soname"; args = texts (get b "args"); diff --git a/lib/style.ml b/lib/style.ml index cb9a51d..3ff2cad 100644 --- a/lib/style.ml +++ b/lib/style.ml @@ -25,7 +25,6 @@ let visible s = let pad n s = s ^ String.make (max 0 (n - visible s)) ' ' let pad_left n s = String.make (max 0 (n - visible s)) ' ' ^ s -let ellipsis n s = if visible s <= n then s else String.sub s 0 (max 0 (n - 1)) ^ "\xe2\x80\xa6" let plural n w = let last = if w = "" then ' ' else w.[String.length w - 1] in let prev = if String.length w < 2 then ' ' else w.[String.length w - 2] in diff --git a/lib/types.ml b/lib/types.ml index 0706650..fe0fb0d 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -7,7 +7,6 @@ let kind_name = function Lib -> "lib" | Shared -> "shared" | Bin -> "bin" | Test type target = { name : string; kind : tkind; - dir : string; srcs : string list; gen_srcs : string list; includes : string list; @@ -16,7 +15,6 @@ type target = { cxxflags : string list; ldflags : string list; defines : string list; - pkgs : string list; install : string option; soname : string option; args : string list; @@ -36,7 +34,6 @@ type toolchain = { cc : string; cxx : string; ar : string; - ranlib : string; target : string; sysroot : string; xflags : string list;