• Home
  • Features
  • Pricing
  • Docs
  • Announcements
  • Sign In

ocaml / dune / 29249

10 Dec 2024 02:42PM UTC coverage: 6.908% (-0.001%) from 6.909%
29249

Pull #11181

github

web-flow
Merge 13e50f393 into 5b695d66d
Pull Request #11181: Create reference documentation for current state of package management support

2951 of 42719 relevant lines covered (6.91%)

26666.99 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

1.56
/src/dune_rules/context.ml
1
open Import
2
open Memo.O
3

4
module Kind = struct
5
  type t =
6
    | Default
7
    | Opam of Opam_switch.t
8
    | Lock of { default : bool }
9

10
  let to_dyn : t -> Dyn.t = function
11
    | Default -> Dyn.string "default"
×
12
    | Lock { default } ->
×
13
      Dyn.variant "lock" [ Dyn.record [ "default", Dyn.bool default ] ]
×
14
    | Opam o -> Opam_switch.to_dyn o
×
15
  ;;
16

17
  let initial_ocamlpath = lazy (Findlib_config.ocamlpath_of_env Env.initial)
×
18

19
  let ocamlpath t ~ocamlpath ~findlib_toolchain =
20
    match t, findlib_toolchain with
×
21
    | Default, None -> Option.value ~default:[] ocamlpath
×
22
    | _, _ ->
×
23
      let initial_ocamlpath = Lazy.force initial_ocamlpath in
24
      (* If we are not in the default context, we can only use the OCAMLPATH
25
         variable if it is specific to this build context *)
26
      (* CR-someday diml: maybe we should actually clear OCAMLPATH in other
27
         build contexts *)
28
      (match ocamlpath, initial_ocamlpath with
×
29
       | None, None -> []
×
30
       | Some s, None ->
×
31
         (* [OCAMLPATH] set for the target context, unset in the
32
            [initial_env]. This means it's the [OCAMLPATH] specific to this
33
            build context. *)
34
         s
35
       | None, Some _ ->
×
36
         (* Clear [OCAMLPATH] for this build context if it's defined
37
            initially but not for this build context. *)
38
         []
39
       | Some env_ocamlpath, Some initial_ocamlpath ->
×
40
         (* Clear [OCAMLPATH] for this build context Unless it's different
41
            from the initial [OCAMLPATH] variable. *)
42
         (match List.compare ~compare:Path.compare env_ocamlpath initial_ocamlpath with
43
          | Eq -> []
×
44
          | _ -> env_ocamlpath))
×
45
  ;;
46
end
47

48
module Env_nodes = struct
49
  type t =
50
    { context : Dune_env.t option
51
    ; workspace : Dune_env.t option
52
    }
53

54
  let empty = { context = None; workspace = None }
55

56
  let extra_env { context; workspace } profile =
57
    let make env =
×
58
      Option.value
×
59
        ~default:Env.empty
60
        (let open Option.O in
61
         let+ (env : Dune_env.config) = env >>= Dune_env.find_opt ~profile in
×
62
         env.env_vars)
×
63
    in
64
    Env.extend_env (make context) (make workspace)
×
65
  ;;
66
end
67

68
type builder =
69
  { profile : Profile.t
70
  ; merlin : bool
71
  ; instrument_with : Lib_name.t list
72
  ; fdo_target_exe : Path.t option
73
  ; dynamically_linked_foreign_archives : bool
74
  ; env_nodes : Env_nodes.t
75
  ; name : Context_name.t
76
  ; env : Env.t Memo.t
77
  ; implicit : bool
78
  ; findlib_toolchain : Context_name.t option
79
  ; for_host : (Context_name.t * t Memo.t) option
80
  ; path : Path.t list
81
  }
82

83
and t =
84
  { kind : Kind.t
85
  ; build_dir : Path.Build.t
86
  ; ocaml : Ocaml_toolchain.t Memo.t
87
  ; findlib_paths : Path.t list Memo.Lazy.t
88
  ; default_ocamlpath : Path.t list Memo.Lazy.t
89
  ; build_context : Build_context.t
90
  ; builder : builder
91
  ; which : Filename.t -> Path.t option Memo.t
92
  }
93

94
module Builder = struct
95
  type t = builder
96

97
  let empty =
98
    { profile = Profile.Dev
99
    ; merlin = false
100
    ; instrument_with = []
101
    ; fdo_target_exe = None
102
    ; dynamically_linked_foreign_archives = false
103
    ; env_nodes = Env_nodes.empty
104
    ; name = Context_name.default
105
    ; env = Memo.return Env.empty
39✔
106
    ; implicit = false
107
    ; findlib_toolchain = None
108
    ; for_host = None
109
    ; path = []
110
    }
111
  ;;
112

113
  let extend_paths t ~env =
114
    let t =
×
115
      let f (var, t) =
116
        let parse ~loc:_ s = s in
×
117
        let standard = Env_path.path env |> List.map ~f:Path.to_string in
×
118
        var, Ordered_set_lang.eval t ~parse ~standard ~eq:String.equal
×
119
      in
120
      List.map ~f t
×
121
    in
122
    let vars =
123
      let to_absolute_filename s = Path.of_string s |> Path.to_absolute_filename in
×
124
      let sep = String.make 1 Bin.path_sep in
125
      let env = Env.Map.of_list_exn t in
×
126
      let f l = String.concat ~sep (List.map ~f:to_absolute_filename l) in
×
127
      Env.Map.map ~f env
×
128
    in
129
    Env.extend ~vars env
130
  ;;
131

132
  let set_workspace_base
133
    t
134
    { Workspace.Context.Common.targets = _
135
    ; name
136
    ; host_context = _
137
    ; profile
138
    ; env = _
139
    ; toolchain
140
    ; paths
141
    ; loc = _
142
    ; fdo_target_exe
143
    ; dynamically_linked_foreign_archives
144
    ; instrument_with
145
    ; merlin
146
    }
147
    =
148
    let env =
×
149
      let env = Global.env () in
150
      extend_paths ~env paths
×
151
    in
152
    { t with
153
      merlin =
154
        (match merlin with
155
         | Selected -> true
×
156
         | Rules_only | Not_selected -> false)
×
157
    ; profile
158
    ; dynamically_linked_foreign_archives
159
    ; instrument_with
160
    ; fdo_target_exe
161
    ; name
162
    ; env = Memo.return env
×
163
    ; findlib_toolchain = toolchain
164
    }
165
  ;;
166
end
167

168
let ocaml t = t.ocaml
×
169
let build_dir t = t.build_dir
×
170
let kind t = t.kind
×
171
let findlib_paths t = Memo.Lazy.force t.findlib_paths
×
172
let for_host t = Option.map t.builder.for_host ~f:snd
×
173
let default_ocamlpath t = Memo.Lazy.force t.default_ocamlpath
×
174
let implicit t = t.builder.implicit
×
175
let findlib_toolchain t = t.builder.findlib_toolchain
×
176
let env_nodes t = t.builder.env_nodes
×
177

178
let dynamically_linked_foreign_archives t =
179
  match t.builder.dynamically_linked_foreign_archives with
×
180
  | false -> Memo.return false
×
181
  | true ->
×
182
    let+ ocaml = ocaml t in
×
183
    Ocaml_config.supports_shared_libraries ocaml.ocaml_config
×
184
;;
185

186
let fdo_target_exe t = t.builder.fdo_target_exe
×
187
let instrument_with t = t.builder.instrument_with
×
188
let merlin t = t.builder.merlin
×
189
let profile t = t.builder.profile
×
190
let equal x y = Context_name.equal x.builder.name y.builder.name
×
191
let hash t = Context_name.hash t.builder.name
×
192
let build_context t = t.build_context
×
193
let which t fname = t.which fname
×
194
let name t = t.builder.name
×
195
let path t = t.builder.path
×
196
let installed_env t = t.builder.env
×
197
let to_dyn_concise t : Dyn.t = Context_name.to_dyn t.builder.name
×
198
let compare a b = Context_name.compare a.builder.name b.builder.name
×
199

200
let host t =
201
  match t.builder.for_host with
×
202
  | None -> Memo.return t
×
203
  | Some (_, host) -> host
×
204
;;
205

206
let to_dyn t : Dyn.t =
207
  let open Dyn in
×
208
  let path = Path.to_dyn in
209
  record
210
    [ "name", Context_name.to_dyn t.builder.name
×
211
    ; "kind", Kind.to_dyn t.kind
×
212
    ; "profile", Profile.to_dyn t.builder.profile
×
213
    ; "merlin", Bool t.builder.merlin
214
    ; "fdo_target_exe", option path t.builder.fdo_target_exe
×
215
    ; "build_dir", Path.Build.to_dyn t.build_dir
×
216
    ; "instrument_with", (list Lib_name.to_dyn) t.builder.instrument_with
×
217
    ]
218
;;
219

220
(* Wrap calls to the opam binary *)
221
module Opam : sig
222
  (* Environment for this opam switch *)
223
  val env : env:Env.t -> Opam_switch.t -> string Env.Map.t Memo.t
224
end = struct
225
  let opam =
226
    Memo.Lazy.create ~name:"context-opam" (fun () ->
39✔
227
      Which.which ~path:(Env_path.path Env.initial) "opam"
×
228
      >>= function
229
      | None -> Utils.program_not_found "opam" ~loc:None
×
230
      | Some opam ->
×
231
        let+ version =
232
          Memo.of_reproducible_fiber
×
233
            (Process.run_capture_line
×
234
               ~display:Quiet
235
               Strict
236
               opam
237
               [ "--version"; "--color=never" ])
238
        in
239
        (match Scanf.sscanf version "%d.%d.%d" (fun a b c -> a, b, c) with
×
240
         | Ok ((a, b, c) as v) ->
×
241
           if v < (2, 0, 0)
242
           then
243
             User_error.raise
×
244
               [ Pp.textf
×
245
                   "The version of opam installed on your system is too old. Dune \
246
                    requires at least version 2.0.0, however version %d.%d.%d is \
247
                    installed."
248
                   a
249
                   b
250
                   c
251
               ];
252
           opam
×
253
         | Error () ->
×
254
           User_error.raise
255
             [ Pp.concat
256
                 ~sep:Pp.space
257
                 [ User_message.command
×
258
                     (sprintf "%s config --version" (Path.to_string_maybe_quoted opam))
×
259
                 ; Pp.text "returned invalid output:"
×
260
                 ]
261
               |> Pp.hovbox
×
262
             ; Pp.verbatim version
×
263
             ]))
264
  ;;
265

266
  let opam_binary_exn () = Memo.Lazy.force opam
×
267

268
  let env =
269
    let impl (env, { Opam_switch.root; switch }) =
270
      let* opam = opam_binary_exn () in
×
271
      let args =
×
272
        List.concat
273
          [ [ "config"; "env" ]
274
          ; (match root with
275
             | None -> []
×
276
             | Some root -> [ "--root"; root ])
×
277
          ; [ "--switch"; switch; "--sexp"; "--set-switch" ]
278
          ]
279
      in
280
      let+ s =
×
281
        Process.run_capture ~display:Quiet ~env Strict opam args
282
        |> Memo.of_reproducible_fiber
×
283
      in
284
      Dune_sexp.Parser.parse_string ~fname:"<opam output>" ~mode:Single s
×
285
      |> Dune_sexp.Decoder.(parse (enter (repeat (pair string string))) Univ_map.empty)
×
286
      |> Env.Map.of_list_multi
×
287
      |> Env.Map.mapi ~f:(fun var values ->
×
288
        match List.rev values with
×
289
        | [] -> assert false
290
        | [ x ] -> x
×
291
        | x :: _ ->
×
292
          User_warning.emit
293
            [ Pp.textf "variable %S present multiple times in the output of:" var
×
294
            ; Pp.tag
×
295
                User_message.Style.Details
296
                (Pp.text (String.quote_list_for_shell (Path.to_string opam :: args)))
×
297
            ];
298
          x)
×
299
    in
300
    let module Input = struct
301
      type t = Env.t * Opam_switch.t
302

303
      let equal (env_a, opam_a) (env_b, opam_b) =
304
        Env.equal env_a env_b && Opam_switch.equal opam_a opam_b
×
305
      ;;
306

307
      let hash = Tuple.T2.hash Env.hash Opam_switch.hash
39✔
308
      let to_dyn (env, kind) = Dyn.Tuple [ Env.to_dyn env; Opam_switch.to_dyn kind ]
×
309
    end
310
    in
311
    let memo =
312
      Memo.create
313
        "opam-env"
314
        impl
315
        ~cutoff:(Env.Map.equal ~equal:String.equal)
316
        ~input:(module Input)
317
    in
318
    fun ~env opam -> Memo.exec memo (env, opam)
×
319
  ;;
320
end
321

322
module Build_environment_kind = struct
323
  (* Heuristics to detect the current environment *)
324

325
  type t =
326
    | Cross_compilation_using_findlib_toolchain of Context_name.t
327
    | Hardcoded_path of string list
328
    | Opam2_environment of string (* opam switch prefix *)
329
    | Lock
330
    | Unknown
331

332
  let query ~kind ~findlib_toolchain ~env =
333
    match findlib_toolchain with
×
334
    | Some s -> Cross_compilation_using_findlib_toolchain s
×
335
    | None ->
×
336
      let opam_prefix = Env.get env Opam_switch.opam_switch_prefix_var_name in
337
      (match kind with
×
338
       | `Opam ->
×
339
         (match opam_prefix with
340
          | Some s -> Opam2_environment s
×
341
          | None ->
342
            (* This is unreachable because we check in [create_for_opam] that opam
343
               sets this variable *)
344
            assert false)
345
       | `Lock -> Lock
×
346
       | `Default ->
×
347
         (match Setup.library_path with
348
          | _ :: _ as l -> Hardcoded_path l
×
349
          | [] ->
×
350
            (match opam_prefix with
351
             | Some s -> Opam2_environment s
×
352
             | None -> Unknown)))
×
353
  ;;
354

355
  let findlib_paths t ~findlib ~ocaml_bin =
356
    match findlib with
×
357
    | Some findlib -> Findlib_config.ocamlpath findlib
×
358
    | None ->
×
359
      (match t with
360
       | Cross_compilation_using_findlib_toolchain toolchain ->
×
361
         User_error.raise
×
362
           [ Pp.textf
×
363
               "Could not find `ocamlfind' in PATH or an environment variable \
364
                `OCAMLFIND_CONF' while cross-compiling with toolchain `%s'"
365
               (Context_name.to_string toolchain)
×
366
           ]
367
           ~hints:
368
             [ Pp.enumerate
×
369
                 [ "`opam install ocamlfind' and/or:"
370
                 ; "Point `OCAMLFIND_CONF' to the findlib configuration that defines \
371
                    this toolchain"
372
                 ]
373
                 ~f:Pp.text
374
             ]
375
       | Hardcoded_path l -> List.map l ~f:Path.of_filename_relative_to_initial_cwd
×
376
       | Opam2_environment opam_prefix ->
×
377
         let p = Path.of_filename_relative_to_initial_cwd opam_prefix in
378
         [ Path.relative p "lib" ]
×
379
       | Lock -> []
×
380
       | Unknown -> [ Path.relative (Path.parent_exn ocaml_bin) "lib" ])
×
381
      |> Memo.return
382
  ;;
383
end
384

385
let make_installed_env env name findlib env_nodes profile =
386
  let vars =
×
387
    Env.Map.singleton
388
      Execution_env.Inside_dune.var
389
      (Execution_env.Inside_dune.value (In_context (Context_name.build_dir name)))
×
390
  in
391
  Env.extend env ~vars
×
392
  |> Env.extend_env
×
393
       (Option.value ~default:Env.empty (Option.map findlib ~f:Findlib_config.env))
×
394
  |> Env.extend_env (Env_nodes.extra_env env_nodes profile)
×
395
;;
396

397
let create (builder : Builder.t) ~(kind : Kind.t) =
398
  let builder =
×
399
    match kind with
400
    | Default | Opam _ -> builder
×
401
    | Lock _ ->
×
402
      let env =
403
        Memo.lazy_
404
          ~human_readable_description:(fun () ->
405
            Pp.textf
×
406
              "base environment for context %S"
407
              (Context_name.to_string builder.name))
×
408
          (fun () ->
409
            let+ current_env = builder.env
×
410
            and+ pkg_env = Pkg_rules.exported_env builder.name in
×
411
            Env_path.extend_env_concat_path current_env pkg_env)
×
412
        |> Memo.Lazy.force
×
413
      in
414
      { builder with env }
×
415
  in
416
  let which_outside_lockdir = Which.which ~path:builder.path in
417
  let which =
418
    match kind with
419
    | Default | Opam _ -> which_outside_lockdir
×
420
    | Lock _ ->
×
421
      let which = Staged.unstage @@ Pkg_rules.which builder.name in
×
422
      fun prog ->
×
423
        Memo.push_stack_frame
×
424
          ~human_readable_description:(fun () ->
425
            Pp.textf
×
426
              "looking up binary %S in context %S"
427
              prog
428
              (Context_name.to_string builder.name))
×
429
          (fun () ->
430
            which prog
×
431
            >>= function
432
            | Some p -> Memo.return (Some p)
×
433
            | None -> Which.which ~path:builder.path prog)
×
434
  in
435
  let ocamlpath =
436
    Memo.lazy_
437
      ~human_readable_description:(fun () ->
438
        Pp.textf "loading OCAMLPATH for context %S" (Context_name.to_string builder.name))
×
439
      (fun () ->
440
        match kind with
×
441
        | Lock _ -> Pkg_rules.ocamlpath builder.name
×
442
        | Default | Opam _ ->
×
443
          let+ ocamlpath = builder.env >>| Findlib_config.ocamlpath_of_env in
×
444
          Kind.ocamlpath kind ~ocamlpath ~findlib_toolchain:builder.findlib_toolchain)
×
445
  in
446
  let findlib =
×
447
    Memo.lazy_
448
      ~human_readable_description:(fun () ->
449
        Pp.textf "loading findlib for context %S" (Context_name.to_string builder.name))
×
450
      (fun () ->
451
        let ocamlpath = Memo.Lazy.force ocamlpath in
×
452
        let* env = builder.env in
×
453
        let findlib_toolchain =
×
454
          Option.map builder.findlib_toolchain ~f:Context_name.to_string
455
        in
456
        Findlib_config.discover_from_env ~env ~which ~ocamlpath ~findlib_toolchain)
×
457
  in
458
  let ocaml_and_build_env_kind =
×
459
    Memo.Lazy.create
460
      ~name:"ocaml_and_build_env_kind"
461
      ~human_readable_description:(fun () ->
462
        Pp.textf
×
463
          "loading the OCaml compiler for context %S"
464
          (Context_name.to_string builder.name))
×
465
      (fun () ->
466
        let+ ocaml, env =
×
467
          let* findlib = Memo.Lazy.force findlib
×
468
          and* env = builder.env in
469
          let toolchain kind =
×
470
            let+ toolchain =
×
471
              Ocaml_toolchain.of_env_with_findlib
×
472
                builder.name
473
                env
474
                findlib
475
                ~which:which_outside_lockdir
476
            in
477
            toolchain, kind
×
478
          in
479
          match kind with
480
          | Default -> toolchain `Default
×
481
          | Opam _ -> toolchain `Opam
×
482
          | Lock _ ->
×
483
            Pkg_rules.ocaml_toolchain builder.name
×
484
            >>= (function
485
             | None -> toolchain `Lock
×
486
             | Some toolchain ->
×
487
               let+ toolchain, _ = Action_builder.evaluate_and_collect_facts toolchain in
×
488
               toolchain, `Default)
×
489
        in
490
        Ocaml_toolchain.register_response_file_support ocaml;
×
491
        if Option.is_some builder.fdo_target_exe
×
492
        then Ocaml_toolchain.check_fdo_support ocaml builder.name;
×
493
        ocaml, env)
×
494
  in
495
  let default_ocamlpath =
×
496
    Memo.Lazy.create ~name:"default_ocamlpath" ~cutoff:(List.equal Path.equal) (fun () ->
×
497
      let* ocaml, kind = Memo.Lazy.force ocaml_and_build_env_kind in
×
498
      let+ default_ocamlpath =
×
499
        let* findlib = Memo.Lazy.force findlib
×
500
        and* env = builder.env in
501
        Build_environment_kind.query
×
502
          ~kind
503
          ~findlib_toolchain:builder.findlib_toolchain
504
          ~env
505
        |> Build_environment_kind.findlib_paths ~findlib ~ocaml_bin:ocaml.bin_dir
506
      in
507
      if Ocaml.Version.has_META_files ocaml.version
×
508
      then ocaml.lib_config.stdlib_dir :: default_ocamlpath
×
509
      else default_ocamlpath)
×
510
  in
511
  let builder =
×
512
    let installed_env =
513
      Memo.lazy_
514
        ~human_readable_description:(fun () ->
515
          Pp.textf
×
516
            "creating installed environment for %S"
517
            (Context_name.to_string builder.name))
×
518
        (fun () ->
519
          let* findlib = Memo.Lazy.force findlib in
×
520
          let+ env = builder.env in
×
521
          make_installed_env env builder.name findlib builder.env_nodes builder.profile)
×
522
    in
523
    { builder with env = Memo.Lazy.force installed_env }
×
524
  in
525
  { kind
526
  ; builder
527
  ; build_dir = Context_name.build_dir builder.name
×
528
  ; ocaml = Memo.of_thunk (fun () -> Memo.Lazy.force ocaml_and_build_env_kind >>| fst)
×
529
  ; findlib_paths =
530
      Memo.Lazy.create ~name:"findlib_paths" (fun () ->
×
531
        let+ ocamlpath = Memo.Lazy.force ocamlpath
×
532
        and+ default_ocamlpath = Memo.Lazy.force default_ocamlpath in
×
533
        ocamlpath @ default_ocamlpath)
×
534
  ; default_ocamlpath
535
  ; build_context = Build_context.create ~name:builder.name
536
  ; which
537
  }
538
;;
539

540
module Group = struct
541
  type nonrec t =
542
    { native : t Memo.Lazy.t
543
    ; targets : t Memo.Lazy.t list
544
    }
545

546
  let create builder ~(kind : Kind.t) ~targets =
547
    let name, native =
×
548
      let implicit =
549
        not
550
          (List.mem
×
551
             targets
552
             ~equal:Workspace.Context.Target.equal
553
             Workspace.Context.Target.Native)
554
      in
555
      let builder = { builder with implicit } in
556
      ( builder.name
557
      , Memo.Lazy.create ~name:"native-context" (fun () ->
×
558
          Memo.return (create builder ~kind)) )
×
559
    in
560
    let targets =
561
      let builder =
562
        { builder with
563
          implicit = false
564
        ; merlin = false
565
        ; for_host = Some (name, Memo.Lazy.force native)
×
566
        }
567
      in
568
      List.filter_map targets ~f:(function
×
569
        | Native -> None
×
570
        | Named findlib_toolchain ->
×
571
          Some
572
            (Memo.Lazy.create ~name:"findlib_toolchain" (fun () ->
×
573
               let name = Context_name.target builder.name ~toolchain:findlib_toolchain in
×
574
               create
×
575
                 { builder with name; findlib_toolchain = Some findlib_toolchain }
576
                 ~kind
577
               |> Memo.return)))
×
578
    in
579
    { native; targets }
580
  ;;
581

582
  let default (builder : Builder.t) ~lock ~targets =
583
    let* path =
×
584
      let+ env = builder.env in
585
      Env_path.path env
×
586
    in
587
    let+ (kind : Kind.t) =
×
588
      if lock
589
      then Memo.return @@ Kind.Lock { default = true }
×
590
      else
591
        Pkg_rules.lock_dir_active builder.name
×
592
        >>| function
×
593
        | true -> Kind.Lock { default = true }
×
594
        | false -> Default
×
595
    in
596
    create { builder with path } ~kind ~targets
×
597
  ;;
598

599
  let create_for_opam (builder : Builder.t) ~switch ~loc ~targets =
600
    let* env = builder.env in
×
601
    let+ vars = Opam.env ~env switch in
×
602
    if not (Env.Map.mem vars Opam_switch.opam_switch_prefix_var_name)
×
603
    then
604
      User_error.raise
×
605
        ~loc
606
        [ Pp.textf
×
607
            "opam doesn't set the environment variable %s. I cannot create an opam build \
608
             context without opam setting this variable."
609
            Opam_switch.opam_switch_prefix_var_name
610
        ];
611
    let path =
×
612
      match Env.Map.find vars Env_path.var with
613
      | None ->
×
614
        (* CR rgrinberg: Is this even possible? *)
615
        Env_path.path env
×
616
      | Some s -> Bin.parse_path s
×
617
    in
618
    let builder = { builder with path; env = Memo.return (Env.extend env ~vars) } in
×
619
    create builder ~kind:(Opam switch) ~targets
620
  ;;
621

622
  module rec Instantiate : sig
623
    val instantiate : Context_name.t -> t Memo.t
624
  end = struct
625
    let instantiate_impl name : t Memo.t =
626
      let* workspace = Workspace.workspace () in
×
627
      let context =
×
628
        List.find_exn workspace.contexts ~f:(fun ctx ->
629
          Context_name.equal (Workspace.Context.name ctx) name)
×
630
      in
631
      let* host_context =
×
632
        match Workspace.Context.host_context context with
633
        | None -> Memo.return None
×
634
        | Some context_name ->
×
635
          let+ { native; targets = _ } = Instantiate.instantiate context_name in
×
636
          Some (context_name, Memo.Lazy.force native)
×
637
      in
638
      let builder : Builder.t =
×
639
        let builder =
640
          let env_nodes =
641
            let context = Workspace.Context.env context in
642
            { Env_nodes.context; workspace = workspace.env }
×
643
          in
644
          { Builder.empty with env_nodes; for_host = host_context }
645
        in
646
        match context with
647
        | Opam opam -> Builder.set_workspace_base builder opam.base
×
648
        | Default default ->
×
649
          let builder = Builder.set_workspace_base builder default.base in
650
          let merlin =
×
651
            workspace.merlin_context = Some (Workspace.Context.name context)
×
652
            ||
653
            match default.base.merlin with
654
            | Rules_only -> true
×
655
            | Not_selected | Selected -> false
×
656
          in
657
          { builder with merlin }
658
      in
659
      match context with
660
      | Opam { base; switch } ->
×
661
        create_for_opam builder ~switch ~loc:base.loc ~targets:base.targets
662
      | Default { lock_dir; base } ->
×
663
        let* builder =
664
          match builder.findlib_toolchain with
665
          | Some _ -> Memo.return builder
×
666
          | None ->
×
667
            let+ env = builder.env in
668
            (match Env.get env "OCAMLFIND_TOOLCHAIN" with
×
669
             | None -> builder
×
670
             | Some name ->
×
671
               { builder with
672
                 findlib_toolchain = Some (Context_name.parse_string_exn (Loc.none, name))
×
673
               })
674
        in
675
        let lock = Option.is_some lock_dir in
×
676
        default builder ~targets:base.targets ~lock
×
677
    ;;
678

679
    let memo =
680
      Memo.create "instantiate-context" ~input:(module Context_name) instantiate_impl
39✔
681
    ;;
682

683
    let instantiate name = Memo.exec memo name
×
684
  end
685

686
  include Instantiate
687
end
688

689
module DB = struct
690
  let all =
691
    let impl () =
692
      let* workspace = Workspace.workspace () in
×
693
      let* contexts =
×
694
        Memo.parallel_map workspace.contexts ~f:(fun c ->
×
695
          let+ { Group.native; targets } = Group.instantiate (Workspace.Context.name c) in
×
696
          native :: targets)
×
697
      in
698
      let+ all = List.concat contexts |> Memo.parallel_map ~f:Memo.Lazy.force in
×
699
      List.iter all ~f:(fun t ->
×
700
        let open Pp.O in
×
701
        Log.info
702
          [ Pp.box ~indent:1 (Pp.text "Dune context:" ++ Pp.cut ++ Dyn.pp (to_dyn t)) ]);
×
703
      all
×
704
    in
705
    let memo = Memo.lazy_ ~name:"build-contexts" impl in
706
    fun () -> Memo.Lazy.force memo
×
707
  ;;
708

709
  let get =
710
    let memo =
711
      Memo.create
712
        "context-db-get"
713
        ~input:(module Context_name)
714
        (fun name ->
715
          let+ contexts = all () in
×
716
          List.find_exn contexts ~f:(fun c -> Context_name.equal name c.builder.name))
×
717
    in
718
    Memo.exec memo
39✔
719
  ;;
720

721
  let by_dir dir =
722
    let context =
×
723
      match Install.Context.of_path dir with
724
      | Some name -> name
×
725
      | None ->
×
726
        Code_error.raise
×
727
          "directory does not have an associated context"
728
          [ "dir", Path.Build.to_dyn dir ]
×
729
    in
730
    get context
731
  ;;
732
end
733

734
let map_exe (context : t) =
735
  match context.builder.for_host with
×
736
  | None -> fun exe -> exe
×
737
  | Some (name, _) ->
×
738
    fun exe ->
739
      let build_dir = Context_name.build_dir name in
×
740
      (match Path.extract_build_context_dir exe with
×
741
       | Some (dir, exe) when Path.equal dir (Path.build context.build_dir) ->
×
742
         Path.append_source (Path.build build_dir) exe
×
743
       | _ -> exe)
×
744
;;
745

746
let roots =
747
  lazy
748
    (let open Setup in
×
749
     match prefix with
750
     | None -> roots
×
751
     | Some prefix ->
×
752
       let prefix = Install.Roots.make prefix ~relative:Filename.concat in
753
       Install.Roots.map2 roots prefix ~f:(fun root prefix ->
×
754
         match root with
×
755
         | None -> Some prefix
×
756
         | Some _ -> root))
×
757
;;
758

759
let roots t =
760
  let module Roots = Install.Roots in
×
761
  let+ prefix_roots =
762
    let+ env = t.builder.env in
763
    match Env.get env Opam_switch.opam_switch_prefix_var_name with
×
764
    | None -> Roots.make_all None
×
765
    | Some prefix ->
×
766
      let prefix = Path.of_filename_relative_to_initial_cwd prefix in
767
      Roots.opam_from_prefix prefix ~relative:Path.relative
×
768
      |> Roots.map ~f:(fun s -> Some s)
×
769
  in
770
  match t.kind with
×
771
  | Lock _ | Default ->
×
772
    let setup_roots = Roots.map ~f:(Option.map ~f:Path.of_string) (Lazy.force roots) in
×
773
    Roots.first_has_priority setup_roots prefix_roots
×
774
  | Opam _ -> prefix_roots
×
775
;;
STATUS · Troubleshooting · Open an Issue · Sales · Support · CAREERS · ENTERPRISE · START FREE · SCHEDULE DEMO
ANNOUNCEMENTS · TWITTER · TOS & SLA · Supported CI Services · What's a CI service? · Automated Testing

© 2026 Coveralls, Inc