From 5f81ab227dffe14f2de3745ddaacac2ef047ac82 Mon Sep 17 00:00:00 2001 From: milner Date: Thu, 21 Jul 2022 16:25:46 +0000 Subject: [PATCH] feat(run): run blocks for commands the build does not produce --- bin/meowc.ml | 67 ++++++++++++++++++++++++++--------- examples/raytracer/build.meow | 7 ++++ lib/parse.ml | 2 +- lib/resolve.ml | 41 ++++++++++++++++++++- lib/types.ml | 5 +++ 5 files changed, 103 insertions(+), 19 deletions(-) diff --git a/bin/meowc.ml b/bin/meowc.ml index af961cc..dd7bc43 100644 --- a/bin/meowc.ml +++ b/bin/meowc.ml @@ -8,7 +8,7 @@ let usage = ""; Style.bold " usage"; " meowc [build] [target...] build everything, or the named targets"; - " meowc run [args...] build a bin target, then run it"; + " meowc run [args...] run a bin target, or a run block"; " meowc test [filter] build and run test targets"; " meowc install copy installable outputs under the prefix"; " meowc configure run the checks and write the config header"; @@ -259,24 +259,46 @@ let cmd_build names = summarise r (Unix.gettimeofday () -. t0); p +let runnable_names p = + List.filter_map (fun (t : target) -> if t.kind = Bin then Some t.name else None) p.targets + @ List.map (fun (s : script) -> s.sname) p.scripts + +let hand_over cmd = + flush stdout; + try Unix.execvp cmd.(0) cmd + with Unix.Unix_error (e, _, _) -> Diag.error "cannot run %s: %s" cmd.(0) (Unix.error_message e) + let cmd_run = function - | [] -> Diag.error ~hint:"try: meowc run " "run needs a target name" - | name :: args -> + | [] -> Diag.error ~hint:"try: meowc run " "run needs a name" + | name :: args -> ( let p = configure () in - let t = match find p name with - | Some ({ kind = Bin; _ } as t) -> t - | Some t -> Diag.error "%s is a %s, not a bin" name (kind_name t.kind) - | None -> unknown_target p name + let build_first names = + banner p; + with_config_header p; + let t0 = Unix.gettimeofday () in + let _, r = execute p ~names in + summarise r (Unix.gettimeofday () -. t0) in - banner p; - with_config_header p; - let t0 = Unix.gettimeofday () in - let _, r = execute p ~names:[ name ] in - summarise r (Unix.gettimeofday () -. t0); - let exe = Build.bin_of p t in - if not fl.quiet then Printf.printf "\n %s\n" (Style.dim exe); - flush stdout; - Unix.execv exe (Array.of_list (exe :: args)) + match List.find_opt (fun (s : script) -> s.sname = name) p.scripts with + | Some s -> + (* no names means everything, the same as a bare meowc build *) + build_first s.suses; + let cmd = Array.of_list (s.scmd @ args) in + if not fl.quiet then Printf.printf "\n %s\n" (Style.dim (Exec.show cmd)); + hand_over cmd + | None -> + let t = + match find p name with + | Some ({ kind = Bin; _ } as t) -> t + | Some t -> Diag.error "%s is a %s, not a bin" name (kind_name t.kind) + | None -> + Diag.error ~hint:(Suggest.hint name (runnable_names p)) + "no bin target or run block named %S" name + in + build_first [ name ]; + let exe = Build.bin_of p t in + if not fl.quiet then Printf.printf "\n %s\n" (Style.dim exe); + hand_over (Array.of_list (exe :: args))) let cmd_test filter = let p = configure () in @@ -344,7 +366,18 @@ let cmd_targets () = (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))) p.targets; - Printf.printf "\n %s\n" (Style.dim (Style.plural (List.length p.targets) "target")) + List.iter + (fun (s : script) -> + Printf.printf " %s%s%s\n" + (Style.yellow (Style.pad 9 "run")) + (Style.pad 22 s.sname) + (Style.dim (if s.suses = [] then "" else "uses " ^ String.concat " " s.suses))) + p.scripts; + Printf.printf "\n %s\n" + (Style.dim + (String.concat ", " + (Style.plural (List.length p.targets) "target" + :: (if p.scripts = [] then [] else [ Style.plural (List.length p.scripts) "run block" ])))) let cmd_graph () = let p = configure () in diff --git a/examples/raytracer/build.meow b/examples/raytracer/build.meow index 0de0e80..4eeb23c 100644 --- a/examples/raytracer/build.meow +++ b/examples/raytracer/build.meow @@ -113,6 +113,13 @@ bin rtbench { use rtscene } +# A canned invocation, for a quick low sample preview. ${builddir} follows the +# target triple, so this still points at the right binary under --target. +run preview { + use render + command ${builddir}/bin/render --scene rings --width 320 --height 180 --samples 8 +} + test math_test { srcs tests/math_test.c include include diff --git a/lib/parse.ml b/lib/parse.ml index 75cdcd0..9e95a7c 100644 --- a/lib/parse.ml +++ b/lib/parse.ml @@ -6,7 +6,7 @@ let stmt_keywords = [ "project"; "set"; "append"; "option"; "include"; "subdir"; "if"; "check"; "pkg"; "config_header"; "message" ] -let block_kinds = [ "toolchain"; "lib"; "shared"; "bin"; "test"; "rule"; "install" ] +let block_kinds = [ "toolchain"; "lib"; "shared"; "bin"; "test"; "rule"; "install"; "run" ] let check_kinds = [ "header"; "func"; "symbol"; "sizeof"; "compiles" ] let peek p = p.toks.(p.pos) diff --git a/lib/resolve.ml b/lib/resolve.ml index aaa8852..d051f6d 100644 --- a/lib/resolve.ml +++ b/lib/resolve.ml @@ -7,6 +7,7 @@ let target_fields = let rule_fields = [ "inputs"; "outputs"; "command"; "description" ] let install_fields = [ "files"; "to" ] +let script_fields = [ "use"; "command" ] let fields_of (b : block) = List.filter_map (function FField f -> Some f | FIf _ -> None) b.items @@ -156,6 +157,20 @@ let installs_of blocks = end) blocks +let scripts_of blocks = + List.concat_map + (fun ((b : block), _) -> + if b.kind <> "run" then [] + else begin + check_fields b script_fields; + let cmd = texts (get b "command") in + if cmd = [] then + Diag.error ~span:b.nspan ~hint:"add a line like: command ./tool --flag" + "run %s declares no command" b.bname; + [ { sname = b.bname; suses = texts (get b "use"); scmd = cmd; sspan = b.nspan } ] + end) + blocks + let project (env : Eval.env) = let blocks = env.blocks in let rules = rules_of blocks in @@ -168,7 +183,8 @@ let project (env : Eval.env) = in List.iter (fun (b : block) -> - if not (List.mem b.kind [ "lib"; "shared"; "bin"; "test"; "rule"; "install"; "toolchain" ]) then + if not (List.mem b.kind [ "lib"; "shared"; "bin"; "test"; "rule"; "install"; "toolchain"; "run" ]) + then Diag.error ~span:b.kspan "unknown block %S" b.kind) (List.map fst blocks); let seen = Hashtbl.create 8 in @@ -186,6 +202,7 @@ let project (env : Eval.env) = tc = env.tc; targets; rules; + scripts = scripts_of blocks; defines = env.defines; config_header = env.config_header; installs = installs_of blocks; @@ -208,6 +225,28 @@ let project (env : Eval.env) = | Some _ -> ()) t.uses) targets; + let seen_runs = Hashtbl.create 4 in + List.iter + (fun (s : script) -> + (match Hashtbl.find_opt seen_runs s.sname with + | Some (prev : script) -> + Diag.error ~span:s.sspan ~notes:[ (prev.sspan, "first declared here") ] + "run %S is declared twice" s.sname + | None -> Hashtbl.add seen_runs s.sname s); + (* meowc run takes one name, so a run block and a target cannot share one *) + (match find p s.sname with + | Some (t : target) -> + Diag.error ~span:s.sspan ~notes:[ (t.span, "the target is here") ] + "run %S has the same name as a target" s.sname + | None -> ()); + List.iter + (fun u -> + if find p u = None then + Diag.error ~span:s.sspan + ~hint:(Suggest.hint u (List.map (fun (x : target) -> x.name) targets)) + "run %s uses %S, which is not a target" s.sname u) + s.suses) + p.scripts; let rec cyc seen t = if List.mem t.name seen then Diag.error ~span:t.span "dependency cycle: %s" (String.concat " -> " (List.rev (t.name :: seen))); diff --git a/lib/types.ml b/lib/types.ml index ce4124c..0706650 100644 --- a/lib/types.ml +++ b/lib/types.ml @@ -46,6 +46,10 @@ type toolchain = { builddir : string; } +(* A command the project can be asked to run, once whatever it names has been + built. Unlike a rule it produces no file, so it is never part of the graph. *) +type script = { sname : string; suses : string list; scmd : string list; sspan : Span.t } + type install_item = { from : string; dest : string } type define = { dname : string; dvalue : string option } @@ -55,6 +59,7 @@ type project = { tc : toolchain; targets : target list; rules : rule list; + scripts : script list; defines : define list; config_header : string option; installs : install_item list;