Browse files

Merge branch 'master' of https://github.com/OCamlPro/opam

  • Loading branch information...
2 parents c83c173 + d8ae7ec commit 5af52d08039abda82314db20d32ac09eb56028e5 @tuong committed Oct 4, 2012
View
8 CHANGES
@@ -1,4 +1,10 @@
-0.7.5 (trunk)
+0.7.6 (trunk)
+* repositories are now versionned, and we try to auto-update when possible
+
+0.7.5 [Oct 2012]
+* dependencies can now be expressed by any formula (instead of just CNF)
+* It's easier to compose the value of environment variable (ie. to write %{lwt+ssl:enable}%)
+* Fix regression on init for rsync repositories
0.7.4 [Oct 2012]
* improve 'opam pin': the code is more robust and it is now possible to pin a package to a git repository
View
2 Makefile
@@ -72,7 +72,7 @@ uninstall:
rm -f $(mandir)/man1/opam*
LIB = opam-lib
-CMI = file path file_format process globals repositories lexer run\
+CMI = opamFile path file_format process globals repositories lexer run\
linelexer types parallel utils parser
_FILES= $(LIB:%=%.a) $(LIB:%=%.cma) $(LIB:%=%.cmxa)\
$(CMI:%=%.cmi)
View
18 configure
@@ -1,6 +1,6 @@
#! /bin/sh
# Guess values for system-dependent variables and create Makefiles.
-# Generated by GNU Autoconf 2.61 for opam 0.7.5.
+# Generated by GNU Autoconf 2.61 for opam 0.7.6.
#
# Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
# 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
@@ -574,8 +574,8 @@ SHELL=${CONFIG_SHELL-/bin/sh}
# Identity of this package.
PACKAGE_NAME='opam'
PACKAGE_TARNAME='opam'
-PACKAGE_VERSION='0.7.5'
-PACKAGE_STRING='opam 0.7.5'
+PACKAGE_VERSION='0.7.6'
+PACKAGE_STRING='opam 0.7.6'
PACKAGE_BUGREPORT=''
ac_subst_vars='SHELL
@@ -1149,7 +1149,7 @@ if test "$ac_init_help" = "long"; then
# Omit some internal or obsolete options to make the list less imposing.
# This message is too long to be a string in the A/UX 3.1 sh.
cat <<_ACEOF
-\`configure' configures opam 0.7.5 to adapt to many kinds of systems.
+\`configure' configures opam 0.7.6 to adapt to many kinds of systems.
Usage: $0 [OPTION]... [VAR=VALUE]...
@@ -1210,7 +1210,7 @@ fi
if test -n "$ac_init_help"; then
case $ac_init_help in
- short | recursive ) echo "Configuration of opam 0.7.5:";;
+ short | recursive ) echo "Configuration of opam 0.7.6:";;
esac
cat <<\_ACEOF
@@ -1291,7 +1291,7 @@ fi
test -n "$ac_init_help" && exit $ac_status
if $ac_init_version; then
cat <<\_ACEOF
-opam configure 0.7.5
+opam configure 0.7.6
generated by GNU Autoconf 2.61
Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001,
@@ -1307,7 +1307,7 @@ cat >config.log <<_ACEOF
This file contains any messages produced by compilers while
running configure, to aid debugging if configure makes a mistake.
-It was created by opam $as_me 0.7.5, which was
+It was created by opam $as_me 0.7.6, which was
generated by GNU Autoconf 2.61. Invocation command line was
$ $0 $@
@@ -4146,7 +4146,7 @@ exec 6>&1
# report actual input values of CONFIG_FILES etc. instead of their
# values after options handling.
ac_log="
-This file was extended by opam $as_me 0.7.5, which was
+This file was extended by opam $as_me 0.7.6, which was
generated by GNU Autoconf 2.61. Invocation command line was
CONFIG_FILES = $CONFIG_FILES
@@ -4189,7 +4189,7 @@ Report bugs to <bug-autoconf@gnu.org>."
_ACEOF
cat >>$CONFIG_STATUS <<_ACEOF
ac_cs_version="\\
-opam config.status 0.7.5
+opam config.status 0.7.6
configured by $0, generated by GNU Autoconf 2.61,
with options \\"`echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`\\"
View
2 configure.ac
@@ -1,4 +1,4 @@
-AC_INIT(opam,0.7.5)
+AC_INIT(opam,0.7.6)
AC_COPYRIGHT(Copyright 2012 OcamlPro SAS)
AC_CONFIG_MACRO_DIR([m4])
View
18 depends.ocp.in
@@ -1,50 +1,50 @@
begin library "re"
- dirname += "%{lib}%/re"
+ dirname = "%{lib}%/re"
generated = true
end
begin library "re_perl"
- dirname += "%{lib}%/re"
+ dirname = "%{lib}%/re"
generated = true
requires = [ "re" ]
end
begin library "re_glob"
- dirname += "%{lib}%/re"
+ dirname = "%{lib}%/re"
generated = true
requires = [ "re" ]
end
begin library "re_pcre"
- dirname += "%{lib}%/re"
+ dirname = "%{lib}%/re"
generated = true
requires = [ "re_perl" ]
end
begin library "graph"
- dirname += "%{lib}%/ocamlgraph"
+ dirname = "%{lib}%/ocamlgraph"
generated = true
end
begin library "arg"
- dirname += "%{lib}%/ocaml-arg"
+ dirname = "%{lib}%/ocaml-arg"
generated = true
end
begin library "cudf"
- dirname += "%{lib}%/mancoosi-cudf"
+ dirname = "%{lib}%/mancoosi-cudf"
generated = true
requires = [ "extLib" ]
end
begin library "dose"
- dirname += "%{lib}%/mancoosi-dose"
+ dirname = "%{lib}%/mancoosi-dose"
generated = true
requires = [ "re_pcre" "extLib" "cudf" "graph" "unix" "str" ]
end
begin library "extLib"
- dirname += "%{lib}%/extlib"
+ dirname = "%{lib}%/extlib"
generated = true
end
View
319 src/client.ml
@@ -435,15 +435,14 @@ let update_repo_index t =
) repo_s
) repo_index
-let base_packages = [ "base-unix"; "base-bigarray"; "base-threads" ]
+let base_packages = List.map N.of_string [ "base-unix"; "base-bigarray"; "base-threads" ]
let create_default_compiler_description t =
let ocaml_version = OCaml_V.of_string Globals.default_compiler_version in
- let mk name = ((name,None),None) in
let f =
OpamFile.Comp.create_preinstalled
ocaml_version
- (List.map mk (if !Globals.base_packages then base_packages else []))
+ (if !Globals.base_packages then base_packages else [])
[ ("CAML_LD_LIBRARY_PATH", "=",
"%{lib}%/stublibs"
^ ":" ^
@@ -613,22 +612,22 @@ let update_packages t ~show_packages repos =
(N.to_string name)
(V.to_string version);
has_error := true);
- let map_b b = List.map (List.map (fun s -> b, s)) in
+ let map_b b = Formula.fold_left (fun accu (n,_) -> (b, n) :: accu) [] in
let depends = map_b true (OpamFile.OPAM.depends opam) in
let depopts = map_b false (OpamFile.OPAM.depopts opam) in
- List.iter (List.iter (fun (mandatory, ((d,_),_)) ->
- match find_available_package_by_name t (N.of_string d) with
+ List.iter (fun (mandatory, d) ->
+ match find_available_package_by_name t d with
| None ->
if mandatory then
Globals.warning
"Package %s depends on the unknown package %s"
- (NV.to_string nv) d
+ (NV.to_string nv) (N.to_string d)
else
Globals.warning
"Package %s depends optionally on the unknown package %s"
- (NV.to_string nv) d
+ (NV.to_string nv) (N.to_string d)
| Some _ -> ()
- )) (depends @ depopts)
+ ) (depends @ depopts)
) (get_available_current t);
if !has_error then
Globals.exit 1
@@ -637,9 +636,8 @@ let update_packages t ~show_packages repos =
let contents_of_variable t v =
let name = Full_variable.package v in
let var = Full_variable.variable v in
- let name_str = N.to_string name in
let var_str = Variable.to_string var in
- let read_var () =
+ let read_var name =
let c = OpamFile.Dot_config.safe_read (Path.C.config t.compiler name) in
try match Full_variable.section v with
| None -> OpamFile.Dot_config.variable c var
@@ -650,7 +648,7 @@ let contents_of_variable t v =
try S (Sys.getenv var_str)
with Not_found ->
match current_ocaml_version t with
- | None -> read_var ()
+ | None -> read_var name
| Some ocaml_version ->
if var_str = "ocaml-version" then (
let ocaml_version_str = OCaml_V.to_string ocaml_version in
@@ -664,21 +662,54 @@ let contents_of_variable t v =
let comp = OpamFile.Comp.read (Path.G.compiler t.global ocaml_version) in
B (OpamFile.Comp.preinstalled comp)
) else
- read_var ()
+ read_var name
) else (
- try S (Sys.getenv (name_str ^"_"^ var_str))
- with Not_found ->
- let installed = mem_installed_package_by_name t name in
- if var = Variable.enable && installed then
- S "enable"
- else if var = Variable.enable && not installed then
- S "disable"
- else if var = Variable.installed then
- B installed
- else if not installed then
- Globals.error_and_exit "Package %s is not installed" (N.to_string name)
- else
- read_var ()
+ let process_one name =
+ let name_str = N.to_string name in
+ try Some (S (Sys.getenv (name_str ^"_"^ var_str)))
+ with Not_found ->
+ let installed = mem_installed_package_by_name t name in
+ if var = Variable.enable && installed then
+ Some (S "enable")
+ else if var = Variable.enable && not installed then
+ Some (S "disable")
+ else if var = Variable.installed then
+ Some (B installed)
+ else if not installed then
+ None
+ else
+ Some (read_var name) in
+ match process_one name with
+ | Some r -> r
+ | None ->
+ let name_str = N.to_string name in
+ let names = Utils.split name_str '+' in
+ if List.length names = 1 then
+ Globals.error_and_exit "Package %s is not installed" name_str;
+ let names = List.map N.of_string names in
+ let results =
+ List.map (fun name ->
+ match process_one name with
+ | None -> Globals.error_and_exit "Package %s is not installed" (N.to_string name)
+ | Some r -> r
+ ) names in
+ let rec compose x y = match x,y with
+ | S "enable" , S "enable" -> S "enable"
+ | S "disable", S "enable"
+ | S "enable" , S "disable"
+ | S "disable", S "disable" -> S "disable"
+ | B b1 , B b2 -> B (b1 && b2)
+ | S b, r | r, S b ->
+ if b = "true" then compose (B true) r
+ else if b = "false" then compose (B false) r
+ else
+ Globals.error_and_exit
+ "Cannot compose %s and %s"
+ (string_of_variable_contents x)
+ (string_of_variable_contents y) in
+ match results with
+ | [] | [_] -> assert false
+ | h::t -> List.fold_left compose h t
)
(* Substitute the file contents *)
@@ -1074,15 +1105,12 @@ let proceed_toinstall t nv =
in depends (XXX there is surely a way to get it from the solver) *)
let local_sections = OpamFile.Dot_config.Section.available config in
let libraries_in_opam =
- List.fold_left (fun accu l ->
- List.fold_left (fun accu ((n,_),_) ->
- let n = N.of_string n in
- let nv = find_installed_package_by_name t n in
- let opam = OpamFile.OPAM.read (Path.G.opam t.global nv) in
- let libs = OpamFile.OPAM.libraries opam in
- let syntax = OpamFile.OPAM.syntax opam in
- List.fold_right Section.Set.add (libs @ syntax) accu
- ) accu l
+ Formula.fold_left (fun accu (n,_) ->
+ let nv = find_installed_package_by_name t n in
+ let opam = OpamFile.OPAM.read (Path.G.opam t.global nv) in
+ let libs = OpamFile.OPAM.libraries opam in
+ let syntax = OpamFile.OPAM.syntax opam in
+ List.fold_right Section.Set.add (libs @ syntax) accu
) Section.Set.empty (OpamFile.OPAM.depends opam) in
let libraries_in_config =
List.fold_left (fun accu s ->
@@ -1568,32 +1596,27 @@ module Heuristic = struct
let pkg_available, pkg_not =
List.partition
- (function (name, _), _ ->
- N.Map.mem (N.of_string name) available)
- (OpamFile.Comp.packages comp) in
-
- let () = (* check that all packages in [comp] are in [available]
- except for "base-..."
- (depending if "-no-base-packages" is set or not) *)
- match
- let pkg_not = List.rev_map (function (n, _), _ -> n) pkg_not in
- if !Globals.base_packages then
- pkg_not
- else
- List.filter (fun n -> not (List.mem n base_packages)) pkg_not
- with
- | [] -> ()
- | l ->
- let () = List.iter (Globals.error "Package %s not found") l in
- Globals.exit 66 in
-
- List.rev_map
- (function
- | (name, _), None ->
- let name = N.of_string name in
- f_h None (N.Map.find name available) name
- | n, v -> n, v)
- pkg_available
+ (fun (n, _) -> N.Map.mem n available)
+ (Formula.atoms (OpamFile.Comp.packages comp)) in
+
+ (* check that all packages in [comp] are in [available]
+ except for "base-..."
+ (depending if "-no-base-packages" is set or not) *)
+ let pkg_not = List.rev_map (function (n, _) -> n) pkg_not in
+ let pkg_not =
+ if !Globals.base_packages then
+ pkg_not
+ else
+ List.filter (fun n -> not (List.mem n base_packages)) pkg_not in
+ if pkg_not <> [] then (
+ List.iter (N.to_string |> Globals.error "Package %s not found") pkg_not;
+ Globals.exit 2
+ );
+
+ List.rev_map (function
+ | n, None -> f_h None (N.Map.find n available) n
+ | n, Some (r,v) -> (N.to_string n, None), Some (r, V.to_string v)
+ ) pkg_available
(* Take a list of version constraints and an heuristic, and return a list of
packages constraints satisfying the constraints *)
@@ -1890,6 +1913,77 @@ let dry_upgrade () =
| Conflicts _ -> None
| Success sol -> Some (get_stats sol)
+let upgrade names =
+ log "upgrade %s" (N.Set.to_string names);
+ let t = update_available_current (load_state ()) in
+ let reinstall = NV.Set.inter t.reinstall t.installed in
+ let to_not_reinstall = ref NV.Set.empty in
+ let solution_found = ref No_solution in
+ if N.Set.is_empty names then (
+ let solution = Heuristic.resolve (`upgrade reinstall) t
+ (List.map (fun to_upgrade ->
+ { wish_install = [];
+ wish_remove = [];
+ wish_upgrade = N.Map.values (Heuristic.get_installed t to_upgrade) })
+ [ Heuristic.v_max; Heuristic.v_ge ]) in
+ solution_found := solution;
+ ) else (
+ let names = Heuristic.nv_of_names t names in
+ let partial_reinstall = NV.Set.of_list (List.map nv_of_version_constraint names) in
+ to_not_reinstall := NV.Set.diff reinstall partial_reinstall;
+ let solution = Heuristic.resolve (`upgrade partial_reinstall) t
+ (List.map (fun (to_upgrade, to_keep) ->
+ let wish_install = Heuristic.get_installed t to_keep in
+ let wish_install =
+ (* Remove the packages in [names] *)
+ N.Map.filter
+ (fun n _ -> List.for_all (fun vc -> name_of_version_constraint vc <> n) names)
+ wish_install in
+ let wish_install = N.Map.values wish_install in
+ let wish_upgrade = Heuristic.apply to_upgrade names in
+ { wish_install;
+ wish_remove = [];
+ wish_upgrade })
+ [ (Heuristic.v_max, Heuristic.v_eq);
+ (Heuristic.v_max, Heuristic.v_ge);
+ (Heuristic.v_max, Heuristic.v_any);
+ (Heuristic.v_ge , Heuristic.v_eq);
+ (Heuristic.v_ge , Heuristic.v_ge);
+ (Heuristic.v_ge , Heuristic.v_any); ]
+ ) in
+ solution_found := solution;
+ );
+ let t = load_state () in
+ begin match !solution_found with
+ | OK -> ()
+ | Nothing_to_do -> Globals.msg "Already up-to-date.\n"
+ | Aborted
+ | No_solution -> to_not_reinstall := reinstall
+ end;
+ let reinstall = NV.Set.inter t.installed !to_not_reinstall in
+ let reinstall_f = Path.C.reinstall t.compiler in
+ if NV.Set.is_empty reinstall then
+ Filename.remove reinstall_f
+ else
+ OpamFile.Reinstall.write reinstall_f reinstall
+
+let check_opam_version () =
+ let t = load_state () in
+ let n = N.of_string "opam" in
+ let current_version =
+ let v = match Run.read_command_output ["opam"; "--version"] with
+ | s::_ -> List.hd (List.rev (Utils.split s ' '))
+ | _ -> assert false in
+ V.of_string v in
+ let max_version = V.Set.max_elt (Path.G.available_versions t.global n) in
+ if V.compare max_version current_version > 0 then (
+ if confirm "Your version of opam (%s) is not up-to-date. Do you want to upgrade to version %s ?"
+ (V.to_string current_version)
+ (V.to_string max_version)
+ then
+ upgrade (N.Set.singleton n)
+ )
+
let update repos =
log "update %s" (String.concat " " repos);
let t = load_state () in
@@ -1910,13 +2004,19 @@ let update repos =
update_packages t ~show_packages:true repos;
);
match dry_upgrade () with
- | None -> Globals.msg "Already up-to-date.\n"
- | Some stats ->
- if sum stats > 0 then (
- print_stats stats;
- Globals.msg "You can now run 'opam upgrade' to upgrade your system.\n"
- ) else
- Globals.msg "Already up-to-date.\n"
+ | None -> Globals.msg "Already up-to-date.\n"
+ | Some _ ->
+ check_opam_version ();
+ (* we re-run dry_upgrade, as some packages might have been
+ upgraded by the precedent function *)
+ match dry_upgrade () with
+ | None -> Globals.msg "Already up-to-date.\n"
+ | Some stats ->
+ if sum stats > 0 then (
+ print_stats stats;
+ Globals.msg "You can now run 'opam upgrade' to upgrade your system.\n"
+ ) else
+ Globals.msg "Already up-to-date.\n"
let init repo ocaml_version cores =
log "init %s" (Repository.to_string repo);
@@ -2000,16 +2100,16 @@ let install names =
List.iter
(fun nv ->
let opam = OpamFile.OPAM.read (Path.G.opam t.global nv) in
- let f_warn =
- List.iter
- (fun ((n, _), _) ->
- if not (N.Map.mem (N.of_string n) available) then
- Globals.warning "unknown package %S" n) in
- List.iter (List.iter f_warn)
- [ OpamFile.OPAM.depends opam
- ; OpamFile.OPAM.depopts opam ];
- f_warn (OpamFile.OPAM.conflicts opam))
- pkg_new;
+ let f_warn (n, _) =
+ if not (N.Map.mem n available) then
+ Globals.warning "unknown package %S" (N.to_string n)
+ in
+ List.iter (Formula.iter f_warn) [
+ OpamFile.OPAM.depends opam;
+ OpamFile.OPAM.depopts opam;
+ OpamFile.OPAM.conflicts opam;
+ ]
+ ) pkg_new;
let name_new = List.map NV.name pkg_new in
List.iter (fun n -> log "new: %s" (N.to_string n)) name_new;
@@ -2136,60 +2236,6 @@ let remove names =
; Heuristic.v_any ]) in
())
-let upgrade names =
- log "upgrade %s" (N.Set.to_string names);
- let t = update_available_current (load_state ()) in
- let reinstall = NV.Set.inter t.reinstall t.installed in
- let to_not_reinstall = ref NV.Set.empty in
- let solution_found = ref No_solution in
- if N.Set.is_empty names then (
- let solution = Heuristic.resolve (`upgrade reinstall) t
- (List.map (fun to_upgrade ->
- { wish_install = [];
- wish_remove = [];
- wish_upgrade = N.Map.values (Heuristic.get_installed t to_upgrade) })
- [ Heuristic.v_max; Heuristic.v_ge ]) in
- solution_found := solution;
- ) else (
- let names = Heuristic.nv_of_names t names in
- let partial_reinstall = NV.Set.of_list (List.map nv_of_version_constraint names) in
- to_not_reinstall := NV.Set.diff reinstall partial_reinstall;
- let solution = Heuristic.resolve (`upgrade partial_reinstall) t
- (List.map (fun (to_upgrade, to_keep) ->
- let wish_install = Heuristic.get_installed t to_keep in
- let wish_install =
- (* Remove the packages in [names] *)
- N.Map.filter
- (fun n _ -> List.for_all (fun vc -> name_of_version_constraint vc <> n) names)
- wish_install in
- let wish_install = N.Map.values wish_install in
- let wish_upgrade = Heuristic.apply to_upgrade names in
- { wish_install;
- wish_remove = [];
- wish_upgrade })
- [ (Heuristic.v_max, Heuristic.v_eq);
- (Heuristic.v_max, Heuristic.v_ge);
- (Heuristic.v_max, Heuristic.v_any);
- (Heuristic.v_ge , Heuristic.v_eq);
- (Heuristic.v_ge , Heuristic.v_ge);
- (Heuristic.v_ge , Heuristic.v_any); ]
- ) in
- solution_found := solution;
- );
- let t = load_state () in
- begin match !solution_found with
- | OK -> ()
- | Nothing_to_do -> Globals.msg "Already up-to-date.\n"
- | Aborted
- | No_solution -> to_not_reinstall := reinstall
- end;
- let reinstall = NV.Set.inter t.installed !to_not_reinstall in
- let reinstall_f = Path.C.reinstall t.compiler in
- if NV.Set.is_empty reinstall then
- Filename.remove reinstall_f
- else
- OpamFile.Reinstall.write reinstall_f reinstall
-
let reinstall names =
log "reinstall %s" (N.Set.to_string names);
let t = update_available_current (load_state ()) in
@@ -2314,9 +2360,12 @@ let config request =
| Some oversion ->
let comp = OpamFile.Comp.read (Path.G.compiler t.global oversion) in
let names =
- List.filter
- (fun n -> NV.Set.exists (fun nv -> NV.name nv = n) t.installed)
- (List.map (function (n, _), _ -> N.of_string n) (OpamFile.Comp.packages comp))
+ Utils.filter_map
+ (fun (n,_) ->
+ if NV.Set.exists (fun nv -> NV.name nv = n) t.installed
+ then Some n
+ else None)
+ (Formula.atoms (OpamFile.Comp.packages comp))
@ List.map Full_section.package c.options in
(* Compute the transitive closure of package dependencies *)
let package_deps =
View
122 src/file_format.ml
@@ -288,76 +288,64 @@ let assoc_list items n parse =
let assoc_string_list s n =
assoc_list s n (parse_list parse_string)
-(* transform: "foo" (< "1", > "2") => "foo" (< "1"), "foo" (>"2") *)
-let rec parse_constraints name = function
- | [] -> []
- | (Symbol r) :: (String v) :: [] ->
- [ ((name,None), Some (r, v)) ]
- | (Symbol r) :: (String v) :: (Symbol ",") :: t ->
- ((name,None), Some (r, v)) :: parse_constraints name t
- | x -> bad_format "Expecting a constraint, got %s" (kinds x)
-
-(* contains only "," *)
-let rec parse_and_formula_aux = function
- | [] -> []
- | [String name] -> [ ((name,None), None) ]
- | [Option(String name, g)] -> parse_constraints name g
- | [Group g] -> parse_and_formula_aux g
- | [ x ] -> bad_format "Expecting string or group, got %s" (kind x)
- | e1 :: e2 -> parse_and_formula_aux [e1] @ parse_and_formula_aux e2
-
-let parse_and_formula = function
- | List l -> parse_and_formula_aux l
+(* Parse any constraint list *)
+let rec parse_constraints t =
+ let open Types.Formula in
+ match t with
+ | [] -> Empty
+ | (Symbol r) :: (String v) :: [] -> Atom (r, Types.V.of_string v)
+ | (Symbol r) :: (String v) :: (Symbol "&") :: t -> And (Atom (r, Types.V.of_string v), parse_constraints t)
+ | (Symbol r) :: (String v) :: (Symbol "|") :: t -> Or (Atom (r, Types.V.of_string v), parse_constraints t)
+ | [Group g] -> Block (parse_constraints g)
+ | x -> bad_format "Expecting a list of constraints, got %s" (kinds x)
+
+let rec make_constraints t =
+ let open Types.Formula in
+ match t with
+ | Empty -> []
+ | Atom (r, v) -> [Symbol r; String (Types.V.to_string v)]
+ | And (x, y) -> make_constraints x @ [Symbol "&"] @ make_constraints y
+ | Or (x, y) -> make_constraints x @ [Symbol "|"] @ make_constraints y
+ | Block g -> [Group (make_constraints g)]
+
+(* parse a list of formulas *)
+let rec parse_formulas opt t =
+ let open Types.Formula in
+ match t with
+ | [] -> Empty
+ | [String name] -> Atom (Types.N.of_string name, Empty)
+ | [Option(String name, g)] -> Atom (Types.N.of_string name, parse_constraints g)
+ | [Group g] -> parse_formulas opt g
+ | e1 :: Symbol "|" :: e2 -> Or (parse_formulas opt [e1], parse_formulas opt e2)
+ | e1 :: Symbol "&" :: e2 -> And (parse_formulas opt [e1], parse_formulas opt e2)
+ | e1 :: e2 when opt -> Or (parse_formulas opt [e1], parse_formulas opt e2)
+ | e1 :: e2 -> And (parse_formulas opt [e1], parse_formulas opt e2)
+
+let rec make_formulas opt t =
+ let open Types.Formula in
+ match t with
+ | Empty -> []
+ | Atom (name, Empty) -> [String (Types.N.to_string name)]
+ | Atom (name, cs) -> [Option(String (Types.N.to_string name), make_constraints cs)]
+ | Block f -> [Group (make_formulas opt f)]
+ | And(e,f) when opt -> make_formulas opt e @ [Symbol "&"] @ make_formulas opt f
+ | And(e,f) -> make_formulas opt e @ make_formulas opt f
+ | Or(e,f) when opt -> make_formulas opt e @ make_formulas opt f
+ | Or(e,f) -> make_formulas opt e @ [Symbol "|"] @ make_formulas opt f
+
+let parse_formula = function
+ | List l -> parse_formulas false l
| x -> bad_format "Expecting list, got %s" (kind x)
-(* contains only "|" *)
-let rec parse_or_formula_aux = function
- | [] -> []
- | [String name] -> [ ((name,None), None) ]
- | [Option(String name, g)] -> parse_constraints name g
- | [Group g] -> parse_or_formula_aux g
- | [ x ] -> bad_format "Expecting string or group, got %s" (kind x)
- | e1 :: Symbol "|" :: e2 -> parse_or_formula_aux [e1] @ parse_or_formula_aux e2
- | _ -> bad_format "Expecting a 'or' formula"
-
-let parse_or_formula = function
- | List l -> parse_or_formula_aux l
- | x -> bad_format "Expecting list, got %s" (kind x)
-
-let rec parse_cnf_formula_aux = function
- | [] -> []
- | e1 :: e2 -> parse_or_formula_aux [e1] :: parse_cnf_formula_aux e2
+let make_formula f =
+ List (make_formulas false f)
-let parse_cnf_formula = function
- | List l -> parse_cnf_formula_aux l
+let parse_opt_formula = function
+ | List l -> parse_formulas true l
| x -> bad_format "Expecting list, got %s" (kind x)
-let make_constraint = function
- | (name,_), None -> String name
- | (name,_), Some (r,v) -> Option (String name, [Symbol r; String v])
-
-let make_and_formula_aux l =
- List.map make_constraint l
-
-let make_and_formula l =
- List (make_and_formula_aux l)
-
-let make_cnf_formula l =
- let cnf =
- List.fold_left (fun cnf l ->
- let orl = List.map make_constraint l in
- let orl =
- List.fold_left (fun orl elt ->
- match orl with
- | [] -> [elt]
- | _ -> elt :: Symbol "|" :: orl
- ) [] orl in
- match orl with
- | [] -> cnf
- | [c] -> c :: cnf
- | _ -> (Group (List.rev orl)) :: cnf
- ) [] l in
- List (List.rev cnf)
+let make_opt_formula f =
+ List (make_formulas true f)
let parse_relop = function
| "=" -> `Eq
@@ -373,6 +361,10 @@ let parse_constraint = function
with _ -> bad_format "Expecting a relop, got %s" r)
| x -> bad_format "Expecting a constraint, got %s" (kind x)
+let make_constraint = function
+ | (name,_), None -> String name
+ | (name,_), Some (r,v) -> Option (String name, [Symbol r; String v])
+
let string_of_relop = function
| `Eq -> "="
| `Geq -> ">="
View
18 src/file_format.mli
@@ -207,19 +207,17 @@ val assoc_sections: item list -> string -> (section -> 'a) -> 'a list
open Types
-(** Parse an AND formala such as
- ["foo", "bar" (<"1", >"2"), "aa" ] *)
-val parse_and_formula : value -> and_formula
+(** Parse package formula where AND are implicit: [x y -> x & y] *)
+val parse_formula : value -> Formula.t
-(** Parse an CNF formula (which contains only inlevel OR) such as
- ["foo" ("bar"(<"1") | "bar" (>"2"))] *)
-val parse_cnf_formula : value -> cnf_formula
+(** Build a formula where AND are implicit. *)
+val make_formula : Formula.t -> value
-(** Build an AND formula *)
-val make_and_formula : and_formula -> value
+(** Parse optional package formula where OR are implicit: [x y -> x | y] *)
+val parse_opt_formula : value -> Formula.t
-(** Build a CNF formula *)
-val make_cnf_formula : cnf_formula -> value
+(** Build a formula where OR are implicit. *)
+val make_opt_formula : Formula.t -> value
(** Parse a simple constraint *)
val parse_constraint: value -> ocaml_constraint
View
2 src/globals.ml.in
@@ -112,7 +112,7 @@ let makecmd = ref (match os with FreeBSD | OpenBSD -> "gmake" | _ -> "make") (*
let default_cores = 1
-let version () =
+let version_msg () =
Printf.printf "\
%s version %s
View
2 src/opam.ml
@@ -41,7 +41,7 @@ let global_args = [
"--debug" , Arg.Set Globals.debug , " Print internal debug messages (very verbose)";
"--verbose" , Arg.Set Globals.verbose , " Display the output of subprocesses";
"--quiet" , Arg.Clear quiet , " Do not display the output of subprocesses";
- "--version" , Arg.Unit Globals.version, " Display version information";
+ "--version" , Arg.Unit Globals.version_msg, " Display version information";
"--yes" , Arg.Set Globals.yes , " Answer yes to all questions";
"--makecmd" , Arg.Set_string Globals.makecmd,
Printf.sprintf " Set the 'make' program used when compiling packages (default is %s)" !Globals.makecmd;
View
50 src/opamFile.ml
@@ -499,9 +499,9 @@ module OPAM = struct
build_env : (string * string * string) list;
build : command list;
remove : command list;
- depends : cnf_formula;
- depopts : cnf_formula;
- conflicts : and_formula;
+ depends : Formula.t;
+ depopts : Formula.t;
+ conflicts : Formula.t;
libraries : section list;
syntax : section list;
patches : (basename * filter option) list;
@@ -518,9 +518,9 @@ module OPAM = struct
build_env = [];
build = [];
remove = [];
- depends = [];
- depopts = [];
- conflicts = [];
+ depends = Formula.Empty;
+ depopts = Formula.Empty;
+ conflicts = Formula.Empty;
libraries = [];
syntax = [];
files = [];
@@ -552,6 +552,7 @@ module OPAM = struct
let s_ocaml_version = "ocaml-version"
let s_patches = "patches"
let s_files = "files"
+ let s_configure_style = "configure-style"
(* to convert to cudf *)
(* see [Debcudf.add_inst] for more details about the format *)
@@ -584,6 +585,7 @@ module OPAM = struct
s_homepage;
s_version;
s_name;
+ s_configure_style;
]
let name t = t.name
@@ -617,17 +619,15 @@ module OPAM = struct
(* XXX: Pre-encode the depends and conflict fields to avoid
headaches when interfacing with the solver *)
- let lencode = List.map (fun ((n,a),c) -> (Common.CudfAdd.encode n,a), c)
- let llencode = List.map lencode
+ let encode = Formula.map (fun (n,c) -> N.of_string (Common.CudfAdd.encode (N.to_string n)), c)
let default_package t =
- let depopts =
- string_of_value (File_format.make_cnf_formula (llencode t.depopts)) in
+ let depopts = string_of_value (File_format.make_opt_formula t.depopts) in
{ D.default_package with
D.name = N.to_string t.name ;
D.version = V.to_string t.version ;
- D.depends = llencode t.depends ;
- D.conflicts = lencode t.conflicts ;
+ D.depends = Formula.to_cnf (encode t.depends);
+ D.conflicts = Formula.to_conjunction (encode t.conflicts);
D.extras = (s_depopts, depopts) :: D.default_package.D.extras }
let to_package t ~installed =
@@ -650,9 +650,9 @@ module OPAM = struct
Variable (s_build_env, make_list make_env_variable t.build_env);
Variable (s_build, make_list make_command t.build);
Variable (s_remove, make_list make_command t.remove);
- Variable (s_depends, make_cnf_formula t.depends);
- Variable (s_depopts, make_cnf_formula t.depopts);
- Variable (s_conflicts, make_and_formula t.conflicts);
+ Variable (s_depends, make_formula t.depends);
+ Variable (s_depopts, make_opt_formula t.depopts);
+ Variable (s_conflicts, make_formula t.conflicts);
Variable (s_libraries, make_list (Section.to_string |> make_string) t.libraries);
Variable (s_syntax, make_list (Section.to_string |> make_string) t.syntax);
Variable (s_files, make_list make_file t.files);
@@ -708,9 +708,9 @@ module OPAM = struct
let build_env = assoc_list s s_build_env (parse_list parse_env_variable) in
let build = assoc_default [] s s_build parse_commands in
let remove = assoc_list s s_remove parse_commands in
- let depends = assoc_list s s_depends parse_cnf_formula in
- let depopts = assoc_list s s_depopts parse_cnf_formula in
- let conflicts = assoc_list s s_conflicts parse_and_formula in
+ let depends = assoc_default Formula.Empty s s_depends parse_formula in
+ let depopts = assoc_default Formula.Empty s s_depopts parse_opt_formula in
+ let conflicts = assoc_default Formula.Empty s s_conflicts parse_formula in
let libraries = assoc_list s s_libraries (parse_list (parse_string |> Section.of_string)) in
let syntax = assoc_list s s_syntax (parse_list (parse_string |> Section.of_string)) in
let ocaml_version = assoc_option s s_ocaml_version parse_constraint in
@@ -1054,7 +1054,7 @@ module Comp = struct
asmcomp : string list ;
bytelink : string list ;
asmlink : string list ;
- packages : and_formula ;
+ packages : Formula.t ;
requires : section list;
pp : ppflag option;
env : (string * string * string) list;
@@ -1073,13 +1073,19 @@ module Comp = struct
asmcomp = [];
bytelink = [];
asmlink = [];
- packages = [];
+ packages = Formula.Empty;
requires = [];
pp = None;
env = [];
}
let create_preinstalled name packages env =
+ let open Formula in
+ let mk n = Atom (n, Empty) in
+ let rec aux accu t = match accu, t with
+ | Empty, x -> mk x
+ | _ , x -> And(accu, mk x) in
+ let packages = List.fold_left aux Formula.Empty packages in
{ empty with name; preinstalled = true; packages; env }
let s_name = "name"
@@ -1158,7 +1164,7 @@ module Comp = struct
let asmcomp = assoc_string_list s s_asmcomp in
let bytelink = assoc_string_list s s_bytecomp in
let asmlink = assoc_string_list s s_asmlink in
- let packages = assoc_list s s_packages parse_and_formula in
+ let packages = assoc_default Formula.Empty s s_packages parse_formula in
let requires =
assoc_list s s_requires (parse_list (parse_string |> Section.of_string)) in
let pp = assoc_default None s s_pp parse_ppflags in
@@ -1200,7 +1206,7 @@ module Comp = struct
Variable (s_asmcomp , make_list make_string s.asmcomp);
Variable (s_bytelink , make_list make_string s.bytelink);
Variable (s_asmlink , make_list make_string s.asmlink);
- Variable (s_packages , make_and_formula s.packages);
+ Variable (s_packages , make_formula s.packages);
Variable (s_requires , make_list (Section.to_string |> make_string) s.requires);
Variable (s_env , make_list make_env_variable s.env);
] @ match s.pp with
View
14 src/opamFile.mli
@@ -108,13 +108,13 @@ module OPAM: sig
val remove: t -> command list
(** Package dependencies *)
- val depends: t -> cnf_formula
+ val depends: t -> Formula.t
(** Optional dependencies *)
- val depopts: t -> cnf_formula
+ val depopts: t -> Formula.t
(** Package conflicts *)
- val conflicts: t -> and_formula
+ val conflicts: t -> Formula.t
(** List of exported libraries *)
val libraries: t -> section list
@@ -135,10 +135,10 @@ module OPAM: sig
val patches: t -> (basename * filter option) list
(** Construct as [depends] *)
- val with_depends : t -> cnf_formula -> t
+ val with_depends : t -> Formula.t -> t
(** Construct as [depopts] *)
- val with_depopts : t -> cnf_formula -> t
+ val with_depopts : t -> Formula.t -> t
(** Construct as [build] *)
val with_build: t -> command list -> t
@@ -202,7 +202,7 @@ module Comp: sig
(** Create a pre-installed compiler description file *)
val create_preinstalled:
- OCaml_V.t -> and_formula -> (string * string * string) list -> t
+ OCaml_V.t -> name list -> (string * string * string) list -> t
(** Is it a pre-installed compiler description file *)
val preinstalled: t -> bool
@@ -227,7 +227,7 @@ module Comp: sig
val build: t -> string list list
(** Packages to install immediately after the creation of OCaml *)
- val packages: t -> and_formula
+ val packages: t -> Formula.t
(** Linking options to give to the native code compiler *)
val asmlink: t -> string list
View
2 src/path.ml
@@ -164,6 +164,8 @@ module R = struct
let root t = t
+ let version t = t // "version"
+
let config t = t // "config"
let packages_dir t = t / "packages"
View
3 src/path.mli
@@ -189,6 +189,9 @@ module R: sig
(** Return the repository folder: {i $opam/repo/$repo} *)
val root: t -> dirname
+ (** Return the version file *)
+ val version: t -> filename
+
(** Return the repository config: {i $opam/repo/$repo/config} *)
val config: t -> filename
View
1 src/repo/rsync.ml
@@ -102,6 +102,7 @@ module B = struct
let updates = Filename.Set.of_list archives
++ sync_dir Path.R.packages_dir
++ sync_dir Path.R.compilers_dir in
+ ignore (rsync_file (Path.R.version remote_repo) (Path.R.version local_repo));
updates
let upload_dir ~address local_dir =
View
13 src/repositories.ml
@@ -208,6 +208,8 @@ let make_archive ?(gener_digest=false) ?local_path nv =
(* Eventually add the <package>/files/* to the extracted dir *)
let files =
+ if not (Dirname.exists extract_dir) then
+ Dirname.mkdir extract_dir;
Dirname.in_dir extract_dir (fun () -> copy_files local_repo nv) in
(* And finally create the final archive *)
@@ -243,12 +245,23 @@ let download r nv =
(NV.to_string nv);
Dirname.in_dir local_dir (fun () -> make_archive nv)
+let check_version repo =
+ let repo_version =
+ try V.of_string (Utils.string_strip (Raw.to_string (Filename.read (Path.R.version repo))))
+ with e -> V.of_string "0.7.5" in
+ if V.compare repo_version (V.of_string Globals.version) >= 0 then
+ Globals.error_and_exit
+ "\nThe current version of OPAM cannot read the repository. \
+ You should upgrade to at least the version %s.\n" (V.to_string repo_version)
+
let update r =
log "update %s" (Repository.to_string r);
let local_repo = Path.R.create r in
let local_dir = Path.R.root local_repo in
let module B = (val find_backend r: BACKEND) in
let updated_files = Dirname.in_dir local_dir (fun () -> B.update (Repository.address r)) in
+
+ check_version local_repo;
let updated_packages = nv_set_of_files updated_files in
(* Clean-up archives and tmp files on URL changes *)
View
2 src/scripts/opam_check.ml
@@ -8,7 +8,7 @@ let label = ref ""
let spec = Arg.align [
("--root", Arg.Set_string Globals.root_path, " Set opam path");
("-l" , Arg.Set_string label , " Set a test label");
- ("--version", Arg.Unit Globals.version , " Display version information");
+ ("--version", Arg.Unit Globals.version_msg , " Display version information");
]
let packages = ref []
View
12 src/scripts/opam_mk_repo.ml
@@ -35,8 +35,8 @@ let all, index, packages, gener_digest, dryrun, recurse =
let dryrun = ref false in
let recurse = ref false in
let specs = Arg.align [
- ("-v" , Arg.Unit Globals.version, " Display version information");
- ("--version", Arg.Unit Globals.version, " Display version information");
+ ("-v" , Arg.Unit Globals.version_msg, " Display version information");
+ ("--version", Arg.Unit Globals.version_msg, " Display version information");
("-a" , Arg.Set all, "");
("--all", Arg.Set all , Printf.sprintf " Build all package archives (default is %b)" !all);
@@ -83,11 +83,9 @@ let () =
let opam = OpamFile.OPAM.read opam_f in
let deps = OpamFile.OPAM.depends opam in
let depopts = OpamFile.OPAM.depopts opam in
- List.fold_left (fun accu l ->
- List.fold_left (fun accu ((n,_),_) ->
- N.Set.add (N.of_string n) accu
- ) accu l
- ) N.Set.empty (deps @ depopts)
+ Formula.fold_left (fun accu (n,_) ->
+ N.Set.add n accu
+ ) N.Set.empty (Formula.And (deps, depopts))
) else
N.Set.empty in
V.Set.fold (fun v set ->
View
2 src/scripts/opam_repo_check.ml
@@ -6,7 +6,7 @@ open OpamFile
let () =
let usage = Printf.sprintf "Usage: %s" Sys.argv.(0) in
let specs = [
- ("--version", Arg.Unit Globals.version, " Display version information")
+ ("--version", Arg.Unit Globals.version_msg, " Display version information")
] in
let ano x =
Printf.eprintf "%s: invalid argument" x in
View
83 src/solver.ml
@@ -91,26 +91,16 @@ module PA_graph = struct
end
type request = {
- wish_install: and_formula;
- wish_remove : and_formula;
- wish_upgrade: and_formula;
+ wish_install: Formula.conjunction;
+ wish_remove : Formula.conjunction;
+ wish_upgrade: Formula.conjunction;
}
-let string_of_vpkg =
- string_of_atom_formula
-
-let string_of_list f l =
- Printf.sprintf "{%s}"
- (String.concat ", " (List.map f l))
-
-let string_of_vpkgs =
- string_of_list string_of_vpkg
-
let string_of_request r =
Printf.sprintf "install:%s remove:%s upgrade:%s"
- (string_of_vpkgs r.wish_install)
- (string_of_vpkgs r.wish_remove)
- (string_of_vpkgs r.wish_upgrade)
+ (Formula.string_of_conjunction r.wish_install)
+ (Formula.string_of_conjunction r.wish_remove)
+ (Formula.string_of_conjunction r.wish_upgrade)
type solution = {
to_remove: NV.t list; (* order : first element needs to be removed before the others *)
@@ -162,9 +152,9 @@ type 'a internal_request = {
let string_of_internal_request f r =
Printf.sprintf "install:%s remove:%s upgrade:%s"
- (string_of_list f r.i_wish_install)
- (string_of_list f r.i_wish_remove)
- (string_of_list f r.i_wish_upgrade)
+ (Utils.string_of_list f r.i_wish_install)
+ (Utils.string_of_list f r.i_wish_remove)
+ (Utils.string_of_list f r.i_wish_upgrade)
let request_map f r =
let f = List.map f in
@@ -184,7 +174,7 @@ let string_of_package p =
p.Debian.Packages.name p.Debian.Packages.version installed
let string_of_packages l =
- string_of_list string_of_package l
+ Utils.string_of_list string_of_package l
let string_of_cudf (p, c) =
let relop = function
@@ -199,8 +189,11 @@ let string_of_cudf (p, c) =
| Some (r,v) -> Printf.sprintf " (%s %d)" (relop r) v in
Printf.sprintf "%s%s" p (const c)
+let string_of_internal_request =
+ string_of_internal_request string_of_cudf
+
let string_of_cudfs l =
- string_of_list string_of_cudf l
+ Utils.string_of_list string_of_cudf l
(* Universe of packages *)
type universe = U of package list
@@ -215,10 +208,10 @@ let string_of_cudf_package p =
p.Cudf.version installed
let string_of_cudf_packages l =
- string_of_list string_of_cudf_package l
+ Utils.string_of_list string_of_cudf_package l
let string_of_answer l =
- string_of_list (string_of_internal_action string_of_cudf_package) l
+ Utils.string_of_list (string_of_internal_action string_of_cudf_package) l
let string_of_universe u =
string_of_cudf_packages (Cudf.get_packages u)
@@ -277,6 +270,21 @@ let string_of_reasons table reasons =
) chains;
Buffer.contents b
+let depopts pkg =
+ let opt = OpamFile.OPAM.s_depopts in
+ if List.mem_assoc opt pkg.Cudf.pkg_extra then
+ match List.assoc opt pkg.Cudf.pkg_extra with
+ | `String s ->
+ let value = Parser.value Lexer.token (Lexing.from_string s) in
+ Some (File_format.parse_formula value)
+ | _ -> assert false
+ else
+ None
+
+let encode ((n,a),c) = (Common.CudfAdd.encode n,a),c
+let lencode = List.map encode
+let llencode = List.map lencode
+
module O_pkg = struct
type t = Cudf.package
let to_string = string_of_cudf_package
@@ -380,17 +388,12 @@ module Graph = struct
file.ml when we create the debian package. It could make sense
to do it here. *)
let extended_dependencies table pkg =
- let opt = OpamFile.OPAM.s_depopts in
- if List.mem_assoc opt pkg.Cudf.pkg_extra then
- match List.assoc opt pkg.Cudf.pkg_extra with
- | `String s ->
- let deps = File_format.parse_cnf_formula
- (Parser.value Lexer.token (Lexing.from_string s)) in
- let deps = Debian.Debcudf.lltocudf table deps in
- { pkg with Cudf.depends = deps @ pkg.Cudf.depends }
- | _ -> assert false
- else
- pkg
+ match depopts pkg with
+ | Some deps ->
+ let cnf = Formula.to_cnf deps in
+ let deps = Debian.Debcudf.lltocudf table (llencode cnf) in
+ { pkg with Cudf.depends = deps @ pkg.Cudf.depends }
+ | None -> pkg
let filter_dependencies f_direction ?(depopts=false) (U l_pkg_pb) (P pkg_l) =
let pkg_map =
@@ -438,7 +441,7 @@ end = struct
include Common.CudfAdd.Cudf_set
let to_string s =
- string_of_list string_of_cudf_package (elements s)
+ Utils.string_of_list string_of_cudf_package (elements s)
let choose_one s =
match elements s with
@@ -459,9 +462,8 @@ end = struct
(* Return the state in which the system has to go *)
let resolve_final_state univ req =
- log "FINAL_STATE: universe=%s request=<%s>"
- (string_of_universe univ)
- (string_of_internal_request string_of_cudf req);
+ log "RESOLVE(final-state): universe=%s" (string_of_universe univ);
+ log "RESOLVE(final-state): request=%s" (string_of_internal_request req);
let r = Algo.Depsolver.check_request (to_cudf_doc univ req) in
(* Diagnostic.fprintf ~explain:true ~failure:true ~success:true Format.err_formatter r;
Format.pp_print_flush Format.err_formatter (); *)
@@ -491,7 +493,7 @@ end = struct
| Diagnostic.Failure e -> Conflicts e
| Diagnostic.Success f ->
let final_state = f ~all:true () in
- log "FINAL_STATE: state=%s" (string_of_cudf_packages final_state);
+ log "RESOLVE(simple): final-state=%s" (string_of_cudf_packages final_state);
try
let diff = Common.CudfDiff.diff univ (Cudf.load_universe final_state) in
Success (actions_of_diff diff)
@@ -561,6 +563,9 @@ end = struct
(* Minimize the installed packages from the request *)
let installed = Cudf.get_packages ~filter:(fun p -> p.Cudf.installed) univ in
+ let installed =
+ List.filter (fun p -> not (List.exists (fun (n,_) -> n=p.Cudf.package) req.i_wish_remove)) installed in
+
let is_installed name =
List.exists (fun p -> p.Cudf.package = name) installed in
let minimize request =
View
6 src/solver.mli
@@ -54,9 +54,9 @@ end
(** Solver request *)
type request = {
- wish_install: and_formula;
- wish_remove : and_formula;
- wish_upgrade: and_formula;
+ wish_install: Formula.conjunction;
+ wish_remove : Formula.conjunction;
+ wish_upgrade: Formula.conjunction;
}
(** Convert a request to a string *)
View
128 src/types.ml
@@ -634,6 +634,8 @@ end = struct
end
+type ocaml_constraint = relop * OCaml_V.t
+
module Alias: ABSTRACT = Base
(* OPAM version *)
@@ -972,14 +974,126 @@ let string_of_config = function
Printf.sprintf "include(%b,%s)"
b (String.concat "," (List.map N.to_string l))
-type atom_formula = Debian.Format822.vpkg
-type and_formula = atom_formula list
-type cnf_formula = Debian.Format822.vpkgformula
-type ocaml_constraint = relop * OCaml_V.t
+module Formula = struct
+
+ type conjunction = Debian.Format822.vpkglist
+
+ type cnf = Debian.Format822.vpkgformula
+
+ let string_of_vpkg = function
+ | ((n,_), None) -> n
+ | ((n,_), Some (r,c)) -> Printf.sprintf "%s (%s %s)" n r c
+
+ let string_of_conjunction c =
+ Printf.sprintf "(%s)" (String.concat " & " (List.map string_of_vpkg c))
+
+ let string_of_cnf cnf =
+ let string_of_clause c =
+ Printf.sprintf "(%s)" (String.concat " | " (List.map string_of_vpkg c)) in
+ Printf.sprintf "(%s)" (String.concat " & " (List.map string_of_clause cnf))
-let string_of_atom_formula = function
- | ((n,_), None) -> n
- | ((n,_), Some (r,c)) -> Printf.sprintf "%s (%s %s)" n r c
+ type 'a formula =
+ | Empty
+ | Atom of 'a
+ | Block of 'a formula
+ | And of 'a formula * 'a formula
+ | Or of 'a formula * 'a formula
+
+ let string_of_formula string_of_a f =
+ let rec aux = function
+ | Empty -> ""
+ | Atom a -> string_of_a a
+ | Block x -> Printf.sprintf "(%s)" (aux x)
+ | And(x,y) -> Printf.sprintf "%s & %s" (aux x) (aux y)
+ | Or(x,y) -> Printf.sprintf "%s | %s" (aux x) (aux y) in
+ aux f
+
+ let rec map f = function
+ | Empty -> Empty
+ | Atom x -> Atom (f x)
+ | Block x -> Block (map f x)
+ | And(x,y) -> And (map f x, map f y)
+ | Or(x,y) -> Or (map f x, map f y)
+
+ let rec iter f = function
+ | Empty -> ()
+ | Atom x -> f x
+ | Block x -> iter f x
+ | And(x,y) -> iter f x; iter f y
+ | Or(x,y) -> iter f x; iter f y
+
+ let rec fold_left f i = function
+ | Empty -> i
+ | Atom x -> f i x
+ | Block x -> fold_left f i x
+ | And(x,y) -> fold_left f (fold_left f i x) y
+ | Or(x,y) -> fold_left f (fold_left f i x) y
+
+ type t = (name * (string * version) formula) formula
+
+ let to_string t =
+ let string_of_constraint (relop, version) =
+ Printf.sprintf "%s %s" relop (V.to_string version) in
+ let string_of_pkg = function
+ | n, Empty -> N.to_string n
+ | n, c -> Printf.sprintf "%s %s" (N.to_string n) (string_of_formula string_of_constraint c) in
+ string_of_formula string_of_pkg t
+
+ (* unroll to a CNF formula *)
+ let rec unroll f t =
+ let rec mk_left x y = match y with
+ | Block y -> mk_left x y
+ | And (a,b) -> And (mk_left x a, mk_left x b)
+ | _ -> Or (x,y) in
+ let rec mk_right x y = match x with
+ | Block x -> mk_right x y
+ | And (a,b) -> And (mk_right a y, mk_right b y)
+ | _ -> mk_left x y in
+ let rec mk = function
+ | Empty -> Empty
+ | Block x -> mk x
+ | Atom x -> f x
+ | And (x,y) -> And (mk x, mk y)
+ | Or (x,y) -> mk_right (mk x) (mk y) in
+ mk t
+
+ let unroll t =
+ let atom (r,v) = Atom (r, v) in
+ let vpkg (x, c) =
+ match unroll atom c with
+ | Empty -> Atom (x, None)
+ | cs -> map (fun c -> x, Some c) cs in
+ unroll vpkg t
+
+ let atoms t =
+ fold_left (fun accu x -> x::accu) [] (unroll t)
+
+ (* Convert to dose-CNF *)
+ let to_cnf t =
+ let rec or_formula = function
+ | Atom (x,None) -> [(N.to_string x, None), None]
+ | Atom (x,Some(r,v)) -> [(N.to_string x, None), Some(r, V.to_string v)]
+ | Or(x,y) -> or_formula x @ or_formula y
+ | Empty
+ | Block _
+ | And _ -> assert false in
+ let rec aux t = match t with
+ | Empty -> []
+ | Block x -> assert false
+ | Atom _
+ | Or _ -> [or_formula t]
+ | And(x,y) -> aux x @ aux y in
+ aux (unroll t)
+
+ let to_conjunction t =
+ let rec aux = function
+ | [] -> []
+ | [x]::t -> x::aux t
+ | _ ->
+ Globals.error_and_exit "%s is not a valid conjunction" (to_string t) in
+ aux (to_cnf t)
+
+end
module Remote_file: sig
include ABSTRACT
View
60 src/types.mli
@@ -364,6 +364,8 @@ module OCaml_V: sig
val compare: t -> relop -> t -> bool
end
+type ocaml_constraint = relop * OCaml_V.t
+
(** OPAM version *)
module OPAM_V: ABSTRACT
@@ -555,14 +557,60 @@ val string_of_config: config -> string
(** Compiler aliases *)
module Alias: ABSTRACT
-type atom_formula = Debian.Format822.vpkg
-type and_formula = atom_formula list
+module Formula: sig
-(** Pretty-print *)
-val string_of_atom_formula : atom_formula -> string
+ (** AND formulas *)
+ type conjunction = Debian.Format822.vpkglist
-type cnf_formula = Debian.Format822.vpkgformula
-type ocaml_constraint = relop * OCaml_V.t
+ (** Pretty print AND formulas *)
+ val string_of_conjunction: conjunction -> string
+
+ (** CNF formulas *)
+ type cnf = Debian.Format822.vpkgformula
+
+ (** Pretty print CNF formulas *)
+ val string_of_cnf: cnf -> string
+
+ (** General formulas *)
+ type 'a formula =
+ | Empty
+ | Atom of 'a
+ | Block of 'a formula
+ | And of 'a formula * 'a formula
+ | Or of 'a formula * 'a formula
+
+ (** Pretty print a formula *)
+ val string_of_formula: ('a -> string) -> 'a formula -> string
+
+ (** Map function *)
+ val map: ('a -> 'b) -> 'a formula -> 'b formula
+
+ (** Iter function *)
+ val iter: ('a -> unit) -> 'a formula -> unit
+
+ (** Fold function *)
+ val fold_left: ('a -> 'b -> 'a) -> 'a -> 'b formula -> 'a
+
+ (** An atom is: [name] * ([relop] * [version]) formula.
+ Examples of valid formulaes:
+ - "foo" {> "1" & (<"3" | ="5")}
+ - "foo" {= "1" | > "4"} | ("bar" "bouh") *)
+ type t = (name * (string * version) formula) formula
+
+ (** Return all the atoms *)
+ val atoms: t -> (name * (string * version) option) list
+
+ (** Pretty print the formula *)
+ val to_string: t -> string
+
+ (** Return a conjunction. If the initial formula is not a
+ conjunction, fail. *)
+ val to_conjunction: t -> conjunction
+
+ (** Return an equivalent CNF formula *)
+ val to_cnf: t -> cnf
+
+end
module Remote_file: sig
include ABSTRACT
View
6 src/utils.ml
@@ -40,6 +40,10 @@ module StringMap = Map.Make(OString)
let (|>) f g x = g (f x)
+let string_of_list f l =
+ Printf.sprintf "{%s}"
+ (String.concat ", " (List.map f l))
+
let string_strip str =
let p = ref 0 in
let l = String.length str in
@@ -94,7 +98,7 @@ let contains s c =
with Not_found -> false
let split s c =
- Pcre.split (Pcre.regexp (String.make 1 c)) s
+ Pcre.split (Re_perl.compile (Re.char c)) s
(* Remove from a ':' separated list of string the one with the given prefix *)
let reset_env_value ~prefix v =
View
3 tests/Makefile
@@ -197,8 +197,9 @@ downgrade:
switch-alias:
$(OPAM) remove P3.1~weird-version.test P4.2
$(CHECK) -l switch-alias P1.1 P2.1
+ $(OPAM) switch -export $(OPAM_ROOT)/export
$(OPAM) switch -install test -alias-of system -no-base-packages
- $(OPAM) switch -clone system
+ $(OPAM) switch -import $(OPAM_ROOT)/export
$(CHECK) -l switch-alias-clone P1.1 P2.1
$(OPAM) switch -install test2 -alias-of 20
$(OPAM) install P1

0 comments on commit 5af52d0

Please sign in to comment.