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