configure.ml

   1 #load "unix.cma";;
   2 module String
   3  = struct
   4         include String
   5         let split
   6          = fun char string ->
   7                 let len = String.length string in
   8                 let rec loop
   9                  = fun curr ->
  10                         if curr >= len
  11                         then []
  12                         else (
  13                                 let next =
  14                                         try String.index_from string curr char
  15                                         with Not_found -> len in
  16                                 String.sub string curr (next - curr) :: loop (succ next)
  17                          )
  18                  in
  19                 loop 0
  20         let chomp
  21          = fun string ->
  22                 let len = String.length string in
  23                 let rec loop
  24                         = function
  25                         | 0 -> ""
  26                         | curr ->
  27                                 match String.unsafe_get string (pred curr) with
  28                                 | ' '|'\n'|'\r'|'\t' -> loop (pred curr)
  29                                 | _ when curr = len -> string
  30                                 | _ -> String.sub string 0 curr
  31                  in
  32                 loop len
  33  end
  34 module Path
  35  = struct
  36         type t = string
  37         let (//) = Filename.concat
  38  end
  39 module File
  40  = struct
  41         let rm
  42          = fun t ->
  43                 try Sys.remove t
  44                 with exn ->
  45                         Pervasives.prerr_endline
  46                          ("File.rm: " ^ Printexc.to_string exn);
  47                         ()
  48         let tmp
  49          = fun ?(prefix="tmp") ?(suffix="tmp") fct ->
  50                 let (file, chan) = Filename.open_temp_file prefix suffix in
  51                 let clean
  52                  = fun () ->
  53                         rm file
  54                  in
  55                 try let t = fct ~file ~chan in clean (); t
  56                 with exn -> clean (); raise exn
  57  end
  58 module Out
  59  = struct
  60         type t =
  61          { close  : unit -> unit
  62          ; format : 'a. ('a, Pervasives.out_channel, unit) format -> 'a
  63          }
  64         let t
  65                 = function
  66                 | "" ->
  67                         { close  = Pervasives.ignore
  68                         ; format = (fun format -> Printf.ifprintf Pervasives.stderr format)
  69                         }
  70                 | file ->
  71                         let chan = Pervasives.open_out file in
  72                         { close  = (fun _ -> Pervasives.close_out chan)
  73                         ; format = (fun format -> Printf.fprintf chan format)
  74                         }
  75  end
  76 module Env
  77  = struct
  78         module List
  79          = struct
  80                 let char =
  81                         match Sys.os_type with
  82                         | "Win32" -> ';'
  83                         | _       -> ':'
  84                 let split
  85                  = String.split char
  86                 let t
  87                  = fun name ->
  88                         try split (Sys.getenv name)
  89                         with Not_found -> []
  90          end
  91         let string
  92          = fun name ->
  93                 try Some (Sys.getenv name)
  94                 with Not_found -> None
  95         let list
  96          = List.t
  97  end
  98 module Glob
  99  = struct
 100         module Param
 101          = struct
 102                 let self   = Sys.argv.(0)
 103                 let c      = ref (self^".h")
 104                 and caml   = ref (self^".ml")
 105                 and camlpp = ref (self^".mlp")
 106                 and make   = ref (self^".make")
 107                 and log    = ref (self^".log")
 108          end
 109         type t =
 110          { c      : Out.t
 111          ; caml   : Out.t
 112          ; camlpp : Out.t
 113          ; make   : Out.t
 114          ; log    : Path.t
 115          }
 116         let t
 117          = fun fct ->
 118                 let c      = !Param.c
 119                 and caml   = !Param.caml
 120                 and camlpp = !Param.camlpp
 121                 and make   = !Param.make
 122                 and log    = !Param.log in
 123                 try
 124                         let c      = Out.t c
 125                         and caml   = Out.t caml
 126                         and camlpp = Out.t camlpp
 127                         and make   = Out.t make
 128                         and c_def  = String.copy c in
 129                         for i = 0 to pred (String.length c_def)
 130                          do match String.unsafe_get c_def i with
 131                                 | 'a'..'z' | 'A'..'Z' -> ()
 132                                 | _ -> String.unsafe_set c_def i '_'
 133                          done;
 134                         c.Out.format "\
 135                                 #ifndef %s\n\
 136                                 #define %s\n\
 137                          "
 138                          c_def
 139                          c_def;
 140                         if Sys.file_exists log
 141                         then File.rm log;
 142                         fct {c=c; caml=caml; camlpp=camlpp; make=make; log=log};
 143                         c.Out.format "\
 144                                 #endif /* %s */\n\
 145                          "
 146                          c_def;
 147                         c     .Out.close ();
 148                         caml  .Out.close ();
 149                         camlpp.Out.close ();
 150                         make  .Out.close ();
 151                 with exn ->
 152                         File.rm c;
 153                         File.rm caml;
 154                         File.rm camlpp;
 155                         File.rm make;
 156                         raise exn
 157  end
 158 module Emit
 159  = struct
 160         let bool
 161          = fun ~glob:{Glob.c=c; caml=caml; camlpp=camlpp; make=make} name bool ->
 162                 match name with
 163                 | "" -> ()
 164                 | _ ->
 165                         match bool with
 166                         | true ->
 167                                 c      .Out.format "#define %s\n" name;
 168                                 caml   .Out.format "let _%s = true\n" name;
 169                                 camlpp .Out.format "#let %s = true\n" name;
 170                                 make   .Out.format "%s := true\n" name
 171                         | false ->
 172                                 c      .Out.format "#undef %s\n" name;
 173                                 caml   .Out.format "let _%s = false\n" name;
 174                                 camlpp .Out.format "#let _%s = false\n" name;
 175                                 make   .Out.format "%s := \n" name
 176  end
 177 module Trace
 178  = struct
 179         let format
 180          = Printf.eprintf
 181  end
 182 module Log
 183  = struct
 184         let t
 185          = fun ~glob:{Glob.log=log} string ->
 186                 match log with
 187                 | "" -> ()
 188                 | _ ->
 189                         let log = Pervasives.open_out_gen
 190                          [Open_wronly; Open_append; Open_creat; Open_text] 0o660 log in
 191                         Pervasives.output_string log string;
 192                         Pervasives.close_out log;
 193  end
 194 module Shell
 195  = struct
 196         let t
 197          = fun ~glob ->
 198                 Printf.ksprintf
 199                  (fun string ->
 200                         Log.t ~glob (Printf.sprintf "$ %s\n" string);
 201                         match glob.Glob.log with
 202                         | "" -> 0 = Sys.command string
 203                         | log ->
 204                                 Printf.ksprintf
 205                                  (fun string -> 0 = Sys.command string)
 206                                  "{ %s ; } >>%s 2>&1"
 207                                  string (Filename.quote log))
 208         let buffer_size = ref 2048
 209         let string
 210          = fun ~glob ->
 211                 Printf.ksprintf
 212                  (fun string ->
 213                         Log.t ~glob (Printf.sprintf "$ %s\n" string);
 214                         let sh
 215                          = fun string ->
 216                                 let size   = !buffer_size in
 217                                 let chan   = Unix.open_process_in string
 218                                 and buf    = Buffer.create size
 219                                 and string = String.create size
 220                                 and read   = ref 1 in
 221                                 while !read <> 0 do
 222                                         read := Pervasives.input chan string 0 size;
 223                                         Buffer.add_substring buf string 0 !read
 224                                  done;
 225                                 match Unix.close_process_in chan with
 226                                 | Unix.WEXITED 0 -> Buffer.contents buf
 227                                 | Unix.WEXITED int -> ""
 228                                 | Unix.WSIGNALED int
 229                                 | Unix.WSTOPPED  int ->
 230                                         Pervasives.failwith
 231                                          (Printf.sprintf
 232                                                  "command received signal %i: %s"
 233                                                  int string) in
 234                         match glob.Glob.log with
 235                         | "" -> sh string
 236                         | log ->
 237                                 Printf.ksprintf
 238                                  (fun string -> sh string)
 239                                  "{ %s ; } 2>&1 | tee -a %s"
 240                                  string (Filename.quote log))
 241  end
 242 module Compile
 243  = struct
 244         module Param
 245          = struct
 246                 let ocamlc     = ref "ocamlfind ocamlc"
 247                 and ext_obj    = ref ".o"
 248                 and os_type    = ref Sys.os_type
 249                 and ccomp_type = ref "cc"
 250          end
 251         module Path
 252          = struct
 253                 type t =
 254                  { inc : Path.t
 255                  ; lib : Path.t
 256                  }
 257                 let (//) = Path.(//)
 258                 let default =
 259                         List.map
 260                          (fun dir -> {inc=dir//"include"; lib=dir//"lib"})
 261                          [ "/usr/local"
 262                          ; "/opt/local"
 263                          ; "/usr"
 264                          ; "/opt"
 265                          ; "/sw"
 266                          ; "/mingw"
 267                          ]
 268          end
 269         module Header
 270          = struct
 271                 module Search
 272                  = struct
 273                         open Path
 274                         let list =
 275                                 List.flatten
 276                                  [ List.map (fun dir -> {inc=dir; lib=dir//".."//"lib"})
 277                                          (Env.list "C_INCLUDE_PATH")
 278                                  ; List.map (fun dir -> {inc=dir//".." //"include"; lib=dir})
 279                                          (Env.list "LIBRARY_PATH")
 280                                  ; default
 281                                  ]
 282                         let t
 283                          = fun ~glob h ->
 284                                 Log.t ~glob (Printf.sprintf "# searching for %s .. " h);
 285                                 let rec loop
 286                                         = function
 287                                         | [] ->
 288                                                 Log.t ~glob (Printf.sprintf "found NOTHING; \
 289                                                  you may use environment variables: \
 290                                                  C_INCLUDE_PATH and LIBRARY_PATH\n");
 291                                                 None
 292                                         | {inc=inc; lib=lib}::list ->
 293                                                 match Sys.file_exists (inc//h) with
 294                                                 | false -> loop list
 295                                                 | true ->
 296                                                         Log.t ~glob (Printf.sprintf "found include:%s lib:%s\n" inc lib);
 297                                                         Some {inc=inc; lib=lib}
 298                                  in
 299                                 loop list
 300                  end
 301          end
 302         module Flags
 303          = struct
 304                 let t
 305                  = fun ~glob ~prefix ~default ->
 306                         let (inc, lib) =
 307                                 match
 308                                  ( Env.list (prefix ^ "_CFLAGS")
 309                                  , Env.list (prefix ^ "_LIBS")
 310                                  ) with
 311                                 | (_::_ as opt), (_::_ as lib) -> (opt, lib)
 312                                 | t ->
 313                                         let opt, lib = default () in
 314                                         match t with
 315                                         | (_::_ as opt), []     -> (opt, lib)
 316                                         | []    , (_::_ as lib) -> (opt, lib)
 317                                         | []    , []            -> (opt, lib)
 318                                         | _ -> assert false in
 319                         let {Glob.make} = glob in
 320                         make.Out.format "%s_CFLAGS := %s\n" prefix (String.concat " " inc);
 321                         make.Out.format "%s_LIBS   := %s\n" prefix (String.concat " " lib);
 322                         (inc, lib)
 323          end
 324         module Caml
 325          = struct
 326                 let t
 327                  = fun string fct ->
 328                         File.tmp ~prefix: "configure_ml_" ~suffix: ".ml"
 329                          (fun ~file ~chan ->
 330                                 Pervasives.output_string chan string;
 331                                 Pervasives.close_out chan;
 332                                 let clean
 333                                  = fun () ->
 334                                         File.rm (Filename.chop_extension file ^ ".cmi");
 335                                         File.rm (Filename.chop_extension file ^ ".cmo");
 336                                         File.rm (Filename.chop_extension file ^ ".byte");
 337                                  in
 338                                 try let t = fct ~ml:file in clean (); t
 339                                 with exn -> clean (); raise exn
 340                          )
 341          end
 342         module C
 343          = struct
 344                 let t
 345                  = fun string fct ->
 346                         File.tmp ~prefix: "configure_c_" ~suffix: ".c"
 347                          (fun ~file ~chan ->
 348                                 Pervasives.output_string chan string;
 349                                 Pervasives.close_out chan;
 350                                 let clean
 351                                  = fun () ->
 352                                         File.rm (Filename.chop_extension file ^ !Param.ext_obj);
 353                                  in
 354                                 try let t = fct ~c:file in clean (); t
 355                                 with exn -> clean (); raise exn
 356                          )
 357          end
 358         let t
 359          = fun ~glob (opt, lib) c ->
 360                 Caml.t "\
 361                         external t : unit -> unit = \"t\"\n\
 362                         let () = t ()\n\
 363                  "
 364                  (fun ~ml -> C.t c
 365                          (fun ~c -> Shell.t ~glob
 366                                  "cd %s && %s -o %s -verbose -custom %s %s %s %s"
 367                                  (Filename.quote (Filename.dirname c))
 368                                  !Param.ocamlc
 369                                  (Filename.quote ((Filename.chop_extension ml) ^ ".byte"))
 370                                  (String.concat " " (List.map (fun t -> Printf.sprintf "-ccopt %s" (Filename.quote t)) opt))
 371                                  (String.concat " " (List.map (fun t -> Printf.sprintf "-cclib %s" (Filename.quote t)) lib))
 372                                  (Filename.quote c)
 373                                  (Filename.quote ml)))
 374  end
 375 module Check
 376  = struct
 377         let t
 378          = fun ~glob ?(enable=true) ?(required=true) ~name ~macro test ->
 379                 Log.t ~glob (Printf.sprintf "# checking %s\n" name);
 380                 Trace.format "checking %s %!" name;
 381                 let line = (String.make (35 - String.length name) '.') in
 382                 match enable with
 383                 | true ->
 384                         (match try Some (test ~glob)
 385                         with exn -> None with
 386                         | Some _ as t ->
 387                                 Trace.format "%s available\n%!" line;
 388                                 Emit.bool ~glob macro true;
 389                                 t
 390                         | None ->
 391                                 Trace.format "%s unavailable" line;
 392                                 Emit.bool ~glob macro false;
 393                                 if required
 394                                 then Trace.format " (required)\n%!"
 395                                 else Trace.format "\n%!";
 396                                 None
 397                         )
 398                 | _ ->
 399                         Trace.format "%s disabled\n%!" line;
 400                         Emit.bool ~glob macro enable;
 401                         None
 402  end
 403 module Arg
 404  = struct
 405         include Arg
 406         let bool
 407          = fun t ->
 408                 Arg.Symbol
 409                  ( ["true"; "false"]
 410                  , function
 411                  | "false" -> t := false
 412                  | "true"  -> t := true
 413                  | _ -> assert false )
 414         let unit
 415          = fun t ->
 416                 Arg.Unit
 417                  (fun _ -> t := true)
 418         let bool_auto
 419          = fun t ->
 420                 Arg.Symbol
 421                  ( ["auto"; "true"; "false"]
 422                  , function
 423                  | "auto"  -> t := None
 424                  | "false" -> t := Some false
 425                  | "true"  -> t := Some true
 426                  | _ -> assert false )
 427  end
 428 module Link
 429  = struct
 430         module Mode
 431          = struct
 432                 type t =
 433                  [ `Auto
 434                  | `Static
 435                  | `Dynamic
 436                  ]
 437                 module Arg
 438                  = struct
 439                         let t
 440                          = fun t ->
 441                                 Arg.Symbol
 442                                  ( ["auto"; "dynamic"; "static"]
 443                                  , function
 444                                  | "auto"    -> t := `Auto
 445                                  | "static"  -> t := `Static
 446                                  | "dynamic" -> t := `Dynamic
 447                                  | _ -> assert false)
 448                  end
 449                 let string
 450                         = function
 451                         | `Auto    -> "auto"
 452                         | `Static  -> "static"
 453                         | `Dynamic -> "dynamic"
 454          end
 455         module Param
 456          = struct
 457                 let mode : Mode.t ref = ref `Auto
 458          end
 459         module Emit
 460          = struct
 461                 let t
 462                  = fun ~glob:{Glob.make} ->
 463                         match !Param.mode with
 464                         | `Auto    -> make.Out.format "export LINKING_MODE := \n"
 465                         | `Static  -> make.Out.format "export LINKING_MODE := static\n"
 466                         | `Dynamic -> make.Out.format "export LINKING_MODE := dynamic\n"
 467          end
 468  end
 469 module Debug
 470  = struct
 471         type t =
 472          bool
 473         let string
 474                 = function
 475                 | true  -> "true"
 476                 | false -> "false"
 477         module Param
 478          = struct
 479                 let bool : t ref = ref false
 480          end
 481         module Emit
 482          = struct
 483                 let t
 484                  = fun ~glob:{Glob.make} ->
 485                         match !Param.bool with
 486                         | true  -> make.Out.format "export DEBUG := true\n";
 487                         | false -> make.Out.format "export DEBUG := \n";
 488          end
 489  end
 490 module Argv
 491  = struct
 492         let list = ref
 493          [ "--debug"     , Arg.unit Debug.Param.bool              , Printf.sprintf "  activate debug (DEFAULT: %s)" (Debug.string !Debug.Param.bool)
 494          ; "--link-type" , Link.Mode.Arg.t Link.Param.mode        , Printf.sprintf "  link mode (DEFAULT: %s)" (Link.Mode.string !Link.Param.mode)
 495          ; "--ocamlc"    , Arg.Set_string Compile.Param.ocamlc    , Printf.sprintf "<command>  ocamlc command (DEFAULT: %s)" !Compile.Param.ocamlc
 496          ; "--ext-obj"   , Arg.Set_string Compile.Param.ext_obj   , Printf.sprintf "<ext>  C object files extension (DEFAULT: %s)" !Compile.Param.ext_obj
 497          ; "--os-type"   , Arg.Set_string Compile.Param.os_type   , Printf.sprintf "<name>  type of the target os (DEFAULT: %s)" !Compile.Param.os_type
 498          ; "--ccomp-type", Arg.Set_string Compile.Param.ccomp_type, Printf.sprintf "<name>  C compiler type (DEFAULT: %s)" !Compile.Param.ccomp_type
 499          ; "--c"         , Arg.Set_string Glob.Param.c            , Printf.sprintf "<file>  C output (DEFAULT: %s)" !Glob.Param.c
 500          ; "--caml"      , Arg.Set_string Glob.Param.caml         , Printf.sprintf "<file>  OCaml output (DEFAULT: %s)" !Glob.Param.caml
 501          ; "--camlpp"    , Arg.Set_string Glob.Param.camlpp       , Printf.sprintf "<file>  OCaml preprocessor output (DEFAULT: %s)" !Glob.Param.camlpp
 502          ; "--make"      , Arg.Set_string Glob.Param.make         , Printf.sprintf "<file>  Makefile output (DEFAULT: %s)" !Glob.Param.make
 503          ; "--log"       , Arg.Set_string Glob.Param.log          , Printf.sprintf "<file>  shell log output (DEFAULT: %s)" !Glob.Param.log
 504          ]
 505  end
 506 let t
 507  = fun ?(env="") ~argv fct ->
 508         Arg.parse
 509          ( argv
 510          @ !Argv.list
 511          ) Pervasives.ignore
 512          (Printf.sprintf
 513                  "check prerequisites and generate %s.* files\n\
 514                  ENVIRONMENT\n\
 515                  \  C_INCLUDE_PATH colon-separated paths to search C headers\n\
 516                  \  LIBRARY_PATH colon-separated paths to search libraries\n\
 517                  \  <NAME>_CFLAGS compile-time flags for <NAME>\n\
 518                  \  <NAME>_LIBS link-time flags for <NAME>\n\
 519                  %s\
 520                  OPTIONS" Glob.Param.self env);
 521         Glob.t
 522          (fun ({Glob.make} as glob) ->
 523                 Debug.Emit.t ~glob;
 524                 Link.Emit.t ~glob;
 525                 let t = fct ~glob in
 526                 t
 527          )