diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/qparser/analyzer.ml | 80 | ||||
| -rw-r--r-- | lib/qparser/analyzer.mli | 4 | ||||
| -rw-r--r-- | lib/qparser/lexbuf.ml | 15 | ||||
| -rw-r--r-- | lib/qparser/lexbuf.mli | 9 | ||||
| -rw-r--r-- | lib/qparser/lexer.ml | 4 | ||||
| -rw-r--r-- | lib/syntax/S.ml | 6 |
6 files changed, 82 insertions, 36 deletions
diff --git a/lib/qparser/analyzer.ml b/lib/qparser/analyzer.ml index 6d09021..7d9b7d2 100644 --- a/lib/qparser/analyzer.ml +++ b/lib/qparser/analyzer.ml @@ -1,16 +1,18 @@ +type 'a result = { content : 'a; report : Qsp_syntax.Report.t list } + (** Run the QSP parser and apply the analyzer over it. See [syntax/S] *) -let parse : +let rec parse : type a context. (module Qsp_syntax.S.Analyzer with type Location.t = a and type context = context) -> Lexbuf.t -> context -> - (a * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) Result.t = + (a result, Qsp_syntax.Report.t) Result.t = fun (module S : Qsp_syntax.S.Analyzer with type Location.t = a and type context = context) -> @@ -41,33 +43,53 @@ let parse : Error err in - (* Then apply the checks over the result of the parsing *) - evaluation - |> Result.map (fun r -> - let r' = r context in - (r', S.Location.v r')) - |> Result.map_error (fun e -> - let message = - match e.IncrementalParser.code with - | Interpreter.InvalidSyntax -> "Invalid Syntax" - | Interpreter.UnrecoverableError -> "UnrecoverableError" - | Interpreter.Custom msg -> msg - | Interpreter.MenhirCode c -> - let message_content = - try Parser_messages.message c - with Not_found -> - String.concat "" [ "(Error code "; string_of_int c; ")" ] - in + (* Then evaluate the result *) + match (evaluation, Lexbuf.is_recovery l) with + | Ok r, _ -> + (* We have been able to read the syntax, apply the checkers over the + Tree *) + let content = r context in + Ok { content; report = S.Location.v content } + | _, true -> + (* This pattern can occur after recovering from an error. The + application attempt to start from a clean state in the next + location, but may fail to detect the correct position. If so, we + just start again until we hook the next location *) + parse (module S) l context + | Error e, _ -> + let message = + match e.IncrementalParser.code with + | Interpreter.UnrecoverableError -> "UnrecoverableError" + | Interpreter.InvalidSyntax -> "Invalid Syntax" + | Interpreter.Custom msg -> msg + | Interpreter.MenhirCode c -> + let message_content = + try Parser_messages.message c + with Not_found -> + String.concat "" [ "(Error code "; string_of_int c; ")" ] + in + String.concat "" [ String.trim message_content ] + in + + let report = Qsp_syntax.Report.error (e.start_pos, e.end_pos) message in + (* Rollback the buffer from the latest errror before discarding until + the end of the location. This ensure we will read the marker + for the end location in the case the error was actually in + this line itsef. + + Example : + + # location + <ERROR HERE> - String.concat "" [ String.trim @@ message_content ] - in - let report = - Qsp_syntax.Report.error (e.start_pos, e.end_pos) message - in + ! ------- a + --- location --------------------------------- + *) + Lexbuf.rollback l; - (* Discard the remaining file to read. The parser is now in a blank - state, it does not make sense to keep feeding it with the new - tokens. *) - let () = try Lexer.discard l with _ -> () in + (* Discard the remaining file to read. The parser is now in a blank + state, it does not make sense to keep feeding it with the new + tokens. *) + let () = try Lexer.discard l with _ -> () in - report) + Error report diff --git a/lib/qparser/analyzer.mli b/lib/qparser/analyzer.mli index 8033601..949db16 100644 --- a/lib/qparser/analyzer.mli +++ b/lib/qparser/analyzer.mli @@ -1,10 +1,12 @@ +type 'a result = { content : 'a; report : Qsp_syntax.Report.t list } + val parse : (module Qsp_syntax.S.Analyzer with type Location.t = 'a and type context = 'context) -> Lexbuf.t -> 'context -> - ('a * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) Result.t + ('a result, Qsp_syntax.Report.t) Result.t (** Read the source and build a analyzis over it. This method make the link between the source file and how to read it diff --git a/lib/qparser/lexbuf.ml b/lib/qparser/lexbuf.ml index 1d93f67..afc3bac 100644 --- a/lib/qparser/lexbuf.ml +++ b/lib/qparser/lexbuf.ml @@ -5,6 +5,7 @@ type t = { mutable start_p : Lexing.position option; state : state Stack.t; reset_line : bool; + mutable recovering : bool; } and lexer = t -> Tokens.token @@ -50,7 +51,8 @@ let start : t -> unit = Sedlexing.set_position t.buffer { end_pos with Lexing.pos_lnum = 1 } in Stack.clear t.state; - t.start_p <- None + t.start_p <- None; + t.recovering <- false let positions : t -> Lexing.position * Lexing.position = fun t -> @@ -62,7 +64,13 @@ let content : t -> string = fun t -> Sedlexing.Utf8.lexeme t.buffer let from_lexbuf : ?reset_line:bool -> Sedlexing.lexbuf -> t = fun ?(reset_line = true) t -> - { buffer = t; start_p = None; reset_line; state = Stack.create () } + { + buffer = t; + start_p = None; + reset_line; + state = Stack.create (); + recovering = false; + } let set_start_position : t -> Lexing.position -> unit = fun t position -> @@ -97,3 +105,6 @@ let overlay : t -> lexer -> lexer = match layer with | String wraper | EndString wraper -> wraper.start_string acc | _ -> acc) + +let start_recovery : t -> unit = fun t -> t.recovering <- true +let is_recovery : t -> bool = fun t -> t.recovering diff --git a/lib/qparser/lexbuf.mli b/lib/qparser/lexbuf.mli index f9812a7..4283db1 100644 --- a/lib/qparser/lexbuf.mli +++ b/lib/qparser/lexbuf.mli @@ -7,7 +7,7 @@ val from_lexbuf : ?reset_line:bool -> Sedlexing.lexbuf -> t (** Create a new buffer *) val start : t -> unit -(** Intialize a new run *) +(** Intialize a new run. *) val buffer : t -> Sedlexing.lexbuf (** Extract the sedlex buffer. Required in each rule. *) @@ -82,3 +82,10 @@ val leave_state : t -> unit (** Leave the current state *) val overlay : t -> lexer -> lexer + +val start_recovery : t -> unit +(** Set the lexer in recovery mode, the lexer raise this mode after an error, + in order to ignore the further errors until a new location *) + +val is_recovery : t -> bool +(** Check if the lexer is in recovery mode *) diff --git a/lib/qparser/lexer.ml b/lib/qparser/lexer.ml index 5c093b1..e3524cc 100644 --- a/lib/qparser/lexer.ml +++ b/lib/qparser/lexer.ml @@ -277,6 +277,7 @@ let main buffer = parser buffer let rec discard buffer = + let () = Lexbuf.start_recovery buffer in let lexbuf = Lexbuf.buffer buffer in match%sedlex lexbuf with @@ -291,8 +292,5 @@ let rec discard buffer = (for example a missing quote). *) leave_expression buffer; () - | '!' -> - ignore @@ skip_comment buffer; - discard buffer | any -> discard buffer | _ -> raise EOF diff --git a/lib/syntax/S.ml b/lib/syntax/S.ml index e691b38..b467863 100644 --- a/lib/syntax/S.ml +++ b/lib/syntax/S.ml @@ -114,6 +114,12 @@ module type Analyzer = sig (** Is the test active or not *) val is_global : bool + (** Declare the checker as global. It requires to run over the whole file and + will be disabled if the application only check a single location. + + Also, the test will be disabled if a syntax error is reported during the + parsing, because this tell that I haven’t been able to analyse the whole + source code. *) type context (** Context used to keep information during the whole test *) |