diff options
Diffstat (limited to 'bin/qsp_parser.ml')
| -rw-r--r-- | bin/qsp_parser.ml | 32 |
1 files changed, 26 insertions, 6 deletions
diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml index 8fb7189..6a6b772 100644 --- a/bin/qsp_parser.ml +++ b/bin/qsp_parser.ml @@ -14,11 +14,13 @@ let filter_report : Args.filters -> Report.t list -> Report.t -> Report.t list = match is_ok with true -> r :: reports | _ -> reports +type ctx = { error_nb : int; warn_nb : int; debug_nb : int } + (** Read the source file until getting a report (the whole location has been read properly), or until the first syntax error. *) -let parse_location : Qparser.Lexbuf.t -> Args.filters -> unit = - fun lexbuf filters -> +let parse_location : ctx:ctx -> Qparser.Lexbuf.t -> Args.filters -> ctx = + fun ~ctx lexbuf filters -> let result = Qparser.Analyzer.parse (module Qsp_syntax.Type_of) lexbuf in let result = @@ -30,16 +32,24 @@ let parse_location : Qparser.Lexbuf.t -> Args.filters -> unit = | Ok report -> ( (* Display the result *) match report with - | [] -> () + | [] -> ctx | _ -> let start_position, _ = Qparser.Lexbuf.positions lexbuf in Format.fprintf Format.std_formatter "Location@ %s@;@[%a@]@." start_position.Lexing.pos_fname pp_result report; - ()) + + List.fold_left report ~init:ctx ~f:(fun ctx report -> + match report.Report.level with + | Error -> { ctx with error_nb = ctx.error_nb + 1 } + | Warn -> { ctx with warn_nb = ctx.warn_nb + 1 } + | Debug -> { ctx with warn_nb = ctx.debug_nb + 1 })) | Error e -> let start_position, _ = Qparser.Lexbuf.positions lexbuf in Format.fprintf Format.std_formatter "Location@ %s@;@[%a]@." - start_position.Lexing.pos_fname Report.pp e + start_position.Lexing.pos_fname Report.pp e; + { ctx with error_nb = ctx.error_nb + 1 } + +let default_ctx = { error_nb = 0; warn_nb = 0; debug_nb = 0 } let () = let file_names, parameters = Args.parse () in @@ -62,13 +72,23 @@ let () = Qparser.Lexbuf.from_lexbuf ~reset_line:parameters.reset_line lexer in + let ctx = ref default_ctx in let () = try while true do - parse_location lexer parameters.filters + ctx := parse_location ~ctx:!ctx lexer parameters.filters done with Qparser.Lexer.EOF -> () in + + let () = + match (!ctx.error_nb, !ctx.warn_nb) with + | 0, 0 -> print_endline "No errors found" + | _ -> + Printf.printf "Found %d error(s), %d warning(s)\n" !ctx.error_nb + !ctx.warn_nb + in + let () = match parameters.interractive with | true -> |