aboutsummaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
Diffstat (limited to 'bin')
-rw-r--r--bin/dune7
-rw-r--r--bin/main.ml57
2 files changed, 60 insertions, 4 deletions
diff --git a/bin/dune b/bin/dune
index 36f9b41..697402f 100644
--- a/bin/dune
+++ b/bin/dune
@@ -3,4 +3,9 @@
(name main)
(libraries
qsp_syntax
- qsp_parser))
+ qsp_parser)
+
+ (preprocess (pps
+ ppx_deriving.show
+ ppx_deriving.eq )))
+
diff --git a/bin/main.ml b/bin/main.ml
index 1e8ff45..0026b73 100644
--- a/bin/main.ml
+++ b/bin/main.ml
@@ -1,10 +1,61 @@
+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_name = Sys.argv.(1) in
+ 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.Tree) lexer in
+ let result = Qsp_parser.Analyzer.parse (module Qsp_syntax.Type_of) lexer in
match result with
- | Ok _ -> exit 0
+ | 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;