configure.ml

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