diff options
| -rw-r--r-- | bin/qsp_parser.ml | 26 | ||||
| -rw-r--r-- | lib/analyzer.ml | 5 | ||||
| -rw-r--r-- | lib/analyzer.mli | 2 | ||||
| -rw-r--r-- | lib/lexbuf.ml | 11 | ||||
| -rw-r--r-- | lib/lexbuf.mli | 2 | ||||
| -rw-r--r-- | test/qsp_parser_test.ml | 5 |
6 files changed, 34 insertions, 17 deletions
diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml index ffb1bd5..fb0c1c8 100644 --- a/bin/qsp_parser.ml +++ b/bin/qsp_parser.ml @@ -9,6 +9,7 @@ module Args = struct 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 -> @@ -19,12 +20,18 @@ module Args = struct exit 1 let speclist = - [ ("--level", Arg.String level, "Message level [debug, warn, error]") ] + [ + ("--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, filters) + (!input_files, !reset_line, filters) end (** Filter the results given by the analysis *) @@ -41,7 +48,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 : Sedlexing.lexbuf -> filters -> unit = +let parse_location : Qparser.Lexbuf.t -> filters -> unit = fun lexbuf filters -> let result = Qparser.Analyzer.parse (module Qsp_syntax.Type_of) lexbuf in @@ -56,17 +63,17 @@ let parse_location : Sedlexing.lexbuf -> filters -> unit = match report with | [] -> () | _ -> - let start_position, _ = Sedlexing.lexing_positions lexbuf in + let start_position, _ = Qparser.Lexbuf.positions lexbuf in Format.fprintf Format.std_formatter "Location %s@;@[%a@]@." start_position.Lexing.pos_fname pp_result report; ()) | Error e -> - let start_position, _ = Sedlexing.lexing_positions lexbuf in + let start_position, _ = Qparser.Lexbuf.positions lexbuf in Format.fprintf Format.std_formatter "Location %s@;@[%a]@." start_position.Lexing.pos_fname Report.pp e let () = - let file_names, filters = Args.parse () in + let file_names, reset_line, filters = Args.parse () in let file_name = List.hd file_names in let ic = Stdlib.open_in_bin file_name in @@ -78,6 +85,7 @@ let () = | ".txt" -> Sedlexing.Utf16.from_channel ic (Some Little_endian) | _ -> raise (Failure "unknown extension") in + let lexer = Qparser.Lexbuf.from_lexbuf ~reset_line lexer in let () = try @@ -87,6 +95,10 @@ let () = with Qparser.Lexer.EOF -> () in let () = - match Sys.os_type with "Win32" -> ignore @@ read_line () | _ -> () + match Sys.os_type with + | "Win32" -> + print_endline "Press <Enter> to terminate"; + ignore @@ read_line () + | _ -> () in () diff --git a/lib/analyzer.ml b/lib/analyzer.ml index 547b3da..7a64cab 100644 --- a/lib/analyzer.ml +++ b/lib/analyzer.ml @@ -5,14 +5,13 @@ *) let parse : (module Qsp_syntax.S.Analyzer with type Location.repr = 'a) -> - Sedlexing.lexbuf -> + Lexbuf.t -> ('a, Qsp_syntax.Report.t) Result.t = fun (type a) (module S : Qsp_syntax.S.Analyzer with type Location.repr = a) -> let module Parser = Parser.Make (S) in let module IncrementalParser = Interpreter.Interpreter (Parser.MenhirInterpreter) in - fun lexbuf -> - let l = Lexbuf.from_lexbuf lexbuf in + fun l -> let lexer = Lexbuf.tokenize Lexer.token l in let init = Parser.Incremental.main (fst (Lexbuf.positions l)) in diff --git a/lib/analyzer.mli b/lib/analyzer.mli index d79ea76..30b6625 100644 --- a/lib/analyzer.mli +++ b/lib/analyzer.mli @@ -1,6 +1,6 @@ val parse : (module Qsp_syntax.S.Analyzer with type Location.repr = 'a) -> - Sedlexing.lexbuf -> + Lexbuf.t -> ('a, Qsp_syntax.Report.t) Result.t (** Read the source and build a analyzis over it. diff --git a/lib/lexbuf.ml b/lib/lexbuf.ml index 6059c8a..3f0b186 100644 --- a/lib/lexbuf.ml +++ b/lib/lexbuf.ml @@ -2,6 +2,7 @@ type t = { buffer : Sedlexing.lexbuf; mutable start_p : Lexing.position option; mutable expression_level : int; + reset_line : bool; } let buffer : t -> Sedlexing.lexbuf = fun t -> t.buffer @@ -9,7 +10,10 @@ let buffer : t -> Sedlexing.lexbuf = fun t -> t.buffer let start : t -> unit = fun t -> let _start_pos, end_pos = Sedlexing.lexing_positions t.buffer in - Sedlexing.set_position t.buffer { end_pos with Lexing.pos_lnum = 1 }; + let () = + if not t.reset_line then + Sedlexing.set_position t.buffer { end_pos with Lexing.pos_lnum = 1 } + in t.start_p <- None; t.expression_level <- 0 @@ -18,8 +22,9 @@ let positions : t -> Lexing.position * Lexing.position = let content : t -> string = fun t -> Sedlexing.Utf8.lexeme t.buffer -let from_lexbuf : Sedlexing.lexbuf -> t = - fun t -> { buffer = t; start_p = None; expression_level = 0 } +let from_lexbuf : ?reset_line:bool -> Sedlexing.lexbuf -> t = + fun ?(reset_line = true) t -> + { buffer = t; start_p = None; expression_level = 0; reset_line } let set_start_position : t -> Lexing.position -> unit = fun t position -> t.start_p <- Some position diff --git a/lib/lexbuf.mli b/lib/lexbuf.mli index 918c011..41f07d1 100644 --- a/lib/lexbuf.mli +++ b/lib/lexbuf.mli @@ -1,6 +1,6 @@ type t -val from_lexbuf : Sedlexing.lexbuf -> t +val from_lexbuf : ?reset_line:bool -> Sedlexing.lexbuf -> t (** Create a new buffer *) val start : t -> unit diff --git a/test/qsp_parser_test.ml b/test/qsp_parser_test.ml index d827099..652ef75 100644 --- a/test/qsp_parser_test.ml +++ b/test/qsp_parser_test.ml @@ -10,8 +10,9 @@ type 'a location = 'a * 'a Ast.statement list [@@deriving eq, show] (** Run the parser with the given expression and return the result *) let parse : string -> T.pos location = fun content -> - let lexing = Sedlexing.Latin1.from_string content in - + let lexing = + Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf + in match Qparser.Analyzer.parse (module Qsp_syntax.Tree) lexing with | Ok e -> e | Error e -> |