diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 3ffd5868..8f7cf26c 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -176,8 +176,7 @@ module Gen(P : Install_rules.Params) = struct +-----------------------------------------------------------------+ *) let interpret_locks ~dir ~scope locks = - List.map locks ~f:(fun s -> - Path.relative dir (SC.expand_vars sctx ~dir ~scope s)) + List.map locks ~f:(SC.expand_vars_path sctx ~dir ~scope) let user_rule (rule : Rule.t) ~dir ~scope = let targets : SC.Action.targets = diff --git a/src/super_context.ml b/src/super_context.ml index aa08ea04..35b46404 100644 --- a/src/super_context.ml +++ b/src/super_context.ml @@ -86,16 +86,18 @@ let find_scope_by_name t name = Scope.DB.find_by_name t.scopes name let expand_var_no_root t var = String.Map.find t.vars var -let expand_vars t ~scope ~dir ?(extra_vars=String.Map.empty) s = - String_with_vars.expand s ~f:(fun _loc -> function - | "ROOT" -> Some (Path.reach ~from:dir t.context.build_dir) - | "SCOPE_ROOT" -> - Some (Path.reach ~from:dir (Scope.root scope)) - | var -> - Option.map ~f:(fun e -> Var_expansion.to_string dir e) +let (expand_vars, expand_vars_path) = + let make expander t ~scope ~dir ?(extra_vars=String.Map.empty) s = + expander ~dir s ~f:(fun _loc -> function + | "ROOT" -> Some (Var_expansion.Paths [t.context.build_dir]) + | "SCOPE_ROOT" -> Some (Paths [Scope.root scope]) + | var -> (match expand_var_no_root t var with | Some _ as x -> x - | None -> String.Map.find extra_vars var)) + | None -> String.Map.find extra_vars var)) in + ( make Var_expansion.Single.string + , make Var_expansion.Single.path + ) let expand_and_eval_set t ~scope ~dir ?extra_vars set ~standard = let open Build.O in @@ -482,13 +484,11 @@ module Deps = struct let make_alias t ~scope ~dir s = let loc = String_with_vars.loc s in - Alias.of_user_written_path ~loc - (Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s)) + Alias.of_user_written_path ~loc ((expand_vars_path t ~scope ~dir s)) let dep t ~scope ~dir = function | File s -> - let path = Path.relative ~error_loc:(String_with_vars.loc s) dir - (expand_vars t ~scope ~dir s) in + let path = expand_vars_path t ~scope ~dir s in Build.path path >>^ fun () -> [path] | Alias s -> @@ -500,19 +500,17 @@ module Deps = struct >>^ fun () -> [] | Glob_files s -> begin let loc = String_with_vars.loc s in - let path = - Path.relative ~error_loc:loc dir (expand_vars t ~scope ~dir s) in + let path = expand_vars_path t ~scope ~dir s in match Glob_lexer.parse_string (Path.basename path) with | Ok re -> let dir = Path.parent_exn path in Build.paths_glob ~loc ~dir (Re.compile re) >>^ Path.Set.to_list | Error (_pos, msg) -> - Loc.fail loc "invalid glob: %s" msg + Loc.fail (String_with_vars.loc s) "invalid glob: %s" msg end | Files_recursively_in s -> - let path = Path.relative ~error_loc:(String_with_vars.loc s) - dir (expand_vars t ~scope ~dir s) in + let path = expand_vars_path t ~scope ~dir s in Build.files_recursively_in ~dir:path ~file_tree:t.file_tree >>^ Path.Set.to_list | Package p -> diff --git a/src/super_context.mli b/src/super_context.mli index 9f74c063..2f06dfba 100644 --- a/src/super_context.mli +++ b/src/super_context.mli @@ -86,6 +86,14 @@ val expand_vars -> String_with_vars.t -> string +val expand_vars_path + : t + -> scope:Scope.t + -> dir:Path.t + -> ?extra_vars:Var_expansion.t String.Map.t + -> String_with_vars.t + -> Path.t + val expand_and_eval_set : t -> scope:Scope.t diff --git a/src/var_expansion.ml b/src/var_expansion.ml index 8dc6d996..080b18ae 100644 --- a/src/var_expansion.ml +++ b/src/var_expansion.ml @@ -42,3 +42,20 @@ let to_path dir = function | Paths [p] -> p | Paths l -> path_of_string dir (concat (List.map l ~f:(string_of_path ~dir))) + +module Single = struct + let path ~dir sw ~f = + let relative = Path.relative ~error_loc:(String_with_vars.loc sw) in + match Expand.expand dir sw ~allow_multivalue:false ~f with + | String s + | Expansion (Strings [s]) -> relative dir s + | Expansion (Paths [s]) -> Path.append dir s + | _ -> assert false (* multivalues aren't allowed *) + + let string ~dir sw ~f = + match Expand.expand dir sw ~allow_multivalue:false ~f with + | String s + | Expansion (Strings [s]) -> s + | Expansion (Paths [s]) -> string_of_path ~dir s + | _ -> assert false (* multivalues aren't allowed *) +end diff --git a/src/var_expansion.mli b/src/var_expansion.mli index 09819fcf..048a2488 100644 --- a/src/var_expansion.mli +++ b/src/var_expansion.mli @@ -17,3 +17,18 @@ val to_path : Path.t -> t -> Path.t module Expand : String_with_vars.Expand_intf with type expansion = t and type context = Path.t + +(** Specialized expansion that produce only a single value *) +module Single : sig + val path + : dir:Path.t + -> String_with_vars.t + -> f:(Loc.t -> string -> t option) + -> Path.t + + val string + : dir:Path.t + -> String_with_vars.t + -> f:(Loc.t -> string -> t option) + -> string +end