aboutsummaryrefslogtreecommitdiff
path: root/bin/qsp_parser.ml
diff options
context:
space:
mode:
Diffstat (limited to 'bin/qsp_parser.ml')
-rw-r--r--bin/qsp_parser.ml63
1 files changed, 16 insertions, 47 deletions
diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index 32e7a2f..8fb7189 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -2,46 +2,9 @@ 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 reset_line = ref false
-
- 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 =
- [
- ( "--version",
- Arg.Unit
- (fun () ->
- Printf.printf "Version %s\n" Tools.Git_hash.revision;
- exit 0),
- "Display the version of the application and exit" );
- ("--level", Arg.String level, "Message level [debug, warn, error]");
- ( "--global",
- Arg.Set reset_line,
- "Each line is refered from the begining of the file and not the \
- location" );
- ]
-
- let parse () =
- let () = Arg.parse speclist anon_fun usage in
- let filters = { level = !level_value } in
- (!input_files, !reset_line, filters)
-end
(** Filter the results given by the analysis *)
-let filter_report : filters -> Report.t list -> Report.t -> Report.t list =
+let filter_report : Args.filters -> Report.t list -> Report.t -> Report.t list =
fun filters reports r ->
let is_ok =
match filters.level with
@@ -54,7 +17,7 @@ let filter_report : filters -> Report.t list -> Report.t -> Report.t list =
(** 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 -> filters -> unit =
+let parse_location : Qparser.Lexbuf.t -> Args.filters -> unit =
fun lexbuf filters ->
let result = Qparser.Analyzer.parse (module Qsp_syntax.Type_of) lexbuf in
@@ -79,30 +42,36 @@ let parse_location : Qparser.Lexbuf.t -> filters -> unit =
start_position.Lexing.pos_fname Report.pp e
let () =
- let file_names, reset_line, filters = Args.parse () in
+ let file_names, parameters = Args.parse () in
let file_name = List.hd file_names in
let ic = Stdlib.open_in_bin file_name in
(*let lexer = Lexing.from_channel ~with_positions:true ic in*)
- let lexer =
+ let lexer, parameters =
match Filename.extension file_name with
- | ".qsrc" -> Sedlexing.Utf8.from_channel ic
- | ".txt" -> Sedlexing.Utf16.from_channel ic (Some Little_endian)
+ | ".qsrc" ->
+ (* The source file are in UTF-8, and we can use the file line number as
+ we have only a single location. *)
+ (Sedlexing.Utf8.from_channel ic, { parameters with reset_line = false })
+ | ".txt" ->
+ (Sedlexing.Utf16.from_channel ic (Some Little_endian), parameters)
| _ -> raise (Failure "unknown extension")
in
- let lexer = Qparser.Lexbuf.from_lexbuf ~reset_line lexer in
+ let lexer =
+ Qparser.Lexbuf.from_lexbuf ~reset_line:parameters.reset_line lexer
+ in
let () =
try
while true do
- parse_location lexer filters
+ parse_location lexer parameters.filters
done
with Qparser.Lexer.EOF -> ()
in
let () =
- match Sys.os_type with
- | "Win32" ->
+ match parameters.interractive with
+ | true ->
print_endline "Press <Enter> to terminate";
ignore @@ read_line ()
| _ -> ()