284 lines
10 KiB
OCaml
284 lines
10 KiB
OCaml
open Ast
|
|
open Types
|
|
|
|
let target_fields =
|
|
[ "srcs"; "include"; "use"; "cflags"; "cxxflags"; "ldflags"; "define"; "pkg"; "install";
|
|
"soname"; "args" ]
|
|
|
|
let rule_fields = [ "inputs"; "outputs"; "use"; "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
|
|
|
|
let check_fields (b : block) known =
|
|
List.iter
|
|
(fun (f : field) ->
|
|
if not (List.mem f.key known) then
|
|
Diag.error ~span:f.kspan ~hint:(Suggest.hint f.key known) "%s %s has no field %S" b.kind
|
|
b.bname f.key)
|
|
(fields_of b)
|
|
|
|
let get b key = List.concat_map (fun (f : field) -> if f.key = key then f.values else []) (fields_of b)
|
|
let texts vs = List.map (fun (v : value) -> v.text) vs
|
|
let get1 b key = match texts (get b key) with [] -> None | l -> Some (String.concat " " l)
|
|
|
|
let subst table s =
|
|
let n = String.length s in
|
|
let b = Buffer.create n in
|
|
let i = ref 0 in
|
|
while !i < n do
|
|
if s.[!i] = '$' && !i + 1 < n && s.[!i + 1] = '{' then
|
|
match String.index_from_opt s (!i + 2) '}' with
|
|
| None -> (Buffer.add_char b s.[!i]; incr i)
|
|
| Some j ->
|
|
let name = String.sub s (!i + 2) (j - !i - 2) in
|
|
(match List.assoc_opt name table with
|
|
| Some v -> Buffer.add_string b v
|
|
| None -> Buffer.add_string b (String.sub s !i (j - !i + 1)));
|
|
i := j + 1
|
|
else (Buffer.add_char b s.[!i]; incr i)
|
|
done;
|
|
Buffer.contents b
|
|
|
|
(* Rules are read in written order, the way checks are, so a later rule can glob
|
|
what an earlier one produces and a pipeline can be spelled out in stages. *)
|
|
let rules_of blocks =
|
|
let generated = ref [] in
|
|
let of_block ((b : block), base) =
|
|
if b.kind <> "rule" then []
|
|
else begin
|
|
check_fields b rule_fields;
|
|
let inputs = texts (get b "inputs") in
|
|
let outputs = texts (get b "outputs") in
|
|
let command = texts (get b "command") in
|
|
let descr = Option.value (get1 b "description") ~default:("gen " ^ b.bname) in
|
|
if outputs = [] then Diag.error ~span:b.nspan "rule %s declares no outputs" b.bname;
|
|
if command = [] then Diag.error ~span:b.nspan "rule %s declares no command" b.bname;
|
|
let files =
|
|
List.concat_map
|
|
(fun p -> Glob.expand_with ~extra:!generated (Eval.under base p))
|
|
inputs
|
|
|> List.sort_uniq compare
|
|
in
|
|
if files = [] then
|
|
Diag.error ~span:b.nspan ~hint:"the inputs pattern matched nothing"
|
|
"rule %s has no inputs" b.bname;
|
|
let rs =
|
|
List.map
|
|
(fun f ->
|
|
let stem = Filename.remove_extension (Filename.basename f) in
|
|
let table0 =
|
|
[ ("in", f); ("stem", stem); ("dir", Filename.dirname f);
|
|
("base", Filename.basename f); ("ext", Filename.extension f); ("name", b.bname) ]
|
|
in
|
|
let routs = List.map (fun o -> Eval.under base (subst table0 o)) outputs in
|
|
let table =
|
|
table0 @ ("out", List.hd routs)
|
|
:: List.mapi (fun i o -> (Printf.sprintf "out%d" i, o)) routs
|
|
in
|
|
{
|
|
rname = b.bname;
|
|
rin = [ f ];
|
|
ruses = texts (get b "use");
|
|
routs;
|
|
rcmd = List.map (subst table) command;
|
|
rdesc = subst table descr;
|
|
rspan = b.nspan;
|
|
})
|
|
files
|
|
in
|
|
generated := !generated @ List.concat_map (fun r -> r.routs) rs;
|
|
rs
|
|
end
|
|
in
|
|
(* fold_left, not map: each block must see what the ones before it generated *)
|
|
List.rev (List.fold_left (fun acc bb -> List.rev_append (of_block bb) acc) [] blocks)
|
|
|
|
let target_of pkgs ((b : block), base) =
|
|
check_fields b target_fields;
|
|
let kind =
|
|
match b.kind with
|
|
| "lib" -> Lib
|
|
| "shared" -> Shared
|
|
| "bin" -> Bin
|
|
| _ -> Test
|
|
in
|
|
let pkg_names = texts (get b "pkg") in
|
|
let pkg_cflags = List.concat_map (fun p ->
|
|
match Hashtbl.find_opt pkgs p with
|
|
| Some (c, _) -> c
|
|
| None -> Diag.error ~span:b.nspan
|
|
~hint:(Printf.sprintf "add 'pkg %s' at the top level first" p)
|
|
"%s uses pkg %S, which was never checked" b.bname p) pkg_names
|
|
in
|
|
let pkg_libs = List.concat_map (fun p ->
|
|
match Hashtbl.find_opt pkgs p with Some (_, l) -> l | None -> []) pkg_names
|
|
in
|
|
{
|
|
name = b.bname;
|
|
kind;
|
|
srcs = [];
|
|
gen_srcs = [];
|
|
includes = List.map (Eval.under base) (texts (get b "include"));
|
|
uses = texts (get b "use");
|
|
cflags = texts (get b "cflags") @ pkg_cflags;
|
|
cxxflags = texts (get b "cxxflags") @ pkg_cflags;
|
|
ldflags = texts (get b "ldflags") @ pkg_libs;
|
|
defines = texts (get b "define");
|
|
install = get1 b "install";
|
|
soname = get1 b "soname";
|
|
args = texts (get b "args");
|
|
span = b.nspan;
|
|
}
|
|
|
|
let sources_of ~extra ((b : block), base) (t : target) =
|
|
let pats = texts (get b "srcs") in
|
|
if pats = [] then
|
|
Diag.error ~span:b.nspan ~hint:"add a line like: srcs src/*.c" "%s %s declares no srcs"
|
|
b.kind b.bname;
|
|
let files =
|
|
List.concat_map (fun p -> Glob.expand_with ~extra (Eval.under base p)) pats
|
|
|> List.sort_uniq compare
|
|
in
|
|
if files = [] then
|
|
Diag.error ~span:b.nspan
|
|
~hint:(Printf.sprintf "no file matches %s" (String.concat " " pats))
|
|
"%s %s matched no sources" b.kind b.bname;
|
|
List.iter
|
|
(fun f ->
|
|
if lang_opt f = None then
|
|
Diag.error ~span:b.nspan
|
|
~hint:("meowc compiles " ^ String.concat " " source_exts)
|
|
"%s %s lists %s, which is not a source meowc can compile" b.kind b.bname f)
|
|
files;
|
|
let gen, real = List.partition (fun f -> List.mem f extra) files in
|
|
{ t with srcs = real; gen_srcs = gen }
|
|
|
|
let installs_of blocks =
|
|
List.concat_map
|
|
(fun ((b : block), base) ->
|
|
if b.kind <> "install" then []
|
|
else begin
|
|
check_fields b install_fields;
|
|
let dest = match get1 b "to" with
|
|
| Some d -> d
|
|
| None -> Diag.error ~span:b.nspan ~hint:"add: to include" "install %s has no destination" b.bname
|
|
in
|
|
let files =
|
|
List.concat_map (fun p -> Glob.expand (Eval.under base p)) (texts (get b "files"))
|
|
in
|
|
if files = [] then Diag.error ~span:b.nspan "install %s matched no files" b.bname;
|
|
List.map (fun f -> { from = f; dest }) files
|
|
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
|
|
let generated = List.concat_map (fun r -> r.routs) rules in
|
|
let tblocks =
|
|
List.filter (fun ((b : block), _) -> List.mem b.kind [ "lib"; "shared"; "bin"; "test" ]) blocks
|
|
in
|
|
let targets =
|
|
List.map (fun bb -> sources_of ~extra:generated bb (target_of env.pkgs bb)) tblocks
|
|
in
|
|
List.iter
|
|
(fun (b : block) ->
|
|
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
|
|
List.iter
|
|
(fun t ->
|
|
match Hashtbl.find_opt seen t.name with
|
|
| Some (prev : target) ->
|
|
Diag.error ~span:t.span ~notes:[ (prev.span, "first declared here") ]
|
|
"target %S is declared twice" t.name
|
|
| None -> Hashtbl.add seen t.name t)
|
|
targets;
|
|
let p =
|
|
{
|
|
pname = env.pname;
|
|
tc = env.tc;
|
|
targets;
|
|
rules;
|
|
scripts = scripts_of blocks;
|
|
defines = env.defines;
|
|
config_header = env.config_header;
|
|
installs = installs_of blocks;
|
|
prefix = (match Hashtbl.find_opt env.vars "prefix" with Some [ p ] -> p | _ -> "/usr/local");
|
|
platform = (match Hashtbl.find_opt env.vars "platform" with Some [ p ] -> p | _ -> "linux");
|
|
}
|
|
in
|
|
List.iter
|
|
(fun t ->
|
|
List.iter
|
|
(fun u ->
|
|
match find p u with
|
|
| None ->
|
|
Diag.error ~span:t.span
|
|
~hint:(Suggest.hint u (List.map (fun x -> x.name) targets))
|
|
"%s uses %S, which is not a target" t.name u
|
|
| Some x when x.kind = Bin || x.kind = Test ->
|
|
Diag.error ~span:t.span "%s uses %S, which is a %s, not a library" t.name u
|
|
(kind_name x.kind)
|
|
| Some _ -> ())
|
|
t.uses)
|
|
targets;
|
|
List.iter
|
|
(fun (r : rule) ->
|
|
List.iter
|
|
(fun u ->
|
|
if find p u = None && not (Sys.file_exists u) then
|
|
Diag.error ~span:r.rspan
|
|
~hint:(Suggest.hint u (List.map (fun (x : target) -> x.name) targets))
|
|
"rule %s uses %S, which is neither a target nor a file" r.rname u)
|
|
r.ruses)
|
|
p.rules;
|
|
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)));
|
|
List.iter (fun u -> match find p u with Some x -> cyc (t.name :: seen) x | None -> ()) t.uses
|
|
in
|
|
List.iter (cyc []) targets;
|
|
p
|