diff options
Diffstat (limited to 'bin/qsp_parser.ml')
-rw-r--r-- | bin/qsp_parser.ml | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml new file mode 100644 index 0000000..0026b73 --- /dev/null +++ b/bin/qsp_parser.ml @@ -0,0 +1,62 @@ +open StdLabels +module Report = Qsp_syntax.Report + +type result = Report.t list [@@deriving show] +type filters = { level : Report.level option } + +module Args = struct + let input_files = ref [] + let usage = "qsp_parser input_file" + let anon_fun filename = input_files := filename :: !input_files + let level_value = ref None + + let level : string -> unit = + fun str_level -> + match Report.level_of_string str_level with + | Ok level_ -> level_value := Some level_ + | Error e -> + print_endline e; + exit 1 + + let speclist = + [ ("--level", Arg.String level, "Message level [debug, warn, error]") ] + + let parse () = + let () = Arg.parse speclist anon_fun usage in + let filters = { level = !level_value } in + (!input_files, filters) +end + +(** Filter the results given by the analysis *) +let filter_report : filters -> Report.t list -> Report.t -> Report.t list = + fun filters reports r -> + let is_ok = + match filters.level with + | None -> true + | Some level -> Report.level_to_enum level >= Report.level_to_enum r.level + in + + match is_ok with true -> r :: reports | _ -> reports + +let () = + let file_names, filters = Args.parse () in + let file_name = List.hd file_names in + + let ic = Stdlib.open_in file_name in + let lexer = Lexing.from_channel ~with_positions:true ic in + let result = Qsp_parser.Analyzer.parse (module Qsp_syntax.Type_of) lexer in + match result with + | Ok f -> ( + let report = List.fold_left (f []) ~init:[] ~f:(filter_report filters) in + + (* Display the result *) + match report with + | [] -> exit 0 + | _ -> + Format.fprintf Format.std_formatter "Location %s@;%a@." file_name + pp_result report; + exit 1) + | Error e -> + Format.fprintf Format.std_formatter "\nError in location %s\n%a" file_name + Qsp_parser.Analyzer.format_error e; + exit 1 |