#load "unix.cma";;
module String
 = struct
	include String
	let split
	 = fun char string ->
		let len = String.length string in
		let rec loop
		 = fun curr ->
			if curr >= len
			then []
			else (
				let next =
					try String.index_from string curr char
					with Not_found -> len in
				String.sub string curr (next - curr) :: loop (succ next)
			 )
		 in
		loop 0
	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
 end
module Path
 = struct
	type t = string
	let (//) = Filename.concat
 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 List
	 = struct
		let char =
			match Sys.os_type with
			| "Win32" -> ';'
			| _       -> ':'
		let split
		 = String.split char
		let t
		 = fun name ->
			try split (Sys.getenv name)
			with Not_found -> []
	 end
	let string
	 = fun name ->
		try Some (Sys.getenv name)
		with Not_found -> None
	let list
	 = List.t
 end
module Glob
 = 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.copy c in
			for i = 0 to pred (String.length c_def)
			 do match String.unsafe_get c_def i with
				| 'a'..'z' | 'A'..'Z' -> ()
				| _ -> String.unsafe_set c_def i '_'
			 done;
			c.Out.format "\
				#ifndef %s\n\
				#define %s\n\
			 "
			 c_def
			 c_def;
			if Sys.file_exists log
			then File.rm log;
			fct {c=c; caml=caml; camlpp=camlpp; make=make; log=log};
			c.Out.format "\
				#endif /* %s */\n\
			 "
			 c_def;
			c     .Out.close ();
			caml  .Out.close ();
			camlpp.Out.close ();
			make  .Out.close ();
		with exn ->
			File.rm c;
			File.rm caml;
			File.rm camlpp;
			File.rm make;
			raise exn
 end
module Emit
 = struct
	let bool
	 = fun ~glob:{Glob.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 "#let %s = true\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 "#let _%s = false\n" name;
				make   .Out.format "%s := \n" name
 end
module Trace
 = struct
	let format
	 = Printf.eprintf
 end
module Log
 = struct
	let t
	 = fun ~glob:{Glob.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 ~glob ->
		Printf.ksprintf
		 (fun string ->
			Log.t ~glob (Printf.sprintf "$ %s\n" string);
			match glob.Glob.log with
			| "" -> 0 = Sys.command string
			| log ->
				Printf.ksprintf
				 (fun string -> 0 = Sys.command string)
				 "{ %s ; } >>%s 2>&1"
				 string (Filename.quote log))
	let buffer_size = ref 2048
	let string
	 = fun ~glob ->
		Printf.ksprintf
		 (fun string ->
			Log.t ~glob (Printf.sprintf "$ %s\n" string);
			let sh
			 = fun string ->
				let size   = !buffer_size in
				let chan   = Unix.open_process_in string
				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;
				match Unix.close_process_in chan with
				| Unix.WEXITED 0 -> Buffer.contents buf
				| Unix.WEXITED int -> ""
				| Unix.WSIGNALED int
				| Unix.WSTOPPED  int ->
					Pervasives.failwith
					 (Printf.sprintf
						 "command received signal %i: %s"
						 int string) in
			match glob.Glob.log with
			| "" -> sh string
			| log ->
				Printf.ksprintf
				 (fun string -> sh string)
				 "{ %s ; } 2>&1 | tee -a %s"
				 string (Filename.quote log))
 end
module Compile
 = struct
	module Param
	 = struct
		let ocamlc     = ref "ocamlfind ocamlc"
		and ext_obj    = ref ".o"
		and os_type    = ref Sys.os_type
		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.list "C_INCLUDE_PATH")
				 ; List.map (fun dir -> {inc=dir//".." //"include"; lib=dir})
					 (Env.list "LIBRARY_PATH")
				 ; default
				 ]
			let t
			 = fun ~glob h ->
				Log.t ~glob (Printf.sprintf "# searching for %s .. " h);
				let rec loop
					= function
					| [] ->
						Log.t ~glob (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 ~glob (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 ~glob ~prefix ~default ->
			let (inc, lib) =
				match
				 ( Env.list (prefix ^ "_CFLAGS")
				 , Env.list (prefix ^ "_LIBS")
				 ) 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 {Glob.make} = glob in
			make.Out.format "%s_CFLAGS := %s\n" prefix (String.concat " " inc);
			make.Out.format "%s_LIBS   := %s\n" prefix (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 ~glob (opt, lib) c ->
		Caml.t "\
			external t : unit -> unit = \"t\"\n\
			let () = t ()\n\
		 "
		 (fun ~ml -> C.t c
			 (fun ~c -> Shell.t ~glob
				 "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 Check
 = struct
	let t
	 = fun ~glob ?(enable=true) ?(required=true) ~name ~macro test ->
		Log.t ~glob (Printf.sprintf "# checking %s\n" name);
		Trace.format "checking %s %!" name;
		let line = (String.make (35 - String.length name) '.') in
		match enable with
		| true ->
			(match try Some (test ~glob)
			with exn -> None with
			| Some _ as t ->
				Trace.format "%s available\n%!" line;
				Emit.bool ~glob macro true;
				t
			| None ->
				Trace.format "%s unavailable" line;
				Emit.bool ~glob macro false;
				if required
				then Trace.format " (required)\n%!"
				else Trace.format "\n%!";
				None
			)
		| _ ->
			Trace.format "%s disabled\n%!" line;
			Emit.bool ~glob macro enable;
			None
 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)
	let bool_auto
	 = fun t ->
		Arg.Symbol
		 ( ["auto"; "true"; "false"]
		 , function
		 | "auto"  -> t := None
		 | "false" -> t := Some false
		 | "true"  -> t := Some true
		 | _ -> assert false )
 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 ~glob:{Glob.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 ~glob:{Glob.make} ->
			match !Param.bool with
			| true  -> make.Out.format "export DEBUG := true\n";
			| false -> make.Out.format "export DEBUG := \n";
	 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-type" , Link.Mode.Arg.t Link.Param.mode        , Printf.sprintf "  link mode (DEFAULT: %s)" (Link.Mode.string !Link.Param.mode)
	 ; "--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
	 ; "--os-type"   , Arg.Set_string Compile.Param.os_type   , Printf.sprintf "<name>  type of the target os (DEFAULT: %s)" !Compile.Param.os_type
	 ; "--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 Glob.Param.c            , Printf.sprintf "<file>  C output (DEFAULT: %s)" !Glob.Param.c
	 ; "--caml"      , Arg.Set_string Glob.Param.caml         , Printf.sprintf "<file>  OCaml output (DEFAULT: %s)" !Glob.Param.caml
	 ; "--camlpp"    , Arg.Set_string Glob.Param.camlpp       , Printf.sprintf "<file>  OCaml preprocessor output (DEFAULT: %s)" !Glob.Param.camlpp
	 ; "--make"      , Arg.Set_string Glob.Param.make         , Printf.sprintf "<file>  Makefile output (DEFAULT: %s)" !Glob.Param.make
	 ; "--log"       , Arg.Set_string Glob.Param.log          , Printf.sprintf "<file>  shell log output (DEFAULT: %s)" !Glob.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\
		 \  <NAME>_CFLAGS compile-time flags for <NAME>\n\
		 \  <NAME>_LIBS link-time flags for <NAME>\n\
		 %s\
		 OPTIONS" Glob.Param.self env);
	Glob.t
	 (fun ({Glob.make} as glob) ->
		Debug.Emit.t ~glob;
		Link.Emit.t ~glob;
		let t = fct ~glob in
		t
	 )