Skip to content

Commit

Permalink
Add the ability to choose the host context.
Browse files Browse the repository at this point in the history 
Also allows to use (default) with different names

Signed-off-by: Lucas Pluvinage <lucas.pluvinage@gmail.com>
  • Loading branch information
@TheLortex
TheLortex committed May 6, 2019
1 parent b9015bb commit 562404e
Show file tree
Hide file tree
Showing 4 changed files with 64 additions and 35 deletions.
2 changes: 2 additions & 0 deletions bin/installed_libraries.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,8 @@ let term =
{ merlin_context = Some "default"
; contexts = [Default { loc = Loc.of_pos __POS__
; targets = [Native]
; name = "default"
; host_context = None
; profile = Config.default_build_profile
; env = None
; toolchain = None
Expand Down
47 changes: 32 additions & 15 deletions src/context.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -208,7 +208,7 @@ let ocamlfind_printconf_path ~env ~ocamlfind ~toolchain =
let+ l = Process.run_capture_lines ~env Strict ocamlfind args in
List.map l ~f:Path.of_filename_relative_to_initial_cwd

let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets ~host_context
~host_toolchain ~profile =
let opam_var_cache = Hashtbl.create 128 in
(match kind with
Expand Down Expand Up @@ -506,11 +506,10 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
set t.ocamlmklib;
end;
end;
Fiber.return t
Fiber.return (host_context, t)
in

let implicit = not (List.mem ~set:targets Workspace.Context.Target.Native) in
let* native =
let* (nat_host, native) =
create_one ~host:None ~findlib_toolchain:host_toolchain
~implicit ~name ~merlin
in
Expand All @@ -523,14 +522,14 @@ let create ~(kind : Kind.t) ~path ~env ~env_nodes ~name ~merlin ~targets
~findlib_toolchain:(Some findlib_toolchain)
>>| Option.some)
in
native :: List.filter_opt others
(nat_host, native) :: List.filter_opt others

let opam_config_var t var =
opam_config_var ~env:t.env ~cache:t.opam_var_cache var

let default ~merlin ~env_nodes ~env ~targets =
let path = Env.path Env.initial in
create ~kind:Default ~path ~env ~env_nodes ~name:"default"
create ~kind:Default ~path ~env ~env_nodes
~merlin ~targets

let opam_version =
Expand All @@ -555,7 +554,7 @@ let opam_version =
Fiber.Future.wait future

let create_for_opam ~root ~env ~env_nodes ~targets ~profile
~switch ~name ~merlin ~host_toolchain =
~switch ~name ~merlin ~host_context ~host_toolchain =
let opam =
match Lazy.force opam with
| None -> Utils.program_not_found "opam" ~loc:None
Expand Down Expand Up @@ -599,7 +598,22 @@ let create_for_opam ~root ~env ~env_nodes ~targets ~profile
in
let env = Env.extend env ~vars in
create ~kind:(Opam { root; switch }) ~profile ~targets ~path ~env ~env_nodes
~name ~merlin ~host_toolchain
~name ~merlin ~host_context ~host_toolchain

let resolve_host_contexts contexts =
let empty = String.Map.empty in
let map = List.fold_left
~f:(fun map (_,(_,elem)) -> String.Map.add map elem.name elem)
~init:empty
contexts in
List.map ~f:(fun (loc, (host, elem)) -> match host with
| None -> elem
| Some host -> (
match String.Map.find map host with
| None -> Errors.fail loc "Undefined host context '%s' for '%s'." host elem.name
| Some ctx -> {elem with for_host=(Some ctx)}
))
contexts

let create ~env (workspace : Workspace.t) =
let env_nodes context =
Expand All @@ -610,7 +624,7 @@ let create ~env (workspace : Workspace.t) =
in
Fiber.parallel_map workspace.contexts ~f:(fun def ->
match def with
| Default { targets; profile; env = env_node ; toolchain ; loc = _ } ->
| Default { targets; name; host_context; profile; env = env_node ; toolchain ; loc } ->
let merlin =
workspace.merlin_context = Some (Workspace.Context.name def)
in
Expand All @@ -619,13 +633,16 @@ let create ~env (workspace : Workspace.t) =
| Some t, _ -> Some t
| None, default -> default
in
default ~env ~env_nodes:(env_nodes env_node) ~profile ~targets ~merlin
~host_toolchain
| Opam { base = { targets; profile; env = env_node; toolchain; loc = _ }
; name; switch; root; merlin } ->
create_for_opam ~root ~env_nodes:(env_nodes env_node) ~env ~profile
~switch ~name ~merlin ~targets ~host_toolchain:toolchain)
(default ~env ~env_nodes:(env_nodes env_node) ~profile ~targets ~name ~merlin
~host_context ~host_toolchain
>>| fun x -> List.map ~f:(fun x -> (loc,x)) x)
| Opam { base = { targets; name; host_context; profile; env = env_node; toolchain; loc }
; switch; root; merlin } ->
(create_for_opam ~root ~env_nodes:(env_nodes env_node) ~env ~profile
~switch ~name ~merlin ~targets ~host_context ~host_toolchain:toolchain)
>>| fun x -> List.map ~f:(fun x -> (loc,x)) x)
>>| List.concat
>>| resolve_host_contexts

let which t s = which ~cache:t.which_cache ~path:t.path s

Expand Down
37 changes: 23 additions & 14 deletions src/workspace.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -47,17 +47,21 @@ module Context = struct

module Common = struct
type t =
{ loc : Loc.t
; profile : string
; targets : Target.t list
; env : Dune_env.Stanza.t option
; toolchain : string option
{ loc : Loc.t
; profile : string
; targets : Target.t list
; env : Dune_env.Stanza.t option
; toolchain : string option
; name : string
; host_context : string option
}

let t ~profile =
let+ env = env_field
and+ targets = field "targets" (list Target.t) ~default:[Target.Native]
and+ profile = field "profile" string ~default:profile
and+ host_context =
field_o "host" (Syntax.since syntax (1, 10) >>= fun () -> string)
and+ toolchain =
field_o "toolchain" (Syntax.since syntax (1, 5) >>> string)
and+ loc = loc
Expand All @@ -66,31 +70,31 @@ module Context = struct
; profile
; loc
; env
; name = "default"
; host_context
; toolchain
}
end

module Opam = struct
type t =
{ base : Common.t
; name : string
; switch : string
; root : string option
; merlin : bool
}

let t ~profile ~x =
let+ base = Common.t ~profile
and+ switch = field "switch" string
let+ switch = field "switch" string
and+ name = field_o "name" Name.t
and+ root = field_o "root" string
and+ merlin = field_b "merlin"
and+ base = Common.t ~profile
in
let name = Option.value ~default:switch name in
let base = { base with targets = Target.add base.targets x } in
let base = { base with targets = Target.add base.targets x; name } in
{ base
; switch
; name
; root
; merlin
}
Expand All @@ -100,8 +104,11 @@ module Context = struct
type t = Common.t

let t ~profile ~x =
Common.t ~profile >>| fun t ->
{ t with targets = Target.add t.targets x }
let+ common = Common.t ~profile
and+ name = field_o "name" (Syntax.since syntax (1, 10) >>= fun () -> Name.t)
in
let name = Option.value ~default:common.name name in
{ common with targets = Target.add common.targets x; name }
end

type t = Default of Default.t | Opam of Opam.t
Expand Down Expand Up @@ -131,8 +138,8 @@ module Context = struct
~dune:(t ~profile ~x)

let name = function
| Default _ -> "default"
| Opam o -> o.name
| Default d -> d.name
| Opam o -> o.base.name

let targets = function
| Default x -> x.targets
Expand All @@ -150,6 +157,8 @@ module Context = struct
; targets = [Option.value x ~default:Target.Native]
; profile = Option.value profile
~default:Config.default_build_profile
; name = "default"
; host_context = None
; env = None
; toolchain = None
}
Expand Down
13 changes: 7 additions & 6 deletions src/workspace.mli
View file
Original file line number Diff line number Diff line change
Expand Up @@ -11,17 +11,18 @@ module Context : sig
end
module Common : sig
type t =
{ loc : Loc.t
; profile : string
; targets : Target.t list
; env : Dune_env.Stanza.t option
; toolchain : string option
{ loc : Loc.t
; profile : string
; targets : Target.t list
; env : Dune_env.Stanza.t option
; toolchain : string option
; name : string
; host_context : string option
}
end
module Opam : sig
type t =
{ base : Common.t
; name : string
; switch : string
; root : string option
; merlin : bool
Expand Down

0 comments on commit 562404e

Please sign in to comment.