src/options.ml

   1 open Misc.ArgExt
   2
   3 let web_mode             = ref false
   4 let is_web_mode ()       = !web_mode
   5 let set_web_mode ()      = web_mode := true
   6
   7 let default_choice       = "default"
   8 let option_settings_step = "during option settings"
   9
  10 let language_from_string kind default s =
  11   try
  12     Languages.from_string s
  13   with Not_found ->
  14     if s = default_choice then
  15       default
  16     else
  17       Error.global_error option_settings_step
  18         (Printf.sprintf "`%s' is not a valid %s language." s kind)
  19
  20 let source_language_of_string   = language_from_string "source" Languages.Clight
  21 let source_language             = ref (source_language_of_string default_choice)
  22 let set_source_language s       = source_language := source_language_of_string s
  23 let get_source_language ()      = !source_language
  24
  25 let target_language_of_string   = language_from_string "target" Languages.ASM
  26 let target_language             = ref (target_language_of_string default_choice)
  27 let set_target_language s       = target_language := target_language_of_string s
  28 let get_target_language ()      = !target_language
  29
  30 let input_files                 = ref []
  31 let add_input_file f            = input_files := f :: !input_files
  32 let input_files ()              = !input_files
  33
  34 let output_files                = ref None
  35 let set_output_files s          = output_files := Some s
  36 let get_output_files ()         = !output_files
  37
  38 let annotation_flag             = ref false
  39 let request_annotation          = (:=) annotation_flag
  40 let annotation_requested ()     = !annotation_flag
  41
  42 let interpretation_flag         = ref false
  43 let request_interpretation      = (:=) interpretation_flag
  44 let interpretation_requested () = !interpretation_flag
  45
  46 let interpretations_flag         = ref false
  47 let request_interpretations      = (:=) interpretations_flag
  48 let interpretations_requested () = !interpretations_flag
  49
  50 let debug_flag                  = ref false
  51 let set_debug                   = (:=) debug_flag
  52 let is_debug_enabled ()         = !debug_flag
  53
  54 let asm_pretty_flag             = ref false
  55 let set_asm_pretty              = (:=) asm_pretty_flag
  56 let is_asm_pretty ()            = !asm_pretty_flag
  57
  58 let lustre_flag                 = ref false
  59 let set_lustre_file             = (:=) lustre_flag
  60 let is_lustre_file ()           = !lustre_flag
  61
  62 let remove_lustre_externals       = ref false
  63 let set_remove_lustre_externals   = (:=) remove_lustre_externals
  64 let is_remove_lustre_externals () = !remove_lustre_externals
  65
  66 let lustre_test                 = ref None
  67 let set_lustre_test s           = lustre_test := Some s
  68 let get_lustre_test ()          = !lustre_test
  69
  70 let lustre_test_cases           = ref 100
  71 let set_lustre_test_cases       = (:=) lustre_test_cases
  72 let get_lustre_test_cases ()    = !lustre_test_cases
  73
  74 let lustre_test_cycles          = ref 100
  75 let set_lustre_test_cycles      = (:=) lustre_test_cycles
  76 let get_lustre_test_cycles ()   = !lustre_test_cycles
  77
  78 let lustre_test_min_int         = ref (-1000)
  79 let set_lustre_test_min_int     = (:=) lustre_test_min_int
  80 let get_lustre_test_min_int ()  = !lustre_test_min_int
  81
  82 let lustre_test_max_int         = ref 1000
  83 let set_lustre_test_max_int     = (:=) lustre_test_max_int
  84 let get_lustre_test_max_int ()  = !lustre_test_max_int
  85
  86 (*
  87 let print_result_flag           = ref false
  88 let set_print_result            = (:=) print_result_flag
  89 let is_print_result_enabled ()  = !print_result_flag
  90 *)
  91
  92 let dev_test                    = ref false
  93 let set_dev_test                = (:=) dev_test
  94 let is_dev_test_enabled ()      = !dev_test
  95
  96 let options = OptionsParsing.register [
  97 (*
  98   "-s", Arg.String set_source_language,
  99   " Choose the source language between:";
 100   extra_doc " Clight, Cminor";
 101   extra_doc " [default is C]";
 102 *)
 103
 104   "-l", Arg.String set_target_language,
 105   " Choose the target language between:";
 106   extra_doc " Clight, Cminor, RTLabs, RTL, ERTL, LTL, LIN, ASM";
 107   extra_doc " [default is ASM]";
 108
 109   "-a", Arg.Set annotation_flag,
 110   " Add cost annotations on the source code.";
 111
 112   "-i", Arg.Set interpretation_flag,
 113   " Interpret the compiled code.";
 114
 115   "-is", Arg.Set interpretations_flag,
 116   " Interpret all the compilation passes.";
 117
 118   "-d", Arg.Set debug_flag,
 119   " Debug mode.";
 120   extra_doc " Outputs all the passes up to the target language.";
 121   extra_doc " Combined with an interpret option, shows the trace";
 122   extra_doc " of execution states.";
 123
 124   "-o", Arg.String set_output_files,
 125   " Prefix of the output files.";
 126
 127   "-asm-pretty", Arg.Set asm_pretty_flag,
 128   " Output a pretty-printed assembly file.";
 129
 130   "-lustre", Arg.Set lustre_flag,
 131   " Input file is a Lustre file.";
 132
 133   "-remove-lustre-externals", Arg.Set remove_lustre_externals,
 134   " Remove Lustre externals.";
 135
 136   "-lustre-test", Arg.String set_lustre_test,
 137   " Input file is a Lustre file, testing requested.";
 138
 139   "-lustre-test-cases", Arg.Int set_lustre_test_cases,
 140   " Set the number of test cases when testing a Lustre";
 141   extra_doc " file.";
 142   extra_doc " [default is 100]";
 143
 144   "-lustre-test-cycles", Arg.Int set_lustre_test_cycles,
 145   " Set the number of cycles for each case when testing";
 146   extra_doc " a Lustre file.";
 147   extra_doc " [default is 100]";
 148
 149   "-lustre-test-min-int", Arg.Int set_lustre_test_min_int,
 150   " Random int minimum value when testing a Lustre file.";
 151   extra_doc " [default is -1000]";
 152
 153   "-lustre-test-max-int", Arg.Int set_lustre_test_max_int,
 154   " Random int maximum value when testing a Lustre file.";
 155   extra_doc " [default is 1000]";
 156
 157 (*
 158   "-res", Arg.Set print_result_flag,
 159   " Print the result of interpretations.";
 160 *)
 161
 162   "-dev", Arg.Set dev_test,
 163   " Playground for developers.";
 164 ]