Skip to content
Browse files

Towards a support for multiple version of OCaml

Currently the parsing/marshalling of .compil files is supported, but not the logics of downloading/configuring/compiling OCaml (should come soon)
  • Loading branch information...
1 parent 9456ac7 commit 8b1026136eeee096e16da5d52eb9f89eada3bb93 @samoht samoht committed Mar 28, 2012
Showing with 143 additions and 20 deletions.
  1. +23 −0 src/client.ml
  2. +84 −12 src/file.ml
  3. +5 −0 src/globals.ml
  4. +1 −1 src/namespace.ml
  5. +13 −1 src/ocp_get.ml
  6. +17 −6 src/path.ml
View
23 src/client.ml
@@ -65,6 +65,9 @@ sig
(** Manage remote indexes *)
val remote : remote_action -> unit
+
+ (** Switch to an other version of ocaml *)
+ val switch : string -> unit
end
module Client : CLIENT = struct
@@ -786,4 +789,24 @@ module Client : CLIENT = struct
let filter t = (string_of_url t <> s) && (t.hostname <> s) in
update_config (List.filter filter t.servers)
+ let switch name =
+ log "switch %s" name;
+ let t = load_state () in
+ let compile compil =
+ failwith "TODO" in
+ if Filename.check_suffix name ".compil" then begin
+ (* we switch to a fresh OCaml install *)
+ let compil = File.Compil.parse (Run.read name) in
+ let name = File.Compil.name compil in
+ let compil_f = Path.compil t.home name in
+ if Path.file_exists compil_f then
+ Globals.error_and_exit "Compiler spec %s already exists" name;
+ File.Compil.add compil_f compil;
+ compile compil
+ end else begin
+ let compil_f = Path.compil t.home name in
+ let compil = File.Compil.find compil_f in
+ compile compil
+ end
+
end
View
96 src/file.ml
@@ -65,6 +65,13 @@ struct
let colon = split ":"
let space = split " "
+ let split_comma str =
+ if str = "" then
+ []
+ else
+ try List.map String.strip (String.nsplit str ",")
+ with _ -> [str]
+
let assoc f k0 =
let rec aux = function
| x :: xs ->
@@ -198,9 +205,7 @@ struct
!Globals.root_path in
let sources =
Parse.assoc_parsed "sources" file in
- let sources =
- try List.map String.strip (String.nsplit sources ",")
- with _ -> [sources] in
+ let sources = Parse.split_comma sources in
let one source =
let uri, hostname = uri_of_url source in
url ?uri hostname in
@@ -628,8 +633,74 @@ struct
let empty = Random ""
end
-end
+ module type COMPIL = sig
+ include IO_FILE
+
+ val name: t -> string
+ val source: t -> url
+ val configure: t -> string list
+ val make: t -> string list
+ val patches: t -> url list
+
+ end
+
+ module Compil : COMPIL = struct
+
+ let internal_name = "compiler"
+
+ type t = {
+ name: string;
+ source: url;
+ patches: url list;
+ configure: string list;
+ make: string list;
+ }
+
+ let empty = {
+ name = "<none>";
+ source = url "<none>";
+ patches = [];
+ configure = [];
+ make = [];
+ }
+ let name t = t.name
+ let source t = t.source
+ let patches t = t.patches
+ let configure t = t.configure
+ let make t = t.make
+
+ let to_string t =
+ Printf.sprintf "\
+name: %s
+source: %s
+patches: %s
+configure: %s
+make: %s
+"
+ t.name
+ (string_of_url t.source)
+ (String.concat ", " (List.map string_of_url t.patches))
+ (String.concat ", " t.configure)
+ (String.concat ", " t.make)
+
+ let parse contents =
+ let file = Parse.colon contents in
+ let name = Parse.assoc_parsed "name" file in
+ let source = url (Parse.assoc_parsed "source" file) in
+ let patches = match Parse.Exceptionless.assoc_parsed "patches" file with
+ | None -> []
+ | Some s -> List.map url (Parse.split_comma s) in
+ let configure = match Parse.Exceptionless.assoc_parsed "configure" file with
+ | None -> []
+ | Some s -> Parse.split_comma s in
+ let make = match Parse.Exceptionless.assoc_parsed "make" file with
+ | None -> []
+ | Some s -> Parse.split_comma s in
+ { name; source; patches; configure; make }
+
+ end
+end
exception Directory_found
@@ -647,22 +718,22 @@ struct
let find f =
log "find %s" (Path.string_of_filename f);
match Path.find_binary f with
- | Path.File (Raw_binary s) -> Some (F.parse s)
- | Path.Not_found _ -> None
- | Path.Directory _ -> raise Directory_found
+ | Path.File (Raw_binary s) -> Some (F.parse s)
+ | Path.Not_found _ -> None
+ | Path.Directory _ -> raise Directory_found
(** Find a file. Exit the program if the file does not exists.
Raise [Parsing] or [Directory] in case another error happen. *)
let find_err = Path.read find
module Exceptionless =
struct
- (** Find a file. Return a default value [v0] if the file does not exists.
- In general, forall [v1], [compare v0 v1] < 0. *)
+ (** Find a file. Return a default value [v0] if the file does not exists.
+ In general, forall [v1], [compare v0 v1] < 0. *)
let default def f =
match try Some (find f) with _ -> None with
- | Some (Some t) -> t
- | _ -> def
+ | Some (Some t) -> t
+ | _ -> def
let find = default F.empty
end
@@ -678,6 +749,7 @@ struct
module To_install = struct include To_install include Make (To_install) end
module PConfig = struct include PConfig include Make (PConfig) end
module Security_key = struct include Security_key include Make (Security_key) end
+ module Compil = struct include Compil include Make (Compil) end
module Installed =
struct
@@ -687,7 +759,7 @@ struct
let modify_def f f_map =
M_installed.add f (N_map.bindings (f_map (find_map f)))
-
+
include Installed
include M_installed
end
View
5 src/globals.ml
@@ -40,6 +40,11 @@ let error fmt =
Printf.eprintf "ERROR: %s\n%!" str
) fmt
+let warning fmt =
+ Printf.kprintf (fun str ->
+ Printf.eprintf "WARNING: %s\n%!" str
+ ) fmt
+
let error_and_exit fmt =
Printf.kprintf (fun str ->
error "%s" str;
View
2 src/namespace.ml
@@ -71,7 +71,7 @@ struct
Name d.Debian.Packages.name, Deb d.Debian.Packages.version
let to_string (Name n, v) =
- Printf.sprintf "%s %s" n (string_of_version v)
+ Printf.sprintf "%s-%s" n (string_of_version v)
end
module N_map = BatMap.Make (struct open Namespace type t = name let compare = name_compare end)
View
14 src/ocp_get.ml
@@ -208,6 +208,18 @@ let remote = {
| _ -> bad_argument ())
}
+let switch = {
+ name = "switch";
+ usage = "[compiler-name]";
+ synopsis = "Switch to an other compiler version";
+ help = "";
+ specs = [];
+ anon;
+ main = parse_args (function
+ | [name] -> Client.switch name
+ | _ -> bad_argument ())
+}
+
let commands = [
init;
list;
@@ -219,11 +231,11 @@ let commands = [
upload;
remove;
remote;
+ switch;
]
let () =
Globals.log "CLIENT" "Root path is %s" !Globals.root_path;
List.iter SubCommand.register commands;
ArgExt.parse global_args
-
View
23 src/path.ml
@@ -41,9 +41,8 @@ let url ?uri ?port hostname =
| Some uri -> Some uri, hostname in
let port = match port, port2, uri with
| Some p, _ , _
- | None , Some p, _ -> Some p
- | None, _ , None -> Some Globals.default_port
- | _ -> None in
+ | None , Some p, _ -> Some p
+ | _ -> None in
{ uri; hostname; port }
let string_of_url url =
@@ -153,6 +152,9 @@ sig
val index : t -> name_version option -> filename (* $HOME_OPAM/index/NAME-VERSION.spec *)
(* [None] : $HOME_OPAM/index *)
+ val compil : t -> string -> filename
+ (* $HOME_OPAM/compilers/[oversion].compil *)
+
(** list of spec files *)
val index_list : t -> name_version list (* [ $HOME_OPAM/index/NAME-VERSION.spec ] -> [ NAME, VERSION ] *)
@@ -296,6 +298,9 @@ module Path : PATH = struct
| Some (n, v) -> mk_name_version t_home name ext n v
let index t = mk_name_version_o t.home "index" ".spec"
+
+ let compil t c = Raw (t.home // "compilers" // c ^ ".compil")
+
let archives_targz t = mk_name_version_o t.home "archives" ".tar.gz"
let build t = mk_name_version_o t.home_ocamlversion "build" ""
@@ -352,12 +357,18 @@ module Path : PATH = struct
else
None
+ let check_suffix f suff =
+ Filename.check_suffix (s_of_filename f) suff
+
let index_list t =
let index_path = index t None in
- let is_file f = is_directory (concat index_path f) = None in
+ let is_spec f =
+ let file = concat index_path f in
+ is_directory file = None
+ && check_suffix file ".spec" in
let files =
match find index_path with
- | Directory l -> List.filter is_file l
+ | Directory l -> List.filter is_spec l
| File _
| Not_found _ -> [] in
List.map (nv_of_extension Namespace.default_version) files
@@ -495,7 +506,7 @@ module Path : PATH = struct
R_lazy (fun () ->
let rec download = function
- | [] -> Globals.error_and_exit "No archive found"
+ | [] -> Globals.warning "%s contains no archive" (Namespace.to_string nv)
| Internal f :: urls -> download_aux f urls
| External (uri, url) :: urls ->
match Run.download (uri, url) nv with

0 comments on commit 8b10261

Please sign in to comment.
Something went wrong with that request. Please try again.