svn did not add these files during previous merge.
git-svn-id: http://caml.inria.fr/svn/ocaml/branches/extension_points@13921 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02master
Alain Frisch
parent
411eb41b42
commit
2c93b42c38
|
|
@ -0,0 +1,343 @@
|
|||
(***********************************************************************)
|
||||
(* *)
|
||||
(* OCaml *)
|
||||
(* *)
|
||||
(* Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt *)
|
||||
(* *)
|
||||
(* Copyright 2013 Institut National de Recherche en Informatique et *)
|
||||
(* en Automatique. All rights reserved. This file is distributed *)
|
||||
(* under the terms of the Q Public License version 1.0. *)
|
||||
(* *)
|
||||
(***********************************************************************)
|
||||
|
||||
open Clflags
|
||||
|
||||
let output_prefix name =
|
||||
let oname =
|
||||
match !output_name with
|
||||
| None -> name
|
||||
| Some n -> if !compile_only then (output_name := None; n) else name in
|
||||
Misc.chop_extension_if_any oname
|
||||
|
||||
let print_version_and_library compiler =
|
||||
Printf.printf "The OCaml %s, version " compiler;
|
||||
print_string Config.version; print_newline();
|
||||
print_string "Standard library directory: ";
|
||||
print_string Config.standard_library; print_newline();
|
||||
exit 0
|
||||
|
||||
let print_version_string () =
|
||||
print_string Config.version; print_newline(); exit 0
|
||||
|
||||
let print_standard_library () =
|
||||
print_string Config.standard_library; print_newline(); exit 0
|
||||
|
||||
let fatal err =
|
||||
prerr_endline err;
|
||||
exit 2
|
||||
|
||||
let extract_output = function
|
||||
| Some s -> s
|
||||
| None ->
|
||||
fatal "Please specify the name of the output file, using option -o"
|
||||
|
||||
let default_output = function
|
||||
| Some s -> s
|
||||
| None -> Config.default_executable_name
|
||||
|
||||
(* Initialize the search path.
|
||||
The current directory is always searched first,
|
||||
then the directories specified with the -I option (in command-line order),
|
||||
then the standard library directory (unless the -nostdlib option is given).
|
||||
*)
|
||||
|
||||
let implicit_modules = ref []
|
||||
let first_include_dirs = ref []
|
||||
let last_include_dirs = ref []
|
||||
let first_ccopts = ref []
|
||||
let last_ccopts = ref []
|
||||
let first_ppx = ref []
|
||||
let last_ppx = ref []
|
||||
let first_objfiles = ref []
|
||||
let last_objfiles = ref []
|
||||
|
||||
(* Note: this function is duplicated in optcompile.ml *)
|
||||
let check_unit_name ppf filename name =
|
||||
try
|
||||
begin match name.[0] with
|
||||
| 'A'..'Z' -> ()
|
||||
| _ ->
|
||||
Location.print_warning (Location.in_file filename) ppf
|
||||
(Warnings.Bad_module_name name);
|
||||
raise Exit;
|
||||
end;
|
||||
for i = 1 to String.length name - 1 do
|
||||
match name.[i] with
|
||||
| 'A'..'Z' | 'a'..'z' | '0'..'9' | '_' | '\'' -> ()
|
||||
| _ ->
|
||||
Location.print_warning (Location.in_file filename) ppf
|
||||
(Warnings.Bad_module_name name);
|
||||
raise Exit;
|
||||
done;
|
||||
with Exit -> ()
|
||||
;;
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
type readenv_position =
|
||||
Before_args | Before_compile | Before_link
|
||||
|
||||
(* Syntax of OCAMLCOMPPARAM: (name=VALUE)(,name=VALUE)* where
|
||||
VALUE=expression without ,
|
||||
*)
|
||||
exception SyntaxError of string
|
||||
|
||||
(*
|
||||
let parse_args s =
|
||||
let len = String.length s in
|
||||
let rec iter0 i pos0 =
|
||||
if i = len then
|
||||
if i = pos0 then []
|
||||
else raise (SyntaxError "End of line while expecting char '='")
|
||||
else
|
||||
let c = s.[i] in
|
||||
let pos1 = i+1 in
|
||||
if c = '=' then
|
||||
iter1 pos1 pos1 (String.sub s pos0 (i-pos0))
|
||||
else iter0 pos1 pos0
|
||||
|
||||
and iter1 i pos0 name =
|
||||
if i = len then [name, ""]
|
||||
else
|
||||
let c = s.[i] in
|
||||
let pos1 = i+1 in
|
||||
match c with
|
||||
'"' ->
|
||||
iter3 pos1 (Buffer.create 50) name
|
||||
| ',' ->
|
||||
(name, "") :: iter0 pos1 pos1
|
||||
| _ ->
|
||||
iter2 pos1 pos0 name
|
||||
|
||||
and iter2 i pos0 name =
|
||||
if i = len then [name, String.sub s pos0 (len-pos0)]
|
||||
else
|
||||
let pos1 = i+1 in
|
||||
match s.[i] with
|
||||
| ',' ->
|
||||
(name, String.sub s pos0 (i-pos0)) :: iter0 pos1 pos1
|
||||
| _ -> iter2 pos1 pos0 name
|
||||
|
||||
and iter3 i b name =
|
||||
if i = len then
|
||||
raise (SyntaxError "End of line while expecting '\"'")
|
||||
else
|
||||
let pos1 = i+1 in
|
||||
match s.[i] with
|
||||
| '"' ->
|
||||
if pos1 = len then
|
||||
[name, Buffer.contents b]
|
||||
else begin
|
||||
let pos2 = pos1+1 in
|
||||
match s.[pos1] with
|
||||
| '"' ->
|
||||
Buffer.add_char b '"';
|
||||
iter3 pos2 b name
|
||||
| ',' ->
|
||||
(name, Buffer.contents b) :: iter0 pos2 pos2
|
||||
| _ ->
|
||||
raise (SyntaxError "Syntax error while expecting ',' after '\"'")
|
||||
end
|
||||
| c ->
|
||||
Buffer.add_char b c;
|
||||
iter3 pos1 b name
|
||||
|
||||
in
|
||||
iter0 0 0
|
||||
*)
|
||||
|
||||
let parse_args s =
|
||||
let args = Misc.split s ',' in
|
||||
let rec iter is_after args before after =
|
||||
match args with
|
||||
[] ->
|
||||
if not is_after then
|
||||
raise (SyntaxError "no '_' separator found")
|
||||
else
|
||||
(List.rev before, List.rev after)
|
||||
| "_" :: _ when is_after -> raise (SyntaxError "too many '_' separators")
|
||||
| "_" :: tail -> iter true tail before after
|
||||
| arg :: tail ->
|
||||
let binding = try
|
||||
Misc.cut_at arg '='
|
||||
with Not_found ->
|
||||
raise (SyntaxError ("missing '=' in " ^ arg))
|
||||
in
|
||||
if is_after then
|
||||
iter is_after tail before (binding :: after)
|
||||
else
|
||||
iter is_after tail (binding :: before) after
|
||||
in
|
||||
iter false args [] []
|
||||
|
||||
let setter f name options s =
|
||||
try
|
||||
let bool = match s with
|
||||
| "0" -> false
|
||||
| "1" -> true
|
||||
| _ -> raise Not_found
|
||||
in
|
||||
List.iter (fun b -> b := f bool) options
|
||||
with Not_found ->
|
||||
Printf.eprintf "Warning: bad value for %S in OCAMLPARAM\n%!" name
|
||||
|
||||
let set name options s =
|
||||
setter (fun b -> b) name options s
|
||||
|
||||
let clear name options s =
|
||||
setter (fun b -> not b) name options s
|
||||
|
||||
let read_OCAMLPARAM position =
|
||||
try
|
||||
let s = Sys.getenv "OCAMLPARAM" in
|
||||
let (before, after) =
|
||||
try
|
||||
parse_args s
|
||||
with SyntaxError s ->
|
||||
fatal (Printf.sprintf "Illegal syntax of OCAMLPARAM: %s" s)
|
||||
in
|
||||
List.iter (fun (name, v) ->
|
||||
match name with
|
||||
|
||||
| "g" -> set "g" [ Clflags.debug ] v
|
||||
| "p" -> set "p" [ Clflags.gprofile ] v
|
||||
| "bin-annot" -> set "bin-annot" [ Clflags.binary_annotations ] v
|
||||
| "annot" -> set "annot" [ Clflags.annotations ] v
|
||||
| "absname" -> set "absname" [ Location.absname ] v
|
||||
| "compat-32" -> set "compat-32" [ bytecode_compatible_32 ] v
|
||||
| "noassert" -> set "noassert" [ noassert ] v
|
||||
| "noautolink" -> set "noautolink" [ no_auto_link ] v
|
||||
| "nostdlib" -> set "nostdlib" [ no_std_include ] v
|
||||
| "linkall" -> set "linkall" [ link_everything ] v
|
||||
| "nolabels" -> set "nolabels" [ classic ] v
|
||||
| "principal" -> set "principal" [ principal ] v
|
||||
| "rectypes" -> set "rectypes" [ recursive_types ] v
|
||||
| "strict-sequence" -> set "strict-sequence" [ strict_sequence ] v
|
||||
| "thread" -> set "thread" [ use_threads ] v
|
||||
| "unsafe" -> set "unsafe" [ fast ] v
|
||||
| "verbose" -> set "verbose" [ verbose ] v
|
||||
| "nopervasives" -> set "nopervasives" [ nopervasives ] v
|
||||
| "slash" -> set "slash" [ force_slash ] v (* for ocamldep *)
|
||||
|
||||
| "compact" -> clear "compact" [ optimize_for_speed ] v
|
||||
| "no-app-funct" -> clear "no-app-funct" [ applicative_functors ] v
|
||||
| "nodynlink" -> clear "nodynlink" [ dlcode ] v
|
||||
| "short-paths" -> clear "short-paths" [ real_paths ] v
|
||||
|
||||
| "pp" -> preprocessor := Some v
|
||||
| "runtime-variant" -> runtime_variant := v
|
||||
| "open" -> implicit_modules := Misc.split v ','
|
||||
| "cc" -> c_compiler := Some v
|
||||
|
||||
(* assembly sources *)
|
||||
| "s" ->
|
||||
set "s" [ Clflags.keep_asm_file ; Clflags.keep_startup_file ] v
|
||||
| "S" -> set "S" [ Clflags.keep_asm_file ] v
|
||||
| "dstartup" -> set "dstartup" [ Clflags.keep_startup_file ] v
|
||||
|
||||
(* warn-errors *)
|
||||
| "we" | "warn-error" -> Warnings.parse_options true v
|
||||
(* warnings *)
|
||||
| "w" -> Warnings.parse_options false v
|
||||
(* warn-errors *)
|
||||
| "wwe" -> Warnings.parse_options false v
|
||||
|
||||
(* inlining *)
|
||||
| "inline" -> begin try
|
||||
inline_threshold := 8 * int_of_string v
|
||||
with _ ->
|
||||
Printf.eprintf
|
||||
"Warning: discarding non integer value of inline from OCAMLCOMPPARAM\n%!"
|
||||
end
|
||||
|
||||
| "intf-suffix" -> Config.interface_suffix := v
|
||||
|
||||
| "I" -> begin
|
||||
match position with
|
||||
| Before_args -> first_include_dirs := v :: !first_include_dirs
|
||||
| Before_link | Before_compile ->
|
||||
last_include_dirs := v :: !last_include_dirs
|
||||
end
|
||||
|
||||
| "cclib" ->
|
||||
begin
|
||||
match position with
|
||||
| Before_compile -> ()
|
||||
| Before_link | Before_args ->
|
||||
ccobjs := Misc.rev_split_words v @ !ccobjs
|
||||
end
|
||||
|
||||
| "ccopts" ->
|
||||
begin
|
||||
match position with
|
||||
| Before_link | Before_compile ->
|
||||
last_ccopts := v :: !last_ccopts
|
||||
| Before_args ->
|
||||
first_ccopts := v :: !first_ccopts
|
||||
end
|
||||
|
||||
| "ppx" ->
|
||||
begin
|
||||
match position with
|
||||
| Before_link | Before_compile ->
|
||||
last_ppx := v :: !last_ppx
|
||||
| Before_args ->
|
||||
first_ppx := v :: !first_ppx
|
||||
end
|
||||
|
||||
|
||||
| "cmo" | "cma" ->
|
||||
if not !native_code then
|
||||
begin
|
||||
match position with
|
||||
| Before_link | Before_compile ->
|
||||
last_objfiles := v ::! last_objfiles
|
||||
| Before_args ->
|
||||
first_objfiles := v :: !first_objfiles
|
||||
end
|
||||
|
||||
| "cmx" | "cmxa" ->
|
||||
if !native_code then
|
||||
begin
|
||||
match position with
|
||||
| Before_link | Before_compile ->
|
||||
last_objfiles := v ::! last_objfiles
|
||||
| Before_args ->
|
||||
first_objfiles := v :: !first_objfiles
|
||||
end
|
||||
|
||||
| _ ->
|
||||
Printf.eprintf
|
||||
"Warning: discarding value of variable %S in OCAMLCOMPPARAM\n%!"
|
||||
name
|
||||
) (match position with
|
||||
Before_args -> before
|
||||
| Before_compile | Before_link -> after)
|
||||
with Not_found -> ()
|
||||
|
||||
let readenv position =
|
||||
last_include_dirs := [];
|
||||
last_ccopts := [];
|
||||
last_ppx := [];
|
||||
last_objfiles := [];
|
||||
read_OCAMLPARAM position;
|
||||
all_ccopts := !last_ccopts @ !first_ccopts;
|
||||
all_ppx := !last_ppx @ !first_ppx
|
||||
|
||||
let get_objfiles () =
|
||||
List.rev (!last_objfiles @ !objfiles @ !first_objfiles)
|
||||
|
||||
|
|
@ -0,0 +1,36 @@
|
|||
(***********************************************************************)
|
||||
(* *)
|
||||
(* OCaml *)
|
||||
(* *)
|
||||
(* Fabrice Le Fessant, EPI Gallium, INRIA Paris-Rocquencourt *)
|
||||
(* *)
|
||||
(* Copyright 2013 Institut National de Recherche en Informatique et *)
|
||||
(* en Automatique. All rights reserved. This file is distributed *)
|
||||
(* under the terms of the Q Public License version 1.0. *)
|
||||
(* *)
|
||||
(***********************************************************************)
|
||||
|
||||
val check_unit_name : Format.formatter -> string -> string -> unit
|
||||
|
||||
val output_prefix : string -> string
|
||||
val extract_output : string option -> string
|
||||
val default_output : string option -> string
|
||||
|
||||
val print_version_and_library : string -> 'a
|
||||
val print_version_string : unit -> 'a
|
||||
val print_standard_library : unit -> 'a
|
||||
val fatal : string -> 'a
|
||||
|
||||
val first_ccopts : string list ref
|
||||
val first_ppx : string list ref
|
||||
val first_include_dirs : string list ref
|
||||
val last_include_dirs : string list ref
|
||||
val implicit_modules : string list ref
|
||||
|
||||
(* return the list of objfiles, after OCAMLPARAM and List.rev *)
|
||||
val get_objfiles : unit -> string list
|
||||
|
||||
type readenv_position =
|
||||
Before_args | Before_compile | Before_link
|
||||
|
||||
val readenv : readenv_position -> unit
|
||||
Loading…
Reference in New Issue