#! /bin/sh
# (*
exec ocaml "$0" "$@"
*) directory ".";;
(* $Id: ocamlfind-mini 49 2003-12-30 09:48:02Z gerd $
* ----------------------------------------------------------------------
*
*)
(**********************************************************************)
(* Module split, rev. 1.2 *)
module Split = struct
let in_words s =
(* splits s in words separated by commas and/or whitespace *)
let l = String.length s in
let rec split i j =
if j < l then
match s.[j] with
(' '|'\t'|'\n'|'\r'|',') ->
if i<j then (String.sub s i (j-i)) :: (split (j+1) (j+1))
else split (j+1) (j+1)
| _ ->
split i (j+1)
else
if i<j then [ String.sub s i (j-i) ] else []
in
split 0 0
;;
let in_words_ws s =
(* splits s in words separated by whitespace *)
let l = String.length s in
let rec split i j =
if j < l then
match s.[j] with
(' '|'\t'|'\n'|'\r') ->
if i<j then (String.sub s i (j-i)) :: (split (j+1) (j+1))
else split (j+1) (j+1)
| _ ->
split i (j+1)
else
if i<j then [ String.sub s i (j-i) ] else []
in
split 0 0
;;
let path_separator =
match Sys.os_type with
"Unix" -> ':'
| "Cygwin" -> ';' (* You might want to change this *)
| "Win32" -> ';'
| "MacOS" -> failwith "Findlib: I do not know what is the correct path separator for MacOS. If you can help me, write a mail to gerd@gerd-stolpmann.de"
| _ -> failwith "Findlib: unknown operating system"
;;
let path str =
(* split "str" into parts separated by "path_separator" *)
let l = String.length str in
let rec split_up j k =
if k < l then begin
let c = str.[k] in
if c = path_separator then begin
if k - j > 0 then
String.sub str j (k-j) :: split_up (k+1) (k+1)
else
split_up (k+1) (k+1)
end
else
split_up j (k+1)
end
else
if k - j > 0 then
[ String.sub str j (k-j) ]
else
[]
in
split_up 0 0
;;
end;;
(**********************************************************************)
exception Usage;;
type mode =
M_use | M_query | M_install | M_remove | M_compiler of string
| M_printconf | M_guess | M_list
;;
let rec remove_dups l =
match l with
x :: l' ->
if List.mem x l' then remove_dups l' else x::remove_dups l'
| [] -> []
;;
let arg n =
if n < Array.length Sys.argv then Sys.argv.(n) else raise Not_found
;;
(**********************************************************************)
let ocaml_stdlib_default = "/usr/local/lib/ocaml";;
let ocaml_stdlib =
begin
(* Execute "ocamlc -v" and read the stdlib directory *)
let filename = Filename.temp_file "ocamlfind." ".dat" in
let command = "ocamlc -v >" ^ filename in (* SYS *)
let n = Sys.command command in
if n <> 0 then begin
prerr_endline ("ocamlfind-mini: [WARNING] Cannot determine directory of stdlib; using " ^ ocaml_stdlib_default ^ " by default");
ocaml_stdlib_default
end
else begin
(* Search the line "Standard library directory: " *)
let tag = "Standard library directory: " in
let taglen = String.length tag in
let f = open_in filename in
let dir = ref ocaml_stdlib_default in
try
while true do
let s = input_line f in
if String.length s >= taglen && String.sub s 0 taglen = tag then begin
dir := String.sub s taglen (String.length s - taglen);
raise Exit;
end
done;
assert false
with
Exit ->
close_in f;
(try Sys.remove filename with _ -> ());
!dir
| End_of_file ->
close_in f;
prerr_endline ("ocamlfind-mini: [WARNING] Cannot determine directory of stdlib; using " ^ ocaml_stdlib_default ^ " by default");
ocaml_stdlib_default
end
end
;;
let ocamlpath =
try
Split.path (Sys.getenv "OCAMLPATH")
with
Not_found ->
(* Use stdlib as default: *)
[ ocaml_stdlib ]
;;
let env_destdir =
try Sys.getenv "OCAMLFIND_DESTDIR" with Not_found -> "";;
let env_metadir =
try Sys.getenv "OCAMLFIND_METADIR" with Not_found -> "";;
let core_packages =
[ "bigarray", ocaml_stdlib;
"dbm", ocaml_stdlib;
"dynlink", ocaml_stdlib;
"graphics", ocaml_stdlib;
"labltk", (Filename.concat ocaml_stdlib "labltk");
"num", ocaml_stdlib;
"stdlib", ocaml_stdlib;
"str", ocaml_stdlib;
"threads", (Filename.concat ocaml_stdlib "threads");
"unix", ocaml_stdlib;
]
;;
(**********************************************************************)
let package_directory pkg =
let rec lookup path =
match path with
| [] -> raise Not_found
| dir :: path' ->
let pkgdir = Filename.concat dir pkg in
let meta = Filename.concat pkgdir "META" in
if Sys.file_exists meta then
pkgdir
else
lookup path'
in
try
List.assoc pkg core_packages
with
Not_found ->
lookup ocamlpath
;;
(**********************************************************************)
let use_package prefix pkgnames =
let pdirs =
List.map
(fun pname ->
try
"-I " ^ package_directory pname
with
Not_found -> failwith ("Cannot find package " ^ pname ^ " (check environment variable OCAMLPATH)"))
pkgnames
in
print_endline (prefix ^ String.concat " " pdirs)
;;
(**************** OCAMLC/OCAMLMKTOP/OCAMLOPT subcommands ****************)
type pass_file_t =
Pass of string
| Impl of string
| Intf of string
;;
let ocamlc which () =
Arg.current := 1;
let switches = ref [] in
let pass_options = ref [] in
let pass_files = ref [] in
let incpath = ref [] in
let packages = ref [] in
let add_switch name =
Arg.Unit (fun () ->
switches := name :: !switches;
pass_options := !pass_options @ [name]) in
let add_spec_fn name s =
pass_options := !pass_options @ [name; s] in
let add_spec name = Arg.String (add_spec_fn name) in
let add_pkg =
Arg.String (fun s -> packages := !packages @ (Split.in_words s)) in
Arg.parse
(List.flatten
[ [
"-package", add_pkg,
" <name> Refer to package when compiling";
"-linkpkg", Arg.Unit(fun _ -> raise (Arg.Bad "Not supported: -linkpkg")),
" Link the packages in (NOT SUPPORTED)";
"-predicates", Arg.String(fun _ -> raise (Arg.Bad "Not supported: -predicates")),
" <p> Add predicate <p> when resolving package properties (NOT SUPPORTED)";
"-dontlink", Arg.String(fun _ -> raise (Arg.Bad "Not supported: -dontlink")),
" <name> Do not link in package <name> and its ancestors (NOT SUPPORTED)";
"-syntax", Arg.String(fun _ -> raise (Arg.Bad "Not supported: -syntax")),
" <p> Use preprocessor with predicate <p> (NOT SUPPORTED)";
"-ppopt", Arg.String(fun _ -> raise (Arg.Bad "Not supported: -ppopt")),
" <opt> Append option <opt> to preprocessor invocation (NOT SUPPORTED)";
"-passopt", Arg.String (fun s -> pass_options := !pass_options @ [s]),
" <opt> Pass option <opt> directly to ocamlc/opt/mktop\nSTANDARD OPTIONS:";
"-a", add_switch "-a",
" Build a library";
"-c", add_switch "-c",
" Compile only (do not link)";
"-cc", add_spec "-cc",
" <comp> Use <comp> as the C compiler and linker";
"-cclib", add_spec "-cclib",
" <opt> Pass option <opt> to the C linker";
"-ccopt", add_spec "-ccopt",
" <opt> Pass option <opt> to the C compiler and linker";
];
if which = "ocamlopt" then [
"-compact", add_switch "-compact",
" Optimize code size rather than speed"
]
else [];
if which <> "ocamlopt" then [
"-custom", add_switch "-custom",
" Link in custom mode";
"-g", add_switch "-g",
" Save debugging information";
] else [];
[
"-i", add_switch "-i",
" Print the types";
"-I", (Arg.String
(fun s ->
incpath := s :: !incpath;
add_spec_fn "-I" s)),
" <dir> Add <dir> to the list of include directories";
"-impl", Arg.String (fun s -> pass_files := !pass_files @ [ Impl s ]),
" <file> Compile <file> as a .ml file";
] ;
if which = "ocamlopt" then [
"-inline", add_spec "-inline",
" <n> Set aggressiveness of inlining to <n>";
] else [];
[
"-intf", Arg.String (fun s -> pass_files := !pass_files @ [ Intf s ]),
" <file> Compile <file> as a .mli file";
"-intf-suffix", add_spec "-intf-suffix",
" <s> Suffix for interface file (default: .mli)";
"-intf_suffix", add_spec "-intf_suffix",
" <s> same as -intf-suffix";
"-labels", add_switch "-labels",
" Use commuting label mode";
"-linkall", add_switch "-linkall",
" Link all modules, even unused ones";
] ;
if which <> "ocamlopt" then [
"-make-runtime", add_switch "-make-runtime",
" Build a runtime system";
"-make_runtime", add_switch "-make_runtime",
" same as -make-runtime";
] else [];
[
"-noautolink", add_switch "-noautolink",
" Don't automatically link C libraries specif'd in .cma files";
"-noassert", add_switch "-noassert",
" Do not compile assertion checks";
"-o", add_spec "-o",
" <file> Set output file name to <file>";
"-output-obj", add_switch "-output-obj",
" Output a C object file instead of an executable";
];
if which = "ocamlopt" then [
"-p", add_switch "-p",
" Compile/link with profiling support for \"gprof\"
(implies -predicates gprof)";
] else if which = "ocamlcp" then [
"-p", add_spec "-p",
" [afilmt] Profile constructs specified by argument:
a Everything
f Function calls
i if ... then ... else
l while, for
m match ... with
t try ... with";
] else [];
[
"-pp", Arg.String (fun s -> add_spec_fn "-pp" s),
" <command> Pipe sources through preprocessor <command>";
"-rectypes", add_switch "-rectypes",
" Allow arbitrary recursive types";
] ;
if which = "ocamlopt" then [
"-S", add_switch "-S",
" Keep intermediate assembly file";
] else [];
[
"-thread", add_switch "-thread",
" Use thread-safe standard library (implies -predicate mt)";
"-unsafe", add_switch "-unsafe",
" No bounds checking on array and string access";
] ;
if which <> "ocamlopt" then [
"-use-runtime", add_spec "-use-runtime",
" <path> Generate bytecode for the given runtime system";
"-use_runtime", add_spec "-use_runtime",
" same as -use-runtime";
] else [];
[
"-v", add_switch "-v",
" Print compiler version number";
"-verbose", add_switch "-verbose",
" Print calls to external commands";
"-w", add_spec "-w",
" <flags> Enable or disable warnings according to <flags>:
A/a enable/disable all warnings
C/c enable/disable suspicious comment
F/f enable/disable partially applied function
M/m enable/disable overriden methods
P/p enable/disable partial match
S/s enable/disable non-unit statement
U/u enable/disable unused match case
V/v enable/disable hidden instance variables
X/x enable/disable all other warnings
default setting is A (all warnings enabled)";
"-warn-error", add_spec "-warn-error",
" Turn these warnings into errors";
"-where", add_switch "-where",
" Print standard library directory";
"-", Arg.String (fun s -> pass_files := !pass_files @ [ Pass s ]),
" <file> Treat <file> as a file name (even if it starts with `-')";
]
])
(fun s -> pass_files := !pass_files @ [ Pass s])
("usage: ocamlfind-mini " ^ which ^ " [options] file ...");
begin match which with
"ocamlc"
| "ocamlcp"
| "ocamlmktop"
| "ocamlopt" -> ()
| _ -> failwith "unsupported backend"
end;
let verbose = List.mem "-verbose" !switches in
(* check packages: *)
List.iter
(fun pkg ->
try
let _ = package_directory pkg in
()
with
Not_found ->
failwith ("package '" ^ pkg ^ "' not found (check environment variable OCAMLPATH)"))
!packages;
let eff_packages = !packages in
let eff_packages_dl =
remove_dups (List.map package_directory eff_packages) in
let stdlibdir =
(* normalized form of the stdlib directory *)
let d = ocaml_stdlib in
if d <> "" & d.[String.length d - 1] = '/' then
String.sub d 0 (String.length d - 1)
else
d
in
let stdlibdirslash = stdlibdir ^ "/" in
let i_options =
List.flatten
(List.map
(fun pkgdir ->
if pkgdir = stdlibdir or pkgdir = stdlibdirslash then
[]
else
[ "-I"; pkgdir;
"-ccopt"; "-I" ^ pkgdir; ])
eff_packages_dl) in
let pass_files' =
List.flatten
(List.map
(function
Pass s ->
if s.[0] = '-'
then [ "-"; String.sub s 1 (String.length s - 1) ]
else [ s ]
| Impl s ->
[ "-impl"; s ]
| Intf s ->
[ "-intf"; s ]
)
!pass_files)
in
let arguments =
!pass_options @
i_options @
pass_files'
in
let actual_command = which in
if verbose then
print_string ("+ " ^ actual_command ^ " " ^
String.concat " " arguments ^ "\n");
flush stdout;
let argstring =
String.concat " "
(List.map Filename.quote arguments)
in
let status = Sys.command (actual_command ^ " " ^ argstring) in
begin
match status with
0 -> ()
| n ->
if verbose then
print_string (actual_command ^ " returned with exit code " ^ string_of_int n ^ "\n");
exit n
end;
;;
(************************************************************************)
let make_directory dirname =
(* Invoke the mkdir command *)
let cmd =
match Sys.os_type with
"Unix" -> "mkdir"
| "Cygwin" -> "mkdir" (* don't really know *)
| "Win32" -> "md"
| "MacOS" -> failwith "make_directory not implemented for MacOS"
| _ -> failwith "Findlib: unknown operating system"
in
let c = Sys.command (cmd ^ " " ^ Filename.quote dirname) in
if c <> 0 then
failwith ("Cannot make directory " ^ dirname)
;;
let remove_directory dirname =
(* Invoke the rmdir command *)
let cmd =
match Sys.os_type with
"Unix" -> "rmdir"
| "Cygwin" -> "rmdir" (* don't really know *)
| "Win32" -> "rd"
| "MacOS" -> failwith "remove_directory not implemented for MacOS"
| _ -> failwith "Findlib: unknown operating system"
in
let c = Sys.command (cmd ^ " " ^ Filename.quote dirname) in
if c <> 0 then
failwith ("Cannot remove directory " ^ dirname)
;;
let list_dir dirname =
let rec rd_dir f =
try
let s = input_line f in
if s = "" then rd_dir f else s::rd_dir f
with
End_of_file ->
close_in f;
[]
in
(* Invoke the ls command *)
let cmd =
match Sys.os_type with
"Unix" -> "ls -1"
| "Cygwin" -> "ls -1" (* don't really know *)
| "Win32" -> "dir /b"
| "MacOS" -> failwith "list_dir not implemented for MacOS"
| _ -> failwith "Findlib: unknown operating system"
in
let filename = Filename.temp_file "ocamlfind." ".dat" in
let fullcmd = cmd ^ " " ^ Filename.quote dirname ^ " >" ^ filename in
let n = Sys.command fullcmd in
if n <> 0 then
failwith ("Cannot execute: " ^ fullcmd);
let f = open_in filename in
let l = rd_dir f in
close_in f;
(try Sys.remove filename with _ -> ());
l
;;
let copy_file ?(rename = (fun name -> name)) ?(append = "") src dstdir =
(* A system-independent function to copy the file src to dstdir *)
let outname = rename (Filename.basename src) in
let ch_in = open_in_bin src in
try
let outpath = Filename.concat dstdir outname in
if Sys.file_exists outpath then
prerr_endline ("ocamlfind-mini: [WARNING] Overwriting file " ^ outpath);
let ch_out = open_out_bin outpath in
try
let buflen = 4096 in
let buf = String.create buflen in
let pos = ref 0 in
let len = ref (input ch_in buf 0 buflen) in
while !len > 0 do
output ch_out buf !pos !len;
len := input ch_in buf !pos buflen;
done;
output_string ch_out append;
close_out ch_out;
close_in ch_in;
prerr_endline("Installed " ^ outpath);
with
exc -> close_out ch_out; raise exc
with
exc -> close_in ch_in; raise exc
;;
let install_create_directory pkgname dstdir =
if Sys.file_exists dstdir then
failwith ("Package " ^ pkgname ^ " is already installed; please remove it first");
make_directory dstdir
;;
exception Skip_file;;
let install_package () =
let destdir = ref (env_destdir) in
let metadir = ref (env_metadir) in
let don't_add_directory_directive = ref false in
let pkgname = ref "" in
let files = ref [] in
let keywords =
[ "-destdir", (Arg.String (fun s -> destdir := s)),
"<path> Set the destination directory";
"-metadir", (Arg.String (fun s -> metadir := s)),
"<path> Install the META file into this directory";
"-dont-add-directory-directive", (Arg.Set don't_add_directory_directive),
" never append directory='...' to META";
] in
let errmsg = "usage: ocamlfind-mini install [options] <package_name> <file> ..." in
Arg.current := 1;
Arg.parse
keywords
(fun s ->
if !pkgname = ""
then pkgname := s
else files := s :: !files
)
errmsg;
if !pkgname = "" then (Arg.usage keywords errmsg; exit 1);
(* Check destdir: *)
if !destdir = "" then
failwith ("No destination directory. Either specify the -destdir option, or set the environment variable OCAMLFIND_DESTDIR");
if not (Sys.file_exists !destdir) then
failwith ("The destination directory " ^ !destdir ^ " does not exist");
(* Check whether META exists: *)
let meta_dot_pkg = "META." ^ !pkgname in
let has_meta =
List.exists
(fun p ->
let b = Filename.basename p in
b = "META" || b = meta_dot_pkg)
!files
in
if not has_meta then
failwith "The META file is missing";
(* Check that there is no meta_dot_pkg: *)
if Sys.file_exists (Filename.concat !metadir meta_dot_pkg) then
failwith ("Package " ^ !pkgname ^ " is already installed; please remove it first");
(* Create the package directory: *)
let pkgdir = Filename.concat !destdir !pkgname in
install_create_directory !pkgname pkgdir;
(* Now copy the files into the package directory: *)
let has_metadir = !metadir <> "" in
List.iter
(fun p ->
try
copy_file
~rename: (fun f ->
if has_metadir then begin
if f = "META" || f = meta_dot_pkg
then raise Skip_file
else f
end
else
if f = meta_dot_pkg then "META" else f)
p
pkgdir
with
Skip_file -> ()
)
!files;
(* Finally copy META into metadir, if this has been requested *)
if has_metadir then begin
List.iter
(fun p ->
let b = Filename.basename p in
if b = "META" || b = meta_dot_pkg then
copy_file
~rename: (fun f ->
if f = "META" then meta_dot_pkg else f)
~append: ("\ndirectory=\"" ^ pkgdir ^ "\" # auto-added by ocamlfind-mini\n")
p
!metadir
)
!files
end
;;
let remove_package () =
let destdir = ref (env_destdir) in
let metadir = ref (env_metadir) in
let pkgname = ref "" in
let keywords =
[ "-destdir", (Arg.String (fun s -> destdir := s)),
"<path> Set the destination directory";
"-metadir", (Arg.String (fun s -> metadir := s)),
"<path> Remove the META file from this directory";
] in
let errmsg = "usage: ocamlfind-mini remove [options] <package_name>" in
Arg.current := 1;
Arg.parse
keywords
(fun s ->
if !pkgname = ""
then pkgname := s
else raise (Arg.Bad "too many arguments")
)
errmsg;
if !pkgname = "" then (Arg.usage keywords errmsg; exit 1);
(* Check destdir: *)
if !destdir = "" then
failwith ("No destination directory. Either specify the -destdir option, or set the environment variable OCAMLFIND_DESTDIR");
if not (Sys.file_exists !destdir) then
failwith ("The destination directory " ^ !destdir ^ " does not exist");
let meta_dot_pkg = "META." ^ !pkgname in
let has_metadir = !metadir <> "" in
(* If there is a metadir, remove the META file from it: *)
if has_metadir then begin
let f = Filename.concat !metadir meta_dot_pkg in
if Sys.file_exists f then begin
Sys.remove f;
prerr_endline ("Removed " ^ f);
end
else
prerr_endline ("ocamlfind-mini: [WARNING] No such file: " ^ f)
end;
(* Remove the files from the package directory: *)
let pkgdir = Filename.concat !destdir !pkgname in
if Sys.file_exists pkgdir then begin
let files = list_dir pkgdir in
List.iter (fun f -> Sys.remove (Filename.concat pkgdir f)) files;
remove_directory pkgdir;
prerr_endline ("Removed " ^ pkgdir)
end
else
prerr_endline("ocamlfind-mini: [WARNING] No such directory: " ^ pkgdir);
;;
let select_mode() =
let m_string = try arg 1 with Not_found -> raise Usage in
let m =
match m_string with
("use"|"-use") -> M_use
| ("query"|"-query") -> M_query
| ("install"|"-install") -> M_install
| ("remove"|"-remove") -> M_remove
| ("ocamlc"|"-ocamlc") -> M_compiler "ocamlc"
| ("ocamlcp"|"-ocamlcp") -> M_compiler "ocamlcp"
| ("ocamlmktop"|"-ocamlmktop") -> M_compiler "ocamlmktop"
| ("ocamlopt"|"-ocamlopt") -> M_compiler "ocamlopt"
| ("printconf"|"-printconf") -> M_printconf
| ("guess"|"-guess") -> M_guess
| ("list"|"-list") -> M_list
| _ -> raise Usage
in
m
;;
let sorry() =
prerr_endline "ocamlfind-mini: sorry, this function is not implemented in the reduced version of ocamlfind";
exit 1
;;
let main() =
try
let m = select_mode() in
let l = Array.length Sys.argv in
let rest = Array.sub Sys.argv 2 (l-2) in
match m with
M_use -> if rest = [| |] then raise Usage;
if rest.(0) = "-p" then begin
if l<4 then raise Usage;
use_package rest.(1)
(List.tl(List.tl(Array.to_list rest)))
end
else
use_package "" (Array.to_list rest)
| M_query -> sorry()
| M_install -> install_package()
| M_remove -> remove_package ()
| M_printconf -> sorry()
| M_guess -> sorry()
| M_list -> sorry()
| M_compiler which -> ocamlc which ()
with
Usage ->
prerr_endline "usage: ocamlfind-mini ocamlc [-help | other options] <file> ...";
prerr_endline " or: ocamlfind-mini ocamlcp [-help | other options] <file> ...";
prerr_endline " or: ocamlfind-mini ocamlmktop [-help | other options] <file> ...";
prerr_endline " or: ocamlfind-mini ocamlopt [-help | other options] <file> ...";
prerr_endline " or: ocamlfind-mini install [-help | other options] <package_name> <file> ...";
prerr_endline " or: ocamlfind-mini remove [-help | other options] <package_name>";
exit 2
| Failure f ->
prerr_endline ("ocamlfind-mini: " ^ f);
exit 2
;;
try
Sys.catch_break true;
main()
with
any ->
prerr_endline ("Uncaught exception: " ^ Printexc.to_string any);
let raise_again =
try ignore(Sys.getenv "OCAMLFIND_DEBUG"); true
with Not_found -> false
in
if raise_again then raise any;
exit 3
;;
(* ======================================================================
* History:
*
* $Log: ocamlfind-mini,v $
* Revision 1.4 2001/03/10 08:15:24 gerd
* -warn-error
*
* Revision 1.3 2001/03/06 20:18:03 gerd
* Option -where.
*
* Revision 1.2 2001/03/04 19:03:56 gerd
* list_dir: deletes the temp file after use
*
* Revision 1.1 2001/03/04 19:01:21 gerd
* Initial revision.
*
*)
