5.70. Get options
Start ocaml section to src/flx_getopt.mli[1
/1
]
1: # 4 "./lpsrc/flx_getopt.ipk"
2: open Flx_types
3:
4: val parse_option: string -> (string * string) list
5: val parse_options: string array -> (string * string) list
6:
7: val check_key_value :
8: (string * string) list ->
9: string-> string ->
10: bool
11:
12: val check_key:
13: (string * string) list ->
14: string ->
15: bool
16:
17: val check_keys:
18: (string * string) list ->
19: string list ->
20: bool
21:
22: val get_key_value :
23: (string * string) list ->
24: string ->
25: string option
26:
27: val get_key_values :
28: (string * string) list ->
29: string ->
30: string list
31:
32: val get_keys_values :
33: (string * string) list ->
34: string list ->
35: string list
36:
Start ocaml section to src/flx_getopt.ml[1
/1
]
1: # 41 "./lpsrc/flx_getopt.ipk"
2: open List
3: open Flx_util
4: open Flx_types
5:
6: let parse_option s =
7: let n = String.length s in
8: if n > 1 && s.[0]='-' then
9: if n > 2 && s.[1]='-' then
10: begin
11: let j = ref 2 in
12: while !j < n && s.[!j]<>'=' do incr j done;
13: let key = String.sub s 2 (!j - 2) in
14: let value =
15: if !j<n && s.[!j]='=' then
16: String.sub s (!j+1) (n - !j - 1)
17: else
18: ""
19: in
20: [key,value]
21: end
22: else
23: [String.sub s 1 1, String.sub s 2 (n-2)]
24: else ["",s]
25:
26: let parse_options argv =
27: concat (map parse_option (List.tl (Array.to_list argv)))
28:
29: let get_key_value options key =
30: catch_all (assoc key) options
31:
32: let check_key options key =
33: is_some (get_key_value options key)
34:
35: let check_keys options keys =
36: fold_left
37: (fun b key -> b || (check_key options key) )
38: false keys
39:
40: let check_key_value options key value =
41: let keyval = key,value in
42: let rec aux = function
43: | [] -> false
44: | h :: t -> if keyval = h then true else aux t
45: in aux options
46:
47: let get_key_values options key =
48: let values = ref [] in
49: let rec aux = function
50: | [] -> !values
51: | (key',value) :: t ->
52: if key=key' then values := value :: !values;
53: aux t
54: in rev (aux options)
55:
56: let get_keys_values options keys =
57: concat (map (get_key_values options) keys)
58:
Start ocaml section to src/flx_flxopt.mli[1
/1
]
1: # 99 "./lpsrc/flx_getopt.ipk"
2: open Flx_types
3: open Flx_mtypes2
4:
5: val get_felix_options:
6: (string * string) list ->
7: felix_compiler_options_t
8:
9: val make_syms:
10: felix_compiler_options_t -> sym_state_t
11:
12: val print_options:
13: unit -> unit
14:
15: val print_chosen:
16: (string * string) list ->
17: unit
18:
Start ocaml section to src/flx_flxopt.ml[1
/1
]
1: # 117 "./lpsrc/flx_getopt.ipk"
2: open Flx_types
3: open Flx_mtypes1
4: open Flx_mtypes2
5: open Flx_getopt
6:
7: let print_chosen options =
8: print_endline
9: (String.concat ", "
10: (List.map
11: (fun (a, b) ->
12: a ^ "=" ^ b
13: )
14: options
15: )
16: )
17:
18: let get_felix_options options =
19: {
20: elkhound =
21: begin match get_key_value options "elkhound" with
22: | Some s -> s
23: | None -> "flx_elkhound"
24: end
25: ;
26: optimise = check_keys options ["opt"; "optimise"];
27: debug = check_key options "debug";
28: with_comments = check_key options "with-comments";
29: mangle_names = check_key options "mangle-names";
30: include_dirs= get_keys_values options ["I"; "include"];
31: print_flag = check_keys options ["v"; "verbose"];
32: generate_axiom_checks = not (check_keys options ["no-check-axioms"]);
33: trace = check_keys options ["trace" ];
34: files = get_key_values options "";
35: raw_options = options;
36: reverse_return_parity = check_key options "e";
37: force_recompile = check_keys options ["force"];
38: max_inline_length =
39: begin
40: let inline =
41: match get_key_value options "inline" with
42: | Some i ->
43: (
44: if i = "none" then 0 else
45: if i = "" then 50 else
46: try
47: int_of_string i
48: with _ ->
49: failwith ("Invalid value for inline: '" ^ i^"'")
50: )
51: | None ->
52: begin match check_key options "noinline" with
53: | true -> 0
54: | false ->
55: begin match check_keys options ["inline";"opt";"optimise"] with
56: | true -> 50
57: | false -> 5
58: end
59: end
60: in
61: (* we need to at least inline a little for typeclasses *)
62: if inline < 1 then 1 else inline
63: end
64: ;
65: hash_include = get_key_values options "hash-include";
66: compile_only = check_keys options ["c";"compile-only"]
67: }
68:
69: let print_options () =
70: print_endline "options:";
71: print_endline " -h, --help : print this help";
72: print_endline " --version: print version info";
73: print_endline " -v, --verbose: print symbol table";
74: print_endline " -q, --quiet: no stdout";
75: print_endline " -c, --compile-only: no code generation";
76: print_endline " -Idir, --include=dir : append dir to include path";
77: print_endline " --inline, --noinline, --optimise";
78: print_endline " --force : force recompilation";
79: print_endline " --with-comments : generate code with comments";
80: print_endline " --mangle-names : generate code with fully mangled names";
81: print_endline " --elkhound=flx_elkhound : set pathname of elkhound executable"
82:
83: let make_syms options =
84: {
85: registry = Hashtbl.create 97;
86: counter = ref 1;
87: dfns = Hashtbl.create 97;
88: varmap = Hashtbl.create 97;
89: ticache = Hashtbl.create 97;
90: glr_cache = Hashtbl.create 97;
91: env_cache = Hashtbl.create 97;
92: compiler_options = options;
93: instances = Hashtbl.create 97;
94: include_files = ref [];
95: roots = ref IntSet.empty;
96: wrappers = Hashtbl.create 97;
97: lexers = Hashtbl.create 7;
98: parsers = Hashtbl.create 7;
99: quick_names = Hashtbl.create 97;
100: bifaces = [];
101: reductions = [];
102: axioms = [];
103: variant_map = Hashtbl.create 97;
104: typeclass_to_instance = Hashtbl.create 97;
105: instances_of_typeclass = Hashtbl.create 97;
106: transient_specialisation_cache = Hashtbl.create 97;
107: }
108:
109: