5.60. 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: 
End ocaml section to src/flx_getopt.mli[1]
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: 
End ocaml section to src/flx_getopt.ml[1]
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: 
End ocaml section to src/flx_flxopt.mli[1]
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 match get_key_value options "inline" with
    40:       | Some i ->
    41:         (
    42:           if i = "none" then 0 else
    43:           if i = "" then 50 else
    44:           try int_of_string i
    45:           with _ ->
    46:             failwith ("Invalid value for inline: '" ^ i^"'")
    47:         )
    48:       | None ->
    49:       begin match check_key options "noinline" with
    50:       | true -> 0
    51:       | false ->
    52:       begin match check_keys options ["inline";"opt";"optimise"] with
    53:       | true -> 50
    54:       | false -> 5
    55:       end
    56:       end
    57:       end
    58:     ;
    59:     compile_only = check_keys options ["c";"compile-only"]
    60:   }
    61: 
    62: let print_options () =
    63:   print_endline "options:";
    64:   print_endline "  -h, --help : print this help";
    65:   print_endline "  --version: print version info";
    66:   print_endline "  -v, --verbose: print symbol table";
    67:   print_endline "  -q, --quiet: no stdout";
    68:   print_endline "  -c, --compile-only: no code generation";
    69:   print_endline "  -Idir, --include=dir : append dir to include path";
    70:   print_endline "  --inline, --noinline, --optimise";
    71:   print_endline "  --force : force recompilation";
    72:   print_endline "  --with-comments : generate code with comments";
    73:   print_endline "  --mangle-names : generate code with fully mangled names";
    74:   print_endline "  --elkhound=flx_elkhound : set pathname of elkhound executable"
    75: 
    76: let make_syms options =
    77:   {
    78:     registry = Hashtbl.create 97;
    79:     counter = ref 1;
    80:     dfns = Hashtbl.create 97;
    81:     varmap = Hashtbl.create 97;
    82:     ticache = Hashtbl.create 97;
    83:     glr_cache = Hashtbl.create 97;
    84:     env_cache = Hashtbl.create 97;
    85:     compiler_options = options;
    86:     instances = Hashtbl.create 97;
    87:     include_files = ref [];
    88:     roots = ref IntSet.empty;
    89:     wrappers = Hashtbl.create 97;
    90:     lexers = Hashtbl.create 7;
    91:     parsers = Hashtbl.create 7;
    92:     quick_names = Hashtbl.create 97;
    93:     bifaces = [];
    94:     reductions = [];
    95:     axioms = [];
    96:     variant_map = Hashtbl.create 97;
    97:   }
    98: 
    99: 
End ocaml section to src/flx_flxopt.ml[1]