configure.ml

   1 #load "unix.cma";;
   2 let (<|) = fun f g x -> f (g x)
   3 and (|>) = fun f g x -> g (f x)
   4 module Char
   5  = struct
   6         include Char
   7         let decimal
   8                 = function
   9                 | '0'..'9' -> true
  10                 | _ -> false
  11         let white
  12                 = function
  13                 | ' '|'\n'|'\r'|'\t' -> true
  14                 | _ -> false
  15  end
  16 module String
  17  = struct
  18         include String
  19         module Split
  20          = struct
  21                 let t
  22                  ~(acc:'acc)
  23                  ~(next:string -> int -> int -> (int * int))
  24                  ~(sub:acc:'acc -> skip: int -> string -> int -> int -> 'acc)
  25                  string =
  26                         let bgn = ref 0
  27                         and siz = String.length string
  28                         and last_skip = ref 0
  29                         and acc = ref acc in
  30                         while !bgn < siz || !last_skip <> 0 do
  31                                 let pos = !bgn in
  32                                 let keep, skip = next string pos (siz - pos) in
  33                                 let inc = keep + skip in
  34                                 assert (inc <> 0 || (inc = 0 && !last_skip <> 0));
  35                                 acc := sub ~acc:!acc ~skip string pos keep;
  36                                 last_skip := skip;
  37                                 bgn := pos + inc;
  38                          done;
  39                         !acc
  40                 let char
  41                  = fun char string ->
  42                         t string ~acc: []
  43                          ~sub: (fun ~acc ~skip string pos siz ->
  44                                 let pos = String.length string - pos - siz in
  45                                 String.sub string pos siz::acc)
  46                          ~next: (fun string pos siz ->
  47                                 let keep = ref 0
  48                                 and pos  = String.length string - pos - 1 in
  49                                 while let keep = !keep
  50                                         in keep < siz
  51                                         && not (char (String.unsafe_get string (pos - keep)))
  52                                 do incr keep done;
  53                                 (!keep, if !keep = siz then 0 else 1))
  54                 let char_with_separators_glued
  55                  = fun char string ->
  56                         t string ~acc: []
  57                          ~sub: (fun ~acc ~skip string pos siz ->
  58                                 let pos = String.length string - pos - siz in
  59                                 let acc = String.sub string pos siz::acc in
  60                                 if skip > 0
  61                                 then String.sub string (pos - skip) skip::acc
  62                                 else acc)
  63                          ~next: (fun string pos siz ->
  64                                 let keep = ref 0
  65                                 and skip = ref 0
  66                                 and pos  = String.length string - pos - 1 in
  67                                 while let keep = !keep
  68                                         in keep < siz
  69                                         && not (char (String.unsafe_get string (pos - keep)))
  70                                 do incr keep done;
  71                                 let keep = !keep in
  72                                 let pos  = pos - keep
  73                                 and siz  = siz - keep in
  74                                 while let skip = !skip
  75                                         in skip < siz
  76                                         && char (String.unsafe_get string (pos - skip))
  77                                 do incr skip done;
  78                                 let skip = !skip in
  79                                 (keep, skip))
  80          end
  81         let chomp
  82          = fun string ->
  83                 let len = String.length string in
  84                 let rec loop
  85                         = function
  86                         | 0 -> ""
  87                         | curr ->
  88                                 match String.unsafe_get string (pred curr) with
  89                                 | ' '|'\n'|'\r'|'\t' -> loop (pred curr)
  90                                 | _ when curr = len -> string
  91                                 | _ -> String.sub string 0 curr
  92                  in
  93                 loop len
  94         let macrofy
  95          = fun string ->
  96                 let string = copy string in
  97                 for pos = 0 to pred (length string)
  98                  do match unsafe_get string pos with
  99                         | 'a'..'z' | 'A'..'Z' | '_' -> ()
 100                         | '0'..'9' when pos > 0 -> ()
 101                         | _ -> unsafe_set string pos '_'
 102                  done;
 103                 string
 104         let uidentify
 105          = fun string ->
 106                 let string = copy string in
 107                 for pos = 0 to min 0 (pred (length string))
 108                  do match unsafe_get string pos with
 109                         | 'a'..'z' | 'A'..'Z' | '_' -> ()
 110                         | _ -> unsafe_set string pos '_'
 111                  done;
 112                 string
 113  end
 114 module Sys
 115  = struct
 116         include Sys
 117         let command
 118          = fun cmd ->
 119                 let pid = Unix.create_process "sh" [| "sh"; "-c"; cmd |]
 120                  Unix.stdin Unix.stdout Unix.stderr in
 121                 match snd (Unix.waitpid [] pid) with
 122                 | Unix.WEXITED   n -> n
 123                 | Unix.WSIGNALED n -> n
 124                 | Unix.WSTOPPED  n -> n
 125  end
 126 module Path
 127  = struct
 128         type t = string
 129         let (//) = Filename.concat
 130         let char =
 131                 match Sys.os_type with
 132                 | "Win32" -> ';'
 133                 | _       -> ':'
 134  end
 135 module File
 136  = struct
 137         let rm
 138          = fun t ->
 139                 try Sys.remove t
 140                 with exn ->
 141                         Pervasives.prerr_endline
 142                          ("File.rm: " ^ Printexc.to_string exn);
 143                         ()
 144         let tmp
 145          = fun ?(prefix="tmp") ?(suffix="tmp") fct ->
 146                 let (file, chan) = Filename.open_temp_file prefix suffix in
 147                 let clean
 148                  = fun () ->
 149                         rm file
 150                  in
 151                 try let t = fct ~file ~chan in clean (); t
 152                 with exn -> clean (); raise exn
 153  end
 154 module Out
 155  = struct
 156         type t =
 157          { close  : unit -> unit
 158          ; format : 'a. ('a, Pervasives.out_channel, unit) format -> 'a
 159          }
 160         let t
 161                 = function
 162                 | "" ->
 163                         { close  = Pervasives.ignore
 164                         ; format = (fun format -> Printf.ifprintf Pervasives.stderr format)
 165                         }
 166                 | file ->
 167                         let chan = Pervasives.open_out file in
 168                         { close  = (fun _ -> Pervasives.close_out chan)
 169                         ; format = (fun format -> Printf.fprintf chan format)
 170                         }
 171  end
 172 module Env
 173  = struct
 174         module Path
 175          = struct
 176                 let split
 177                  = String.Split.char ((=) Path.char)
 178                 let list
 179                  = fun name ->
 180                         try split (Sys.getenv name)
 181                         with Not_found -> []
 182          end
 183         let string
 184          = fun name ->
 185                 try Some (Sys.getenv name)
 186                 with Not_found -> None
 187  end
 188 module Context
 189  = struct
 190         module Param
 191          = struct
 192                 let self   = Sys.argv.(0)
 193                 let c      = ref (self^".h")
 194                 and caml   = ref (self^".ml")
 195                 and camlpp = ref (Filename.concat (Filename.dirname self) ("pa_"^Filename.basename self^".ml"))
 196                 and make   = ref (self^".make")
 197                 and log    = ref (self^".log")
 198          end
 199         type t =
 200          { c      : Out.t
 201          ; caml   : Out.t
 202          ; camlpp : Out.t
 203          ; make   : Out.t
 204          ; log    : Path.t
 205          }
 206         let t
 207          = fun fct ->
 208                 let c      = !Param.c
 209                 and caml   = !Param.caml
 210                 and camlpp = !Param.camlpp
 211                 and make   = !Param.make
 212                 and log    = !Param.log in
 213                 try
 214                         let c      = Out.t c
 215                         and caml   = Out.t caml
 216                         and camlpp = Out.t camlpp
 217                         and make   = Out.t make
 218                         and c_def  = String.macrofy c in
 219                         c.Out.format "\
 220                                 #ifndef %s\n\
 221                                 #define %s\n\
 222                          "
 223                          c_def
 224                          c_def;
 225                         if Sys.file_exists log
 226                         then File.rm log;
 227                         let t = fct {c=c; caml=caml; camlpp=camlpp; make=make; log=log} in
 228                         c.Out.format "\
 229                                 #endif /* %s */\n\
 230                          "
 231                          c_def;
 232                         c     .Out.close ();
 233                         caml  .Out.close ();
 234                         camlpp.Out.close ();
 235                         make  .Out.close ();
 236                         t
 237                 with exn ->
 238                         File.rm c;
 239                         File.rm caml;
 240                         File.rm camlpp;
 241                         File.rm make;
 242                         raise exn
 243  end
 244 module Emit
 245  = struct
 246         let bool
 247          = fun ~context:{Context.c=c; caml=caml; camlpp=camlpp; make=make} name bool ->
 248                 match name with
 249                 | "" -> ()
 250                 | _ ->
 251                         match bool with
 252                         | true ->
 253                                 c      .Out.format "#define %s\n" name;
 254                                 caml   .Out.format "let _%s = true\n" name;
 255                                 camlpp .Out.format "DEFINE %s\n" name;
 256                                 make   .Out.format "%s := true\n" name
 257                         | false ->
 258                                 c      .Out.format "#undef %s\n" name;
 259                                 caml   .Out.format "let _%s = false\n" name;
 260                                 camlpp .Out.format "(* DEFINE %s *)\n" name;
 261                                 make   .Out.format "%s := \n" name
 262         let string
 263          = fun ~context:{Context.c=c; caml=caml; camlpp=camlpp; make=make} name string ->
 264                 match name with
 265                 | "" -> ()
 266                 | _ ->
 267                         c      .Out.format "#define %s = %S\n" name string;
 268                         caml   .Out.format "let _%s = %S\n"    name string;
 269                         camlpp .Out.format "DEFINE %s = %S\n"  name string;
 270                         make   .Out.format "%s := \"%s\"\n"    name string
 271  end
 272 module Trace
 273  = struct
 274         let format
 275          = Printf.eprintf
 276  end
 277 module Log
 278  = struct
 279         let t
 280          = fun ~context:{Context.log=log} string ->
 281                 match log with
 282                 | "" -> ()
 283                 | _ ->
 284                         let log = Pervasives.open_out_gen
 285                          [Open_wronly; Open_append; Open_creat; Open_text] 0o660 log in
 286                         Pervasives.output_string log string;
 287                         Pervasives.close_out log;
 288  end
 289 module Shell
 290  = struct
 291         let t
 292          = fun ~context ->
 293                 Printf.ksprintf
 294                  (fun string ->
 295                         Log.t ~context (Printf.sprintf "$ %s\n" string);
 296                         let sh
 297                          = fun string ->
 298                                 if 0 = Sys.command string
 299                                 then ()
 300                                 else raise Not_found
 301                          in
 302                         match context.Context.log with
 303                         | "" -> sh string
 304                         | log ->
 305                                 Printf.ksprintf sh
 306                                  "{ %s ; } >>%s 2>&1"
 307                                  string (Filename.quote log))
 308         let buffer_size = ref 2048
 309         exception Exit of int * string
 310         let string
 311          = fun ~context ->
 312                 Printf.ksprintf
 313                  (fun string ->
 314                         Log.t ~context (Printf.sprintf "$ %s\n" string);
 315                         let sh
 316                          = fun cmd ->
 317                                 let size   = !buffer_size in
 318                                 let pipe_out, pipe_in = Unix.pipe () in
 319                                 Unix.set_close_on_exec pipe_out;
 320                                 let pid = Unix.create_process "sh" [| "sh"; "-c"; cmd |]
 321                                  Unix.stdin pipe_in Unix.stderr in
 322                                 Unix.close pipe_in;
 323                                 let chan   = Unix.in_channel_of_descr pipe_out in
 324                                 let buf    = Buffer.create size
 325                                 and string = String.create size
 326                                 and read   = ref 1 in
 327                                 while !read <> 0 do
 328                                         read := Pervasives.input chan string 0 size;
 329                                         Buffer.add_substring buf string 0 !read
 330                                  done;
 331                                 let string = Buffer.contents buf in
 332                                 Log.t ~context string;
 333                                 match snd (Unix.waitpid [] pid) with
 334                                 | Unix.WEXITED   0   -> string
 335                                 | Unix.WEXITED   int -> raise (Exit (int, string))
 336                                 | Unix.WSIGNALED int
 337                                 | Unix.WSTOPPED  int ->
 338                                         Pervasives.failwith
 339                                          (Printf.sprintf
 340                                                  "command received signal %i: %s"
 341                                                  int cmd) in
 342                         match context.Context.log with
 343                         | "" -> sh string
 344                         | log -> Printf.ksprintf sh "{ %s ; } 2>&1" string)
 345  end
 346 module Compile
 347  = struct
 348         module Param
 349          = struct
 350                 let ocamlc     = ref "ocamlfind ocamlc"
 351                 and ext_obj    = ref ".o"
 352                 and ccomp_type = ref "cc"
 353          end
 354         module Path
 355          = struct
 356                 type t =
 357                  { inc : Path.t
 358                  ; lib : Path.t
 359                  }
 360                 let (//) = Path.(//)
 361                 let default =
 362                         List.map
 363                          (fun dir -> {inc=dir//"include"; lib=dir//"lib"})
 364                          [ "/usr/local"
 365                          ; "/opt/local"
 366                          ; "/usr"
 367                          ; "/opt"
 368                          ; "/sw"
 369                          ; "/mingw"
 370                          ]
 371          end
 372         module Header
 373          = struct
 374                 module Search
 375                  = struct
 376                         open Path
 377                         let list =
 378                                 List.flatten
 379                                  [ List.map (fun dir -> {inc=dir; lib=dir//".."//"lib"})
 380                                          (Env.Path.list "C_INCLUDE_PATH")
 381                                  ; List.map (fun dir -> {inc=dir//".." //"include"; lib=dir})
 382                                          (Env.Path.list "LIBRARY_PATH")
 383                                  ; default
 384                                  ]
 385                         let t
 386                          = fun ~context h ->
 387                                 Log.t ~context (Printf.sprintf "# searching for %s .. " h);
 388                                 let rec loop
 389                                         = function
 390                                         | [] ->
 391                                                 Log.t ~context (Printf.sprintf "found NOTHING; \
 392                                                  you may use environment variables: \
 393                                                  C_INCLUDE_PATH and LIBRARY_PATH\n");
 394                                                 None
 395                                         | {inc=inc; lib=lib}::list ->
 396                                                 match Sys.file_exists (inc//h) with
 397                                                 | false -> loop list
 398                                                 | true ->
 399                                                         Log.t ~context (Printf.sprintf "found include:%s lib:%s\n" inc lib);
 400                                                         Some {inc=inc; lib=lib}
 401                                  in
 402                                 loop list
 403                  end
 404          end
 405         module Flags
 406          = struct
 407                 let t
 408                  = fun ~context ~name ~default ->
 409                         let (inc, lib) =
 410                                 match
 411                                  ( Env.Path.list ("CFLAGS_" ^ name)
 412                                  , Env.Path.list ("LIBS_" ^ name)
 413                                  ) with
 414                                 | (_::_ as opt), (_::_ as lib) -> (opt, lib)
 415                                 | t ->
 416                                         let opt, lib = default () in
 417                                         match t with
 418                                         | (_::_ as opt), []     -> (opt, lib)
 419                                         | []    , (_::_ as lib) -> (opt, lib)
 420                                         | []    , []            -> (opt, lib)
 421                                         | _ -> assert false in
 422                         let {Context.make=make} = context in
 423                         make.Out.format "CFLAGS_%s := %s\n" name (String.concat " " inc);
 424                         make.Out.format "LIBS_%s := %s\n" name (String.concat " " lib);
 425                         (inc, lib)
 426          end
 427         module Caml
 428          = struct
 429                 let t
 430                  = fun string fct ->
 431                         File.tmp ~prefix: "configure_ml_" ~suffix: ".ml"
 432                          (fun ~file ~chan ->
 433                                 Pervasives.output_string chan string;
 434                                 Pervasives.close_out chan;
 435                                 let clean
 436                                  = fun () ->
 437                                         File.rm (Filename.chop_extension file ^ ".cmi");
 438                                         File.rm (Filename.chop_extension file ^ ".cmo");
 439                                         File.rm (Filename.chop_extension file ^ ".byte");
 440                                  in
 441                                 try let t = fct ~ml:file in clean (); t
 442                                 with exn -> clean (); raise exn
 443                          )
 444          end
 445         module C
 446          = struct
 447                 let t
 448                  = fun string fct ->
 449                         File.tmp ~prefix: "configure_c_" ~suffix: ".c"
 450                          (fun ~file ~chan ->
 451                                 Pervasives.output_string chan string;
 452                                 Pervasives.close_out chan;
 453                                 let clean
 454                                  = fun () ->
 455                                         File.rm (Filename.chop_extension file ^ !Param.ext_obj);
 456                                  in
 457                                 try let t = fct ~c:file in clean (); t
 458                                 with exn -> clean (); raise exn
 459                          )
 460          end
 461         let t
 462          = fun ~context (opt, lib) c ->
 463                 Caml.t "\
 464                         external t : unit -> unit = \"t\"\n\
 465                         let () = t ()\n\
 466                  "
 467                  (fun ~ml -> C.t c
 468                          (fun ~c -> Shell.t ~context
 469                                  "cd %s && %s -o %s -verbose -custom %s %s %s %s"
 470                                  (Filename.quote (Filename.dirname c))
 471                                  !Param.ocamlc
 472                                  (Filename.quote ((Filename.chop_extension ml) ^ ".byte"))
 473                                  (String.concat " " (List.map (fun t -> Printf.sprintf "-ccopt %s" (Filename.quote t)) opt))
 474                                  (String.concat " " (List.map (fun t -> Printf.sprintf "-cclib %s" (Filename.quote t)) lib))
 475                                  (Filename.quote c)
 476                                  (Filename.quote ml)))
 477  end
 478 module Version
 479  = struct
 480         type i =
 481          | Int    of int
 482          | String of string
 483         type t = i list
 484         module String
 485          = struct
 486                 let t'
 487                  = fun string ->
 488                         List.map
 489                          (fun string ->
 490                                 try Int (Pervasives.int_of_string string)
 491                                 with Failure "int_of_string" -> String string)
 492                          (String.Split.char_with_separators_glued
 493                                  ((not) <| Char.decimal) string)
 494                 let t
 495                  = fun t ->
 496                         String.concat ""
 497                          (List.map
 498                                  (function
 499                                  | Int int -> Pervasives.string_of_int int
 500                                  | String string -> string) t)
 501          end
 502         let t = String.t'
 503         let string = String.t
 504         module Constraint
 505          = struct
 506                 type v = t
 507                 type t =
 508                  | EQ  of v * v
 509                  | LT  of v * v
 510                  | LE  of v * v
 511                  | GT  of v * v
 512                  | GE  of v * v
 513                  | NOT of t
 514                  | AND of t * t
 515                  | OR  of t * t
 516                 let rec bool
 517                         = function
 518                         | NOT (t)     -> not (bool t)
 519                         | AND (t, tt) -> bool t && bool tt
 520                         | OR  (t, tt) -> bool t || bool tt
 521                         | EQ  (v, vv) -> v =  vv
 522                         | LT  (v, vv) -> v <  vv
 523                         | LE  (v, vv) -> v <= vv
 524                         | GT  (v, vv) -> v >  vv
 525                         | GE  (v, vv) -> v >= vv
 526                 let rec string
 527                         = function
 528                         | NOT (t)     -> Printf.sprintf "(not %s)"   (string t)
 529                         | AND (t, tt) -> Printf.sprintf "(%s && %s)" (string t)   (string tt)
 530                         | OR  (t, tt) -> Printf.sprintf "(%s || %s)" (string t)   (string tt)
 531                         | EQ  (v, vv) -> Printf.sprintf "(%s = %s)"  (String.t v) (String.t vv)
 532                         | LT  (v, vv) -> Printf.sprintf "(%s < %s)"  (String.t v) (String.t vv)
 533                         | LE  (v, vv) -> Printf.sprintf "(%s <= %s)" (String.t v) (String.t vv)
 534                         | GT  (v, vv) -> Printf.sprintf "(%s > %s)"  (String.t v) (String.t vv)
 535                         | GE  (v, vv) -> Printf.sprintf "(%s >= %s)" (String.t v) (String.t vv)
 536          end
 537         exception Constraint of t * Constraint.t
 538  end
 539 exception Check
 540 module Check
 541  = struct
 542         let t
 543          = fun ~context ?(enable=true) ?(optional=false) ?(mem=ref None)
 544          ~descr ?(info=fun _ -> "") ?(info_exn=fun _ -> "")
 545          ~macro test ->
 546                 match !mem with
 547                 | Some mem ->
 548                         (match mem with
 549                         | Some _ -> mem
 550                         | None ->
 551                                 (match optional with
 552                                 | true -> None
 553                                 | false -> raise Check))
 554                 | None ->
 555                         Log.t ~context (Printf.sprintf "# checking %s\n" descr);
 556                         Trace.format "checking %s %!" descr;
 557                         let line = (String.make (45 - String.length descr) '.') in
 558                         match enable with
 559                         | false ->
 560                                 Trace.format "%s skip\n%!" line;
 561                                 Emit.bool ~context macro enable;
 562                                 None
 563                         | true ->
 564                                 match (try Some (test ~context), Not_found
 565                                  with exn -> None, exn) with
 566                                 | Some t as option, _ ->
 567                                         let info = info t in
 568                                         Trace.format "%s ok %s\n%!" line info;
 569                                         Emit.bool ~context macro true;
 570                                         mem := Some option;
 571                                         option
 572                                 | None, exn ->
 573                                         Trace.format "%s KO" line;
 574                                         Emit.bool ~context macro false;
 575                                         mem := Some None;
 576                                         match optional with
 577                                         | true ->
 578                                                 Trace.format " (optional) %s\n%!" (info_exn exn);
 579                                                 None
 580                                         | false ->
 581                                                 Trace.format " (NOT optional) %s\n%!" (info_exn exn);
 582                                                 raise Check
 583         module Version
 584          = struct
 585                 let t
 586                  = fun ?optional ?enable ?(mem=ref None) ?(info_exn=fun _ -> "")
 587                  ~context ~descr ~macro
 588                  ?(constraint_=fun t -> Version.Constraint.EQ (t, t))
 589                  version ->
 590                         let old_mem = !mem in
 591                         match t ~context ?optional ?enable ~mem ~descr ~macro
 592                                  ~info: (fun t -> Printf.sprintf "(version %s)" (Version.string t))
 593                                  ~info_exn: (function
 594                                         | Version.Constraint (v, c) ->
 595                                                 Printf.sprintf "(version %s MUST satisfy: %s)"
 596                                                  (Version.string v)
 597                                                  (Version.Constraint.string c)
 598                                         | exn -> info_exn exn)
 599                                  (fun ~context ->
 600                                         let v = version ~context in
 601                                         let c = constraint_ v in
 602                                         if not (Version.Constraint.bool c)
 603                                         then raise (Version.Constraint (v, c))
 604                                         else v)
 605                          with
 606                         | Some version as option ->
 607                                 if old_mem = None
 608                                 then (
 609                                         let version = Version.string version in
 610                                         Emit.string ~context (String.macrofy ("VERSION_" ^ macro)) version;
 611                                         Emit.bool   ~context (String.macrofy ("VERSION_" ^ macro ^ "_" ^ version)) true;
 612                                  );
 613                                 option
 614                         | None -> None
 615          end
 616  end
 617 module Ocamlfind
 618  = struct
 619         module Check
 620          = struct
 621                 module Super = Check
 622                 type t =
 623                  { ocamlc   : Version.t option
 624                  ; ocamlopt : Version.t option
 625                  }
 626                 let mem          = ref None
 627                 and mem_ocamlc   = ref None
 628                 and mem_ocamlopt = ref None
 629                 let t
 630                  = fun ~context ?optional
 631                  ?version_ocamlc ?version_ocamlopt
 632                  () ->
 633                         match Check.t ~context ~descr: "ocamlfind"
 634                                  ~macro: "HAVE_ocamlfind" ?optional ~mem
 635                                  (Shell.t "ocamlfind printconf")
 636                          with
 637                         | None -> None
 638                         | Some () ->
 639                                 let ocamlc =
 640                                         Check.Version.t ~context ~descr: "ocamlc"   ~macro: "OCAMLC"
 641                                          ~optional: false ?constraint_:version_ocamlc ~mem: mem_ocamlc
 642                                          (fun ~context -> Version.t (String.chomp
 643                                                  (Shell.string ~context "ocamlfind ocamlc -version 2>/dev/null"))) in
 644                                 let ocamlopt =
 645                                         Check.Version.t ~context ~descr: "ocamlopt" ~macro: "OCAMLOPT"
 646                                          ~optional: true  ?constraint_:version_ocamlopt ~mem: mem_ocamlopt
 647                                          (fun ~context -> Version.t (String.chomp
 648                                                  (Shell.string ~context "ocamlfind ocamlopt -version 2>/dev/null"))) in
 649                                 Some
 650                                  { ocamlc   = ocamlc
 651                                  ; ocamlopt = ocamlopt
 652                                  }
 653          end
 654         module Package
 655          = struct
 656                 module Check
 657                  = struct
 658                         let t
 659                          = fun ~context: ({Context.c=c; caml=caml; camlpp=camlpp; make=make} as context)
 660                          ?optional ?enable ?mem ?version
 661                          name ->
 662                                 assert (None <> Check.t () ~context ~optional: false);
 663                                 Check.Super.Version.t ~context ?optional ?enable ?mem ?constraint_:version
 664                                  ~descr: ("ocamlfind package " ^ name)
 665                                  ~macro: (String.macrofy ("PACKAGE_" ^ name))
 666                                  (fun ~context -> Version.t (String.chomp
 667                                          (Shell.string ~context "ocamlfind query -format '%%v' %s 2>/dev/null" name)))
 668                  end
 669          end
 670  end
 671 module Arg
 672  = struct
 673         include Arg
 674         let bool
 675          = fun t ->
 676                 Arg.Symbol
 677                  ( ["true"; "false"]
 678                  , function
 679                  | "false" -> t := false
 680                  | "true"  -> t := true
 681                  | _ -> assert false )
 682         let unit
 683          = fun t ->
 684                 Arg.Unit
 685                  (fun _ -> t := true)
 686         module Bool_auto
 687          = struct
 688                 module String
 689                  = struct
 690                         let t
 691                                 = function
 692                                 | None       -> "auto"
 693                                 | Some false -> "false"
 694                                 | Some true  -> "true"
 695                         let t'
 696                                 = function
 697                                 | "auto"  -> None
 698                                 | "false" -> Some false
 699                                 | "true"  -> Some true
 700                                 | _ -> assert false
 701                  end
 702                 let string = String.t
 703                 let t
 704                  = fun t ->
 705                         Arg.Symbol
 706                          ( ["auto"; "false"; "true"]
 707                          , ((:=) t <| String.t') )
 708          end
 709         module Path
 710          = struct
 711                 module String
 712                  = struct
 713                         let t
 714                                 = String.concat (String.make 1 Path.char)
 715                         let t'
 716                                 = String.Split.char ((=) Path.char)
 717                  end
 718                 let t
 719                  = fun fct ->
 720                         Arg.String
 721                          (fct <| String.t')
 722          end
 723  end
 724 module Link
 725  = struct
 726         module Mode
 727          = struct
 728                 type t =
 729                  [ `Auto
 730                  | `Static
 731                  | `Dynamic
 732                  ]
 733                 module Arg
 734                  = struct
 735                         let t
 736                          = fun t ->
 737                                 Arg.Symbol
 738                                  ( ["auto"; "dynamic"; "static"]
 739                                  , function
 740                                  | "auto"    -> t := `Auto
 741                                  | "static"  -> t := `Static
 742                                  | "dynamic" -> t := `Dynamic
 743                                  | _ -> assert false)
 744                  end
 745                 let string
 746                         = function
 747                         | `Auto    -> "auto"
 748                         | `Static  -> "static"
 749                         | `Dynamic -> "dynamic"
 750          end
 751         module Param
 752          = struct
 753                 let mode : Mode.t ref = ref `Auto
 754          end
 755         module Emit
 756          = struct
 757                 let t
 758                  = fun ~context:{Context.make=make} ->
 759                         match !Param.mode with
 760                         | `Auto    -> make.Out.format "export LINKING_MODE := \n"
 761                         | `Static  -> make.Out.format "export LINKING_MODE := static\n"
 762                         | `Dynamic -> make.Out.format "export LINKING_MODE := dynamic\n"
 763          end
 764  end
 765 module Debug
 766  = struct
 767         type t =
 768          bool
 769         let string
 770                 = function
 771                 | true  -> "true"
 772                 | false -> "false"
 773         module Param
 774          = struct
 775                 let bool : t ref = ref false
 776          end
 777         module Emit
 778          = struct
 779                 let t
 780                  = fun ~context:{Context.make=make} ->
 781                         match !Param.bool with
 782                         | true  -> make.Out.format "export DEBUG := true\n";
 783                         | false -> make.Out.format "export DEBUG := \n";
 784          end
 785  end
 786 module OS
 787  = struct
 788         module Type
 789          = struct
 790                 type t =
 791                  [ `Unix
 792                  | `Win32
 793                  | `Cygwin
 794                  ]
 795                 module String
 796                  = struct
 797                         let t
 798                                 = function
 799                                 | `Unix   -> "Unix"
 800                                 | `Win32  -> "Win32"
 801                                 | `Cygwin -> "Cygwin"
 802                         let t'
 803                                 = function
 804                                 | "Unix"   -> `Unix
 805                                 | "Win32"  -> `Win32
 806                                 | "Cygwin" -> `Cygwin
 807                                 | _ -> assert false
 808                  end
 809                 let string = String.t
 810                 module Arg
 811                  = struct
 812                         let t
 813                          = fun t ->
 814                                 Arg.Symbol
 815                                  ( ["Unix"; "Win32"; "Cygwin"]
 816                                  , ((:=) t <| String.t') )
 817                  end
 818          end
 819         module Param
 820          = struct
 821                 let type_ : Type.t ref = ref (Type.String.t' Sys.os_type)
 822          end
 823         module Emit
 824          = struct
 825                 let t
 826                  = fun ~context:{Context.camlpp=camlpp} ->
 827                         let type_ = Type.string !Param.type_ in
 828                         camlpp.Out.format "DEFINE OS_TYPE = \"%s\"\n" type_;
 829                         camlpp.Out.format "DEFINE %s\n" (String.uidentify type_)
 830          end
 831  end
 832 module Argv
 833  = struct
 834         let list = ref
 835          [ "--debug"     , Arg.unit Debug.Param.bool              , Printf.sprintf "  activate debug (DEFAULT: %s)" (Debug.string !Debug.Param.bool)
 836          ; "--link-mode" , Link.Mode.Arg.t Link.Param.mode        , Printf.sprintf "  link mode (DEFAULT: %s)" (Link.Mode.string !Link.Param.mode)
 837          ; "--os-type"   , OS.Type.Arg.t OS.Param.type_           , Printf.sprintf "  type of the target OS (DEFAULT: %s)" (OS.Type.string !OS.Param.type_)
 838          ; "--ocamlc"    , Arg.Set_string Compile.Param.ocamlc    , Printf.sprintf "<command>  ocamlc command (DEFAULT: %s)" !Compile.Param.ocamlc
 839          ; "--ext-obj"   , Arg.Set_string Compile.Param.ext_obj   , Printf.sprintf "<ext>  C object files extension (DEFAULT: %s)" !Compile.Param.ext_obj
 840          ; "--ccomp-type", Arg.Set_string Compile.Param.ccomp_type, Printf.sprintf "<name>  C compiler type (DEFAULT: %s)" !Compile.Param.ccomp_type
 841          ; "--c"         , Arg.Set_string Context.Param.c         , Printf.sprintf "<file>  C output (DEFAULT: %s)" !Context.Param.c
 842          ; "--caml"      , Arg.Set_string Context.Param.caml      , Printf.sprintf "<file>  OCaml output (DEFAULT: %s)" !Context.Param.caml
 843          ; "--camlpp"    , Arg.Set_string Context.Param.camlpp    , Printf.sprintf "<file>  OCaml Pa_macro output (DEFAULT: %s)" !Context.Param.camlpp
 844          ; "--make"      , Arg.Set_string Context.Param.make      , Printf.sprintf "<file>  Makefile output (DEFAULT: %s)" !Context.Param.make
 845          ; "--log"       , Arg.Set_string Context.Param.log       , Printf.sprintf "<file>  shell log output (DEFAULT: %s)" !Context.Param.log
 846          ]
 847  end
 848 let t
 849  = fun ?(env="") ~argv fct ->
 850         Arg.parse
 851          ( argv
 852          @ !Argv.list
 853          ) Pervasives.ignore
 854          (Printf.sprintf
 855                  "check prerequisites and generate %s.* files\n\
 856                  ENVIRONMENT\n\
 857                  \  C_INCLUDE_PATH colon-separated paths to search C headers\n\
 858                  \  LIBRARY_PATH   colon-separated paths to search libraries\n\
 859                  \  CFLAGS_<name>  compile-time flags for <name>\n\
 860                  \  LIBS_<name>    link-time flags for <name>\n\
 861                  %s\
 862                  OPTIONS" Context.Param.self env);
 863         Context.t
 864          (fun ({Context.make=make} as context) ->
 865                 Debug.Emit.t ~context;
 866                 Link.Emit.t ~context;
 867                 OS.Emit.t ~context;
 868                 let t = fct ~context in
 869                 t
 870          )