Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
14 changes: 14 additions & 0 deletions src/dune_lang/package_variable_name.ml
Original file line number Diff line number Diff line change
Expand Up @@ -45,8 +45,19 @@ let name = of_string "name"
let build = of_string "build"
let post = of_string "post"
let dev = of_string "dev"
let installed = of_string "installed"
let pinned = of_string "pinned"
let enable = of_string "enable"
let one_of t xs = List.mem xs ~equal t

let absent_package_value t =
if equal t installed then Some "false" else if equal t version then Some "" else None
;;

let is_falsey_for_absent_package t =
equal t installed || equal t pinned || equal t enable
;;

let platform_specific =
Set.of_list [ arch; os; os_version; os_distribution; os_family; sys_ocaml_version ]
;;
Expand All @@ -69,6 +80,9 @@ let all_known =
; build
; post
; dev
; installed
; pinned
; enable
]
;;

Expand Down
12 changes: 12 additions & 0 deletions src/dune_lang/package_variable_name.mli
Original file line number Diff line number Diff line change
Expand Up @@ -32,8 +32,20 @@ val version : t
val post : t
val build : t
val dev : t
val installed : t
val pinned : t
val enable : t
val one_of : t -> t list -> bool

(** Returns the value of a package variable when the package is not in the
solution. Some variables have well-defined values for absent packages
(e.g., "installed" is "false"), while others are undefined and return None. *)
val absent_package_value : t -> string option

(** Returns true if the variable is known to be false/falsey for absent packages.
This includes "installed", "pinned", and "enable". *)
val is_falsey_for_absent_package : t -> bool

(** The set of variable names whose values are expected to differ depending on
the current platform. *)
val platform_specific : Set.t
Expand Down
189 changes: 126 additions & 63 deletions src/dune_pkg/lock_pkg.ml
Original file line number Diff line number Diff line change
Expand Up @@ -12,7 +12,7 @@ let add_self_to_filter_env package env variable =
else env variable
;;

let simplify_filter get_solver_var =
let simplify_filter ~packages_in_solution get_solver_var =
OpamFilter.partial_eval (fun var ->
match OpamVariable.Full.scope var with
| Global ->
Expand All @@ -25,7 +25,18 @@ let simplify_filter get_solver_var =
*)
Some (B false)
else get_solver_var name |> Option.map ~f:Variable_value.to_opam_variable_contents
| _ -> None)
| Self -> None
| Package pkg_name ->
let name = Package_name.of_opam_package_name pkg_name in
if Package_name.Map.mem packages_in_solution name
then None
else (
(* Package is absent from solution - substitute known values.
All these are false/falsey for absent packages. *)
let var_name = OpamVariable.Full.variable var |> Package_variable_name.of_opam in
if Package_variable_name.is_falsey_for_absent_package var_name
then Some (B false)
else None))
;;

let partial_eval_filter = function
Expand Down Expand Up @@ -54,40 +65,50 @@ let invalid_variable_error ~loc variable =
[ Pp.textf "Variable %S is not supported." (OpamVariable.to_string variable) ]
;;

let opam_variable_to_slang ~loc packages variable =
let variable_string = OpamVariable.to_string variable in
let convert_with_package_name package_name =
match is_valid_package_variable_name variable_string with
| false -> invalid_variable_error ~loc variable
| true ->
let pform =
let name = Package_variable_name.of_string variable_string in
let scope : Package_variable.Scope.t =
match package_name with
| None -> Self
| Some p -> Package (Package_name.of_opam_package_name p)
in
Package_variable.to_pform { Package_variable.name; scope }
in
Slang.pform pform
let opam_variable_to_slang =
let opam_var_to_pform variable_name scope =
Package_variable.to_pform { Package_variable.name = variable_name; scope }
|> Slang.pform
in
match packages with
| [] ->
(match is_valid_global_variable_name variable_string with
| false ->
(* Note that there's no syntactic distinction between global variables
fun ~loc ~packages_in_solution ~for_string_interp packages variable ->
let variable_string = OpamVariable.to_string variable in
let variable_name = Package_variable_name.of_string variable_string in
let convert_with_package_name package_name =
match is_valid_package_variable_name variable_string with
| false -> invalid_variable_error ~loc variable
| true ->
(match package_name with
| Some p ->
let pkg_name = Package_name.of_opam_package_name p in
if Package_name.Map.mem packages_in_solution pkg_name
then opam_var_to_pform variable_name (Package pkg_name)
else if for_string_interp
then
Package_variable_name.absent_package_value variable_name
|> Option.value ~default:""
|> Slang.text
else if Package_variable_name.is_falsey_for_absent_package variable_name
then Slang.bool false
else opam_var_to_pform variable_name (Package pkg_name)
| None -> opam_var_to_pform variable_name Self)
in
match packages with
| [] ->
(match is_valid_global_variable_name variable_string with
| false ->
(* Note that there's no syntactic distinction between global variables
and package variables in the current package. This check will prevent
invalid global variable names from being used for package variables in the
current package where the optional qualifier "_:" is omitted. *)
invalid_variable_error ~loc variable
| true ->
(match Pform.Var.of_opam_global_variable_name variable_string with
| Some global_var -> Slang.pform (Pform.Var global_var)
| None -> convert_with_package_name None))
| [ package_name ] -> convert_with_package_name package_name
| many ->
let many = List.map many ~f:convert_with_package_name in
Slang.blang (Blang.And (List.map many ~f:(fun slang -> Blang.Expr slang)))
invalid_variable_error ~loc variable
| true ->
(match Pform.Var.of_opam_global_variable_name variable_string with
| Some global_var -> Slang.pform (Pform.Var global_var)
| None -> convert_with_package_name None))
| [ package_name ] -> convert_with_package_name package_name
| many ->
let many = List.map many ~f:convert_with_package_name in
Slang.blang (Blang.And (List.map many ~f:(fun slang -> Blang.Expr slang)))
;;

(* Handles the special case for packages whose names contain '+' characters
Expand All @@ -113,29 +134,45 @@ let desugar_special_string_interpolation_syntax
| _ -> fident
;;

let opam_fident_to_slang ~loc fident =
let opam_fident_to_slang ~loc ~packages_in_solution ~for_string_interp fident =
let packages, variable, string_converter =
OpamFilter.desugar_fident fident |> desugar_special_string_interpolation_syntax
in
let slang = opam_variable_to_slang ~loc packages variable in
let for_string_interp =
match string_converter with
| Some _ -> false
| None -> for_string_interp
in
let slang =
opam_variable_to_slang ~loc ~packages_in_solution ~for_string_interp packages variable
in
match string_converter with
| None -> slang
| Some (then_, else_) ->
(* The "else" case is also used when evaluating the condition would expand
an undefined variable. The catch_undefined_var operator is used to
convert expressions that throw undefined variable exceptions into false.
*)
let condition =
Blang.Expr (Slang.catch_undefined_var slang ~fallback:(Slang.bool false))
let is_known_false =
match slang with
| Form (_, Blang (Blang.Const false)) -> true
| _ -> false
in
Slang.if_ condition ~then_:(Slang.text then_) ~else_:(Slang.text else_)
if is_known_false
then Slang.text else_
else (
let condition =
Blang.Expr (Slang.catch_undefined_var slang ~fallback:(Slang.bool false))
in
Slang.if_ condition ~then_:(Slang.text then_) ~else_:(Slang.text else_))
;;

let opam_raw_fident_to_slang ~loc raw_ident =
OpamTypesBase.filter_ident_of_string raw_ident |> opam_fident_to_slang ~loc
let opam_raw_fident_to_slang ~loc ~packages_in_solution ~for_string_interp raw_ident =
OpamTypesBase.filter_ident_of_string raw_ident
|> opam_fident_to_slang ~loc ~packages_in_solution ~for_string_interp
;;

let opam_string_to_slang ~package ~loc opam_string =
let opam_string_to_slang ~packages_in_solution ~package ~loc opam_string =
Re.Seq.split_full OpamFilter.string_interp_regex opam_string
|> Seq.map ~f:(function
| `Text text -> Slang.text text
Expand All @@ -146,7 +183,7 @@ let opam_string_to_slang ~package ~loc opam_string =
when String.starts_with ~prefix:"%{" interp
&& String.ends_with ~suffix:"}%" interp ->
let ident = String.sub ~pos:2 ~len:(String.length interp - 4) interp in
opam_raw_fident_to_slang ~loc ident
opam_raw_fident_to_slang ~loc ~packages_in_solution ~for_string_interp:true ident
| other ->
User_error.raise
~loc
Expand Down Expand Up @@ -216,11 +253,13 @@ let resolve_depopts ~resolve depopts =
These two Slang operators are used to emulate Opam's undefined value
semantics.
*)
let filter_to_blang ~package ~loc filter =
let filter_to_blang ~packages_in_solution ~package ~loc filter =
let filter_to_slang (filter : OpamTypes.filter) =
match filter with
| FString s -> opam_string_to_slang ~package ~loc s
| FIdent fident -> opam_fident_to_slang ~loc fident
| FString s -> opam_string_to_slang ~packages_in_solution ~package ~loc s
| FIdent fident ->
(* FIdent in filter context is truthy, so don't substitute absent values *)
opam_fident_to_slang ~loc ~packages_in_solution ~for_string_interp:false fident
| other ->
Code_error.raise
"The opam file parser should only allow identifiers and strings in places where \
Expand Down Expand Up @@ -268,27 +307,37 @@ let filter_to_blang ~package ~loc filter =
;;

let opam_commands_to_actions
~packages_in_solution
get_solver_var
loc
package
(commands : OpamTypes.command list)
=
List.filter_map commands ~f:(fun (args, filter) ->
let filter = Option.map filter ~f:(simplify_filter get_solver_var) in
let filter =
Option.map filter ~f:(simplify_filter ~packages_in_solution get_solver_var)
in
match partial_eval_filter filter with
| `Skip -> None
| `Filter filter ->
let terms =
List.filter_map args ~f:(fun ((simple_arg : OpamTypes.simple_arg), filter) ->
let filter = Option.map filter ~f:(simplify_filter get_solver_var) in
let filter =
Option.map filter ~f:(simplify_filter ~packages_in_solution get_solver_var)
in
match partial_eval_filter filter with
| `Skip -> None
| `Filter filter ->
let slang =
let slang =
match simple_arg with
| CString s -> opam_string_to_slang ~package ~loc s
| CIdent ident -> opam_raw_fident_to_slang ~loc ident
| CString s -> opam_string_to_slang ~packages_in_solution ~package ~loc s
| CIdent ident ->
opam_raw_fident_to_slang
~loc
~packages_in_solution
~for_string_interp:true
ident
in
Slang.simplify slang
in
Expand All @@ -298,18 +347,23 @@ let opam_commands_to_actions
| None -> slang
| Some filter ->
let filter_blang =
filter_to_blang ~package ~loc filter |> Slang.simplify_blang
and slang = slang in
filter_to_blang ~packages_in_solution ~package ~loc filter
|> Slang.simplify_blang
in
let filter_blang_handling_undefined =
(* Wrap the blang filter so that if any undefined
variables are expanded while evaluating the filter,
the filter will return false. *)
let slang =
Slang.catch_undefined_var
(Slang.blang filter_blang)
~fallback:(Slang.bool false)
in
Blang.Expr slang
variables are expanded while evaluating the filter,
the filter will return false. Skip wrapping if the
filter is already a constant. *)
match filter_blang with
| Const _ -> filter_blang
| _ ->
let slang =
Slang.catch_undefined_var
(Slang.blang filter_blang)
~fallback:(Slang.bool false)
in
Blang.Expr slang
in
Slang.when_ filter_blang_handling_undefined slang
in
Expand All @@ -324,7 +378,8 @@ let opam_commands_to_actions
| None -> action
| Some filter ->
let condition =
filter_to_blang ~package ~loc filter |> Slang.simplify_blang
filter_to_blang ~packages_in_solution ~package ~loc filter
|> Slang.simplify_blang
in
Action.When (condition, action)
in
Expand All @@ -349,13 +404,14 @@ let opam_commands_to_actions
solving. Opam allows depexts to be filtered by arbitrary filter expressions,
which is why the slang dsl is needed as opposed to (say) a map from
distro/version to depext name. *)
let depexts_to_conditional_external_dependencies package depexts =
let depexts_to_conditional_external_dependencies ~packages_in_solution package depexts =
List.map depexts ~f:(fun (sys_pkgs, filter) ->
let external_package_names =
OpamSysPkg.Set.to_list_map OpamSysPkg.to_string sys_pkgs
in
let condition =
filter_to_blang ~package ~loc:Loc.none filter |> Slang.simplify_blang
filter_to_blang ~packages_in_solution ~package ~loc:Loc.none filter
|> Slang.simplify_blang
in
let enabled_if =
if Slang.Blang.equal condition Slang.Blang.true_
Expand Down Expand Up @@ -456,6 +512,7 @@ let opam_package_to_lock_file_pkg
Solver_stats.Updater.expand_variable stats_updater variable_name;
Solver_env.get solver_env variable_name
in
let packages_in_solution = version_by_package_name in
let build_command =
if Resolved_package.dune_build resolved_package
then Some Lock_dir.Build_command.Dune
Expand All @@ -479,12 +536,17 @@ let opam_package_to_lock_file_pkg
| None -> action
| Some filter ->
let blang =
filter_to_blang ~package:opam_package ~loc:Loc.none filter
filter_to_blang
~packages_in_solution
~package:opam_package
~loc:Loc.none
filter
|> Slang.simplify_blang
in
Action.When (blang, action))
and build_step =
opam_commands_to_actions
~packages_in_solution
get_solver_var
loc
opam_package
Expand Down Expand Up @@ -515,6 +577,7 @@ let opam_package_to_lock_file_pkg
if portable_lock_dir
then
depexts_to_conditional_external_dependencies
~packages_in_solution
opam_package
(OpamFile.OPAM.depexts opam_file)
else (
Expand All @@ -533,7 +596,7 @@ let opam_package_to_lock_file_pkg
in
let install_command =
OpamFile.OPAM.install opam_file
|> opam_commands_to_actions get_solver_var loc opam_package
|> opam_commands_to_actions ~packages_in_solution get_solver_var loc opam_package
|> make_action
|> Option.map ~f:(fun action -> lockfile_field_choice (build_env action))
|> Option.value ~default:Lock_dir.Conditional_choice.empty
Expand Down
Loading
Loading