#load "unix.cma";;
let (<|) = fun f g x -> f (g x)
and (|>) = fun f g x -> g (f x)
module Char
 = struct
	include Char
	let decimal
		= function
		| '0'..'9' -> true
		| _ -> false
	let white
		= function
		| ' '|'\n'|'\r'|'\t' -> true
		| _ -> false
 end
module String
 = struct
	include String
	module Split
	 = struct
		let t
		 ~(acc:'acc)
		 ~(next:string -> int -> int -> (int * int))
		 ~(sub:acc:'acc -> skip: int -> string -> int -> int -> 'acc)
		 string =
			let bgn = ref 0
			and siz = String.length string
			and last_skip = ref 0
			and acc = ref acc in
			while !bgn < siz || !last_skip <> 0 do
				let pos = !bgn in
				let keep, skip = next string pos (siz - pos) in
				let inc = keep + skip in
				assert (inc <> 0 || (inc = 0 && !last_skip <> 0));
				acc := sub ~acc:!acc ~skip string pos keep;
				last_skip := skip;
				bgn := pos + inc;
			 done;
			!acc
		let char
		 = fun char string ->
			t string ~acc: []
			 ~sub: (fun ~acc ~skip string pos siz ->
				let pos = String.length string - pos - siz in
				String.sub string pos siz::acc)
			 ~next: (fun string pos siz ->
				let keep = ref 0
				and pos  = String.length string - pos - 1 in
				while let keep = !keep
					in keep < siz
					&& not (char (String.unsafe_get string (pos - keep)))
				do incr keep done;
				(!keep, if !keep = siz then 0 else 1))
		let char_with_separators_glued
		 = fun char string ->
			t string ~acc: []
			 ~sub: (fun ~acc ~skip string pos siz ->
				let pos = String.length string - pos - siz in
				let acc = String.sub string pos siz::acc in
				if skip > 0
				then String.sub string (pos - skip) skip::acc
				else acc)
			 ~next: (fun string pos siz ->
				let keep = ref 0
				and skip = ref 0
				and pos  = String.length string - pos - 1 in
				while let keep = !keep
					in keep < siz
					&& not (char (String.unsafe_get string (pos - keep)))
				do incr keep done;
				let keep = !keep in
				let pos  = pos - keep
				and siz  = siz - keep in
				while let skip = !skip
					in skip < siz
					&& char (String.unsafe_get string (pos - skip))
				do incr skip done;
				let skip = !skip in
				(keep, skip))
	 end
	let chomp
	 = fun string ->
		let len = String.length string in
		let rec loop
			= function
			| 0 -> ""
			| curr ->
				match String.unsafe_get string (pred curr) with
				| ' '|'\n'|'\r'|'\t' -> loop (pred curr)
				| _ when curr = len -> string
				| _ -> String.sub string 0 curr
		 in
		loop len
	let macrofy
	 = fun string ->
		let string = copy string in
		for pos = 0 to pred (length string)
		 do match unsafe_get string pos with
			| 'a'..'z' | 'A'..'Z' | '_' -> ()
			| '0'..'9' when pos > 0 -> ()
			| _ -> unsafe_set string pos '_'
		 done;
		string
	let uidentify
	 = fun string ->
		let string = copy string in
		for pos = 0 to min 0 (pred (length string))
		 do match unsafe_get string pos with
			| 'a'..'z' | 'A'..'Z' | '_' -> ()
			| _ -> unsafe_set string pos '_'
		 done;
		string
 end
module Path
 = struct
	type t = string
	let (//) = Filename.concat
	let char =
		match Sys.os_type with
		| "Win32" -> ';'
		| _       -> ':'
 end
module File
 = struct
	let rm
	 = fun t ->
		try Sys.remove t
		with exn ->
			Pervasives.prerr_endline
			 ("File.rm: " ^ Printexc.to_string exn);
			()
	let tmp
	 = fun ?(prefix="tmp") ?(suffix="tmp") fct ->
		let (file, chan) = Filename.open_temp_file prefix suffix in
		let clean
		 = fun () ->
			rm file
		 in
		try let t = fct ~file ~chan in clean (); t
		with exn -> clean (); raise exn
 end
module Out
 = struct
	type t =
	 { close  : unit -> unit
	 ; format : 'a. ('a, Pervasives.out_channel, unit) format -> 'a
	 }
	let t
		= function
		| "" ->
			{ close  = Pervasives.ignore
			; format = (fun format -> Printf.ifprintf Pervasives.stderr format)
			}
		| file ->
			let chan = Pervasives.open_out file in
			{ close  = (fun _ -> Pervasives.close_out chan)
			; format = (fun format -> Printf.fprintf chan format)
			}
 end
module Env
 = struct
	module Path
	 = struct
		let split
		 = String.Split.char ((=) Path.char)
		let list
		 = fun name ->
			try split (Sys.getenv name)
			with Not_found -> []
	 end
	let string
	 = fun name ->
		try Some (Sys.getenv name)
		with Not_found -> None
 end
module Context
 = struct
	module Param
	 = struct
		let self   = Sys.argv.(0)
		let c      = ref (self^".h")
		and caml   = ref (self^".ml")
		and camlpp = ref (self^".mlp")
		and make   = ref (self^".make")
		and log    = ref (self^".log")
	 end
	type t =
	 { c      : Out.t
	 ; caml   : Out.t
	 ; camlpp : Out.t
	 ; make   : Out.t
	 ; log    : Path.t
	 }
	let t
	 = fun fct ->
		let c      = !Param.c
		and caml   = !Param.caml
		and camlpp = !Param.camlpp
		and make   = !Param.make
		and log    = !Param.log in
		try
			let c      = Out.t c
			and caml   = Out.t caml
			and camlpp = Out.t camlpp
			and make   = Out.t make
			and c_def  = String.macrofy c in
			c.Out.format "\
				#ifndef %s\n\
				#define %s\n\
			 "
			 c_def
			 c_def;
			if Sys.file_exists log
			then File.rm log;
			let t = fct {c=c; caml=caml; camlpp=camlpp; make=make; log=log} in
			c.Out.format "\
				#endif /* %s */\n\
			 "
			 c_def;
			c     .Out.close ();
			caml  .Out.close ();
			camlpp.Out.close ();
			make  .Out.close ();
			t
		with exn ->
			File.rm c;
			File.rm caml;
			File.rm camlpp;
			File.rm make;
			raise exn
 end
module Emit
 = struct
	let bool
	 = fun ~context:{Context.c=c; caml=caml; camlpp=camlpp; make=make} name bool ->
		match name with
		| "" -> ()
		| _ ->
			match bool with
			| true ->
				c      .Out.format "#define %s\n" name;
				caml   .Out.format "let _%s = true\n" name;
				camlpp .Out.format "DEFINE %s\n" name;
				make   .Out.format "%s := true\n" name
			| false ->
				c      .Out.format "#undef %s\n" name;
				caml   .Out.format "let _%s = false\n" name;
				camlpp .Out.format "(* DEFINE %s *)\n" name;
				make   .Out.format "%s := \n" name
	let string
	 = fun ~context:{Context.c=c; caml=caml; camlpp=camlpp; make=make} name string ->
		match name with
		| "" -> ()
		| _ ->
			c      .Out.format "#define %s = %S\n" name string;
			caml   .Out.format "let _%s = %S\n"    name string;
			camlpp .Out.format "DEFINE %s = %S\n"  name string;
			make   .Out.format "%s := \"%s\"\n"    name string
 end
module Trace
 = struct
	let format
	 = Printf.eprintf
 end
module Log
 = struct
	let t
	 = fun ~context:{Context.log=log} string ->
		match log with
		| "" -> ()
		| _ ->
			let log = Pervasives.open_out_gen
			 [Open_wronly; Open_append; Open_creat; Open_text] 0o660 log in
			Pervasives.output_string log string;
			Pervasives.close_out log;
 end
module Shell
 = struct
	let t
	 = fun ~context ->
		Printf.ksprintf
		 (fun string ->
			Log.t ~context (Printf.sprintf "$ %s\n" string);
			let sh
			 = fun string ->
				if 0 = Sys.command string
				then ()
				else raise Not_found
			 in
			match context.Context.log with
			| "" -> sh string
			| log ->
				Printf.ksprintf sh
				 "{ %s ; } >>%s 2>&1"
				 string (Filename.quote log))
	let buffer_size = ref 2048
	exception Exit of int * string
	let string
	 = fun ~context ->
		Printf.ksprintf
		 (fun string ->
			Log.t ~context (Printf.sprintf "$ %s\n" string);
			let sh
			 = fun cmd ->
				let size   = !buffer_size in
				let chan   = Unix.open_process_in cmd
				and buf    = Buffer.create size
				and string = String.create size
				and read   = ref 1 in
				while !read <> 0 do
					read := Pervasives.input chan string 0 size;
					Buffer.add_substring buf string 0 !read
				 done;
				let string = Buffer.contents buf in
				Log.t ~context string;
				match Unix.close_process_in chan with
				| Unix.WEXITED   0   -> string
				| Unix.WEXITED   int -> raise (Exit (int, string))
				| Unix.WSIGNALED int
				| Unix.WSTOPPED  int ->
					Pervasives.failwith
					 (Printf.sprintf
						 "command received signal %i: %s"
						 int cmd) in
			match context.Context.log with
			| "" -> sh string
			| log -> Printf.ksprintf sh "{ %s ; } 2>&1" string)
 end
module Compile
 = struct
	module Param
	 = struct
		let ocamlc     = ref "ocamlfind ocamlc"
		and ext_obj    = ref ".o"
		and ccomp_type = ref "cc"
	 end
	module Path
	 = struct
		type t =
		 { inc : Path.t
		 ; lib : Path.t
		 }
		let (//) = Path.(//)
		let default =
			List.map
			 (fun dir -> {inc=dir//"include"; lib=dir//"lib"})
			 [ "/usr/local"
			 ; "/opt/local"
			 ; "/usr"
			 ; "/opt"
			 ; "/sw"
			 ; "/mingw"
			 ]
	 end
	module Header
	 = struct
		module Search
		 = struct
			open Path
			let list =
				List.flatten
				 [ List.map (fun dir -> {inc=dir; lib=dir//".."//"lib"})
					 (Env.Path.list "C_INCLUDE_PATH")
				 ; List.map (fun dir -> {inc=dir//".." //"include"; lib=dir})
					 (Env.Path.list "LIBRARY_PATH")
				 ; default
				 ]
			let t
			 = fun ~context h ->
				Log.t ~context (Printf.sprintf "# searching for %s .. " h);
				let rec loop
					= function
					| [] ->
						Log.t ~context (Printf.sprintf "found NOTHING; \
						 you may use environment variables: \
						 C_INCLUDE_PATH and LIBRARY_PATH\n");
						None
					| {inc=inc; lib=lib}::list ->
						match Sys.file_exists (inc//h) with
						| false -> loop list
						| true ->
							Log.t ~context (Printf.sprintf "found include:%s lib:%s\n" inc lib);
							Some {inc=inc; lib=lib}
				 in
				loop list
		 end
	 end
	module Flags
	 = struct
		let t
		 = fun ~context ~name ~default ->
			let (inc, lib) =
				match
				 ( Env.Path.list ("CFLAGS_" ^ name)
				 , Env.Path.list ("LIBS_" ^ name)
				 ) with
				| (_::_ as opt), (_::_ as lib) -> (opt, lib)
				| t ->
					let opt, lib = default () in
					match t with
					| (_::_ as opt), []     -> (opt, lib)
					| []    , (_::_ as lib) -> (opt, lib)
					| []    , []            -> (opt, lib)
					| _ -> assert false in
			let {Context.make=make} = context in
			make.Out.format "CFLAGS_%s := %s\n" name (String.concat " " inc);
			make.Out.format "LIBS_%s := %s\n" name (String.concat " " lib);
			(inc, lib)
	 end
	module Caml
	 = struct
		let t
		 = fun string fct ->
			File.tmp ~prefix: "configure_ml_" ~suffix: ".ml"
			 (fun ~file ~chan ->
				Pervasives.output_string chan string;
				Pervasives.close_out chan;
				let clean
				 = fun () ->
					File.rm (Filename.chop_extension file ^ ".cmi");
					File.rm (Filename.chop_extension file ^ ".cmo");
					File.rm (Filename.chop_extension file ^ ".byte");
				 in
				try let t = fct ~ml:file in clean (); t
				with exn -> clean (); raise exn
			 )
	 end
	module C
	 = struct
		let t
		 = fun string fct ->
			File.tmp ~prefix: "configure_c_" ~suffix: ".c"
			 (fun ~file ~chan ->
				Pervasives.output_string chan string;
				Pervasives.close_out chan;
				let clean
				 = fun () ->
					File.rm (Filename.chop_extension file ^ !Param.ext_obj);
				 in
				try let t = fct ~c:file in clean (); t
				with exn -> clean (); raise exn
			 )
	 end
	let t
	 = fun ~context (opt, lib) c ->
		Caml.t "\
			external t : unit -> unit = \"t\"\n\
			let () = t ()\n\
		 "
		 (fun ~ml -> C.t c
			 (fun ~c -> Shell.t ~context
				 "cd %s && %s -o %s -verbose -custom %s %s %s %s"
				 (Filename.quote (Filename.dirname c))
				 !Param.ocamlc
				 (Filename.quote ((Filename.chop_extension ml) ^ ".byte"))
				 (String.concat " " (List.map (fun t -> Printf.sprintf "-ccopt %s" (Filename.quote t)) opt))
				 (String.concat " " (List.map (fun t -> Printf.sprintf "-cclib %s" (Filename.quote t)) lib))
				 (Filename.quote c)
				 (Filename.quote ml)))
 end
module Version
 = struct
	type i =
	 | Int    of int
	 | String of string
	type t = i list
	module String
	 = struct
		let t'
		 = fun string ->
			List.map
			 (fun string ->
				try Int (Pervasives.int_of_string string)
				with Failure "int_of_string" -> String string)
			 (String.Split.char_with_separators_glued
				 ((not) <| Char.decimal) string)
		let t
		 = fun t ->
			String.concat ""
			 (List.map
				 (function
				 | Int int -> Pervasives.string_of_int int
				 | String string -> string) t)
	 end
	let t = String.t'
	let string = String.t
	module Constraint
	 = struct
		type v = t
		type t =
		 | EQ  of v * v
		 | LT  of v * v
		 | LE  of v * v
		 | GT  of v * v
		 | GE  of v * v
		 | NOT of t
		 | AND of t * t
		 | OR  of t * t
		let rec bool
			= function
			| NOT (t)     -> not (bool t)
			| AND (t, tt) -> bool t && bool tt
			| OR  (t, tt) -> bool t || bool tt
			| EQ  (v, vv) -> v =  vv
			| LT  (v, vv) -> v <  vv
			| LE  (v, vv) -> v <= vv
			| GT  (v, vv) -> v >  vv
			| GE  (v, vv) -> v >= vv
		let rec string
			= function
			| NOT (t)     -> Printf.sprintf "(not %s)"   (string t)
			| AND (t, tt) -> Printf.sprintf "(%s && %s)" (string t)   (string tt)
			| OR  (t, tt) -> Printf.sprintf "(%s || %s)" (string t)   (string tt)
			| EQ  (v, vv) -> Printf.sprintf "(%s = %s)"  (String.t v) (String.t vv)
			| LT  (v, vv) -> Printf.sprintf "(%s < %s)"  (String.t v) (String.t vv)
			| LE  (v, vv) -> Printf.sprintf "(%s <= %s)" (String.t v) (String.t vv)
			| GT  (v, vv) -> Printf.sprintf "(%s > %s)"  (String.t v) (String.t vv)
			| GE  (v, vv) -> Printf.sprintf "(%s >= %s)" (String.t v) (String.t vv)
	 end
	exception Constraint of t * Constraint.t
 end
exception Check
module Check
 = struct
	let t
	 = fun ~context ?(enable=true) ?(optional=false) ?(mem=ref None)
	 ~descr ?(info=fun _ -> "") ?(info_exn=fun _ -> "")
	 ~macro test ->
		match !mem with
		| Some mem ->
			(match mem with
			| Some _ -> mem
			| None ->
				(match optional with
				| true -> None
				| false -> raise Check))
		| None ->
			Log.t ~context (Printf.sprintf "# checking %s\n" descr);
			Trace.format "checking %s %!" descr;
			let line = (String.make (45 - String.length descr) '.') in
			match enable with
			| false ->
				Trace.format "%s skip\n%!" line;
				Emit.bool ~context macro enable;
				None
			| true ->
				match (try Some (test ~context), Not_found
				 with exn -> None, exn) with
				| Some t as option, _ ->
					let info = info t in
					Trace.format "%s ok %s\n%!" line info;
					Emit.bool ~context macro true;
					mem := Some option;
					option
				| None, exn ->
					Trace.format "%s KO" line;
					Emit.bool ~context macro false;
					mem := Some None;
					match optional with
					| true ->
						Trace.format " (optional) %s\n%!" (info_exn exn);
						None
					| false ->
						Trace.format " (NOT optional) %s\n%!" (info_exn exn);
						raise Check
	module Version
	 = struct
		let t
		 = fun ?optional ?enable ?(mem=ref None) ?(info_exn=fun _ -> "")
		 ~context ~descr ~macro
		 ?(constraint_=fun t -> Version.Constraint.EQ (t, t))
		 version ->
			let old_mem = !mem in
			match t ~context ?optional ?enable ~mem ~descr ~macro
				 ~info: (fun t -> Printf.sprintf "(version %s)" (Version.string t))
				 ~info_exn: (function
					| Version.Constraint (v, c) ->
						Printf.sprintf "(version %s MUST satisfy: %s)"
						 (Version.string v)
						 (Version.Constraint.string c)
					| exn -> info_exn exn)
				 (fun ~context ->
					let v = version ~context in
					let c = constraint_ v in
					if not (Version.Constraint.bool c)
					then raise (Version.Constraint (v, c))
					else v)
			 with
			| Some version as option ->
				if old_mem = None
				then (
					let version = Version.string version in
					Emit.string ~context (String.macrofy ("VERSION_" ^ macro)) version;
					Emit.bool   ~context (String.macrofy ("VERSION_" ^ macro ^ "_" ^ version)) true;
				 );
				option
			| None -> None
	 end
 end
module Ocamlfind
 = struct
	module Check
	 = struct
		module Super = Check
		type t =
		 { ocamlc   : Version.t option
		 ; ocamlopt : Version.t option
		 }
		let mem          = ref None
		and mem_ocamlc   = ref None
		and mem_ocamlopt = ref None
		let t
		 = fun ~context ?optional
		 ?version_ocamlc ?version_ocamlopt
		 () ->
			match Check.t ~context ~descr: "ocamlfind"
				 ~macro: "HAVE_ocamlfind" ?optional ~mem
				 (Shell.t "ocamlfind printconf")
			 with
			| None -> None
			| Some () ->
				let ocamlc =
					Check.Version.t ~context ~descr: "ocamlc"   ~macro: "OCAMLC"
					 ~optional: false ?constraint_:version_ocamlc ~mem: mem_ocamlc
					 (fun ~context -> Version.t (String.chomp
						 (Shell.string ~context "ocamlfind ocamlc -version"))) in
				let ocamlopt =
					Check.Version.t ~context ~descr: "ocamlopt" ~macro: "OCAMLOPT"
					 ~optional: true  ?constraint_:version_ocamlopt ~mem: mem_ocamlopt
					 (fun ~context -> Version.t (String.chomp
						 (Shell.string ~context "ocamlfind ocamlopt -version"))) in
				Some
				 { ocamlc   = ocamlc
				 ; ocamlopt = ocamlopt
				 }
	 end
	module Package
	 = struct
		module Check
		 = struct
			let t
			 = fun ~context: ({Context.c=c; caml=caml; camlpp=camlpp; make=make} as context)
			 ?optional ?enable ?mem ?version
			 name ->
				assert (None <> Check.t () ~context ~optional: false);
				Check.Super.Version.t ~context ?optional ?enable ?mem ?constraint_:version
				 ~descr: ("ocamlfind package " ^ name)
				 ~macro: (String.macrofy ("PACKAGE_" ^ name))
				 (fun ~context -> Version.t (String.chomp
					 (Shell.string ~context "ocamlfind query -format '%%v' %s" name)))
		 end
	 end
 end
module Arg
 = struct
	include Arg
	let bool
	 = fun t ->
		Arg.Symbol
		 ( ["true"; "false"]
		 , function
		 | "false" -> t := false
		 | "true"  -> t := true
		 | _ -> assert false )
	let unit
	 = fun t ->
		Arg.Unit
		 (fun _ -> t := true)
	module Bool_auto
	 = struct
		module String
		 = struct
			let t
				= function
				| None       -> "auto"
				| Some false -> "false"
				| Some true  -> "true"
			let t'
				= function
				| "auto"  -> None
				| "false" -> Some false
				| "true"  -> Some true
				| _ -> assert false
		 end
		let string = String.t
		let t
		 = fun t ->
			Arg.Symbol
			 ( ["auto"; "false"; "true"]
			 , ((:=) t <| String.t') )
	 end
	module Path
	 = struct
		module String
		 = struct
			let t
				= String.concat (String.make 1 Path.char)
			let t'
				= String.Split.char ((=) Path.char)
		 end
		let t
		 = fun fct ->
			Arg.String
			 (fct <| String.t')
	 end
 end
module Link
 = struct
	module Mode
	 = struct
		type t =
		 [ `Auto
		 | `Static
		 | `Dynamic
		 ]
		module Arg
		 = struct
			let t
			 = fun t ->
				Arg.Symbol
				 ( ["auto"; "dynamic"; "static"]
				 , function
				 | "auto"    -> t := `Auto
				 | "static"  -> t := `Static
				 | "dynamic" -> t := `Dynamic
				 | _ -> assert false)
		 end
		let string
			= function
			| `Auto    -> "auto"
			| `Static  -> "static"
			| `Dynamic -> "dynamic"
	 end
	module Param
	 = struct
		let mode : Mode.t ref = ref `Auto
	 end
	module Emit
	 = struct
		let t
		 = fun ~context:{Context.make=make} ->
			match !Param.mode with
			| `Auto    -> make.Out.format "export LINKING_MODE := \n"
			| `Static  -> make.Out.format "export LINKING_MODE := static\n"
			| `Dynamic -> make.Out.format "export LINKING_MODE := dynamic\n"
	 end
 end
module Debug
 = struct
	type t =
	 bool
	let string
		= function
		| true  -> "true"
		| false -> "false"
	module Param
	 = struct
		let bool : t ref = ref false
	 end
	module Emit
	 = struct
		let t
		 = fun ~context:{Context.make=make} ->
			match !Param.bool with
			| true  -> make.Out.format "export DEBUG := true\n";
			| false -> make.Out.format "export DEBUG := \n";
	 end
 end
module OS
 = struct
	module Type
	 = struct
		type t =
		 [ `Unix
		 | `Win32
		 | `Cygwin
		 ]
		module String
		 = struct
			let t
				= function
				| `Unix   -> "Unix"  
				| `Win32  -> "Win32" 
				| `Cygwin -> "Cygwin"
			let t'
				= function
				| "Unix"   -> `Unix
				| "Win32"  -> `Win32
				| "Cygwin" -> `Cygwin
				| _ -> assert false
		 end
		let string = String.t
		module Arg
		 = struct
			let t
			 = fun t ->
				Arg.Symbol
				 ( ["Unix"; "Win32"; "Cygwin"]
				 , ((:=) t <| String.t') )
		 end
	 end
	module Param
	 = struct
		let type_ : Type.t ref = ref (Type.String.t' Sys.os_type)
	 end
	module Emit
	 = struct
		let t
		 = fun ~context:{Context.camlpp=camlpp} ->
			let type_ = Type.string !Param.type_ in
			camlpp.Out.format "DEFINE OS_TYPE = \"%s\"\n" type_;
			camlpp.Out.format "DEFINE %s\n" (String.uidentify type_)
	 end
 end
module Argv
 = struct
	let list = ref
	 [ "--debug"     , Arg.unit Debug.Param.bool              , Printf.sprintf "  activate debug (DEFAULT: %s)" (Debug.string !Debug.Param.bool)
	 ; "--link-mode" , Link.Mode.Arg.t Link.Param.mode        , Printf.sprintf "  link mode (DEFAULT: %s)" (Link.Mode.string !Link.Param.mode)
	 ; "--os-type"   , OS.Type.Arg.t OS.Param.type_           , Printf.sprintf "  type of the target OS (DEFAULT: %s)" (OS.Type.string !OS.Param.type_)
	 ; "--ocamlc"    , Arg.Set_string Compile.Param.ocamlc    , Printf.sprintf "<command>  ocamlc command (DEFAULT: %s)" !Compile.Param.ocamlc
	 ; "--ext-obj"   , Arg.Set_string Compile.Param.ext_obj   , Printf.sprintf "<ext>  C object files extension (DEFAULT: %s)" !Compile.Param.ext_obj
	 ; "--ccomp-type", Arg.Set_string Compile.Param.ccomp_type, Printf.sprintf "<name>  C compiler type (DEFAULT: %s)" !Compile.Param.ccomp_type
	 ; "--c"         , Arg.Set_string Context.Param.c         , Printf.sprintf "<file>  C output (DEFAULT: %s)" !Context.Param.c
	 ; "--caml"      , Arg.Set_string Context.Param.caml      , Printf.sprintf "<file>  OCaml output (DEFAULT: %s)" !Context.Param.caml
	 ; "--camlpp"    , Arg.Set_string Context.Param.camlpp    , Printf.sprintf "<file>  OCaml Pa_macro output (DEFAULT: %s)" !Context.Param.camlpp
	 ; "--make"      , Arg.Set_string Context.Param.make      , Printf.sprintf "<file>  Makefile output (DEFAULT: %s)" !Context.Param.make
	 ; "--log"       , Arg.Set_string Context.Param.log       , Printf.sprintf "<file>  shell log output (DEFAULT: %s)" !Context.Param.log
	 ]
 end
let t
 = fun ?(env="") ~argv fct ->
	Arg.parse
	 ( argv
	 @ !Argv.list
	 ) Pervasives.ignore
	 (Printf.sprintf
		 "check prerequisites and generate %s.* files\n\
		 ENVIRONMENT\n\
		 \  C_INCLUDE_PATH colon-separated paths to search C headers\n\
		 \  LIBRARY_PATH   colon-separated paths to search libraries\n\
		 \  CFLAGS_<name>  compile-time flags for <name>\n\
		 \  LIBS_<name>    link-time flags for <name>\n\
		 %s\
		 OPTIONS" Context.Param.self env);
	Context.t
	 (fun ({Context.make=make} as context) ->
		Debug.Emit.t ~context;
		Link.Emit.t ~context;
		OS.Emit.t ~context;
		let t = fct ~context in
		t
	 )