diff options
Diffstat (limited to 'lib/qparser')
| -rw-r--r-- | lib/qparser/analyzer.ml | 43 | ||||
| -rw-r--r-- | lib/qparser/analyzer.mli | 10 | ||||
| -rw-r--r-- | lib/qparser/dune | 42 | ||||
| -rw-r--r-- | lib/qparser/expression_parser.messages | 16 | ||||
| -rw-r--r-- | lib/qparser/idents.ml | 2 | ||||
| -rw-r--r-- | lib/qparser/lexbuf.ml | 8 | ||||
| -rw-r--r-- | lib/qparser/lexbuf.mli | 40 | ||||
| -rw-r--r-- | lib/qparser/lexer.ml | 25 | ||||
| -rw-r--r-- | lib/qparser/lexer.mli | 2 | ||||
| -rw-r--r-- | lib/qparser/parser.mly | 25 | ||||
| -rw-r--r-- | lib/qparser/qsp_expression.mly | 140 | ||||
| -rw-r--r-- | lib/qparser/tokens.mly | 1 |
12 files changed, 210 insertions, 144 deletions
diff --git a/lib/qparser/analyzer.ml b/lib/qparser/analyzer.ml index ca2b54f..0337baf 100644 --- a/lib/qparser/analyzer.ml +++ b/lib/qparser/analyzer.ml @@ -1,28 +1,45 @@ type 'a result = { content : 'a; report : Qsp_syntax.Report.t list } +type lexer = Location | Dynamic -(** - Run the QSP parser and apply the analyzer over it. +let get_lexer : + Lexbuf.t -> + lexer -> + unit -> + Tokens.token * Lexing.position * Lexing.position = + fun l -> function + | Location -> Lexbuf.tokenize Lexer.main l + | Dynamic -> Lexbuf.tokenize Lexer.dynamics l + +(** Run the QSP parser and apply the analyzer over it. - See [syntax/S] - *) -let rec parse : - type a context. - (module Qsp_syntax.S.Analyzer + See [syntax/S] *) +let rec parse : type a context. + (module Qsp_syntax.Analyzer.T with type Location.t = a and type context = context) -> + lexer -> Lexbuf.t -> context -> (a result, Qsp_syntax.Report.t) Result.t = - fun (module S : Qsp_syntax.S.Analyzer + fun (module S : Qsp_syntax.Analyzer.T with type Location.t = a and type context = context) -> let module Parser = Parser.Make (S) in let module IncrementalParser = - Interpreter.Interpreter (Parser.MenhirInterpreter) in - fun l context -> - let lexer = Lexbuf.tokenize Lexer.main l in + Interpreter.Interpreter (Parser.MenhirInterpreter) + in + fun lexer_type l context -> + let get_parser : + lexer -> + Lexing.position -> + (context -> a) Parser.MenhirInterpreter.checkpoint = function + | Location -> Parser.Incremental.main + | Dynamic -> Parser.Incremental.dynamics + in + + let lexer = get_lexer l lexer_type in - let init = Parser.Incremental.main (fst (Lexbuf.positions l)) in + let init = (get_parser lexer_type) (fst (Lexbuf.positions l)) in (* Firslty, check if we are able to read the whole syntax from the source *) let evaluation = @@ -59,7 +76,7 @@ let rec parse : 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 + parse (module S) lexer_type l context | Error e, _ -> let message = match e.IncrementalParser.code with diff --git a/lib/qparser/analyzer.mli b/lib/qparser/analyzer.mli index 949db16..6e2f752 100644 --- a/lib/qparser/analyzer.mli +++ b/lib/qparser/analyzer.mli @@ -1,13 +1,15 @@ type 'a result = { content : 'a; report : Qsp_syntax.Report.t list } +type lexer = Location | Dynamic val parse : - (module Qsp_syntax.S.Analyzer + (module Qsp_syntax.Analyzer.T with type Location.t = 'a and type context = 'context) -> + lexer -> Lexbuf.t -> 'context -> ('a result, Qsp_syntax.Report.t) Result.t -(** Read the source and build a analyzis over it. +(** Read the source and build a analyzis over it. -This method make the link between the source file and how to read it -(encoding…) and the AST we want to build. *) + This method make the link between the source file and how to read it + (encoding…) and the AST we want to build. *) diff --git a/lib/qparser/dune b/lib/qparser/dune index eea3815..7edba9c 100644 --- a/lib/qparser/dune +++ b/lib/qparser/dune @@ -1,30 +1,28 @@ (library (name qparser) - (libraries - str - menhirLib - qsp_syntax - sedlex - ) - (preprocess (pps - sedlex.ppx - )) - ) - + (libraries str menhirLib qsp_syntax sedlex) + (preprocess + (pps sedlex.ppx))) (rule (targets parser_messages.ml) - (deps expression_parser.messages tokens.mly qsp_expression.mly qsp_instruction.mly qsp_single_line.mly parser.mly) - (action (with-stdout-to %{targets} (run menhir --base parser.mly --compile-errors %{deps})))) + (deps + expression_parser.messages + tokens.mly + qsp_expression.mly + qsp_instruction.mly + qsp_single_line.mly + parser.mly) + (action + (with-stdout-to + %{targets} + (run menhir --base parser.mly --compile-errors %{deps})))) (menhir - (modules tokens) - (flags --only-tokens) -) - + (modules tokens) + (flags --only-tokens)) -(menhir - (modules tokens parser qsp_instruction qsp_expression qsp_single_line) - (flags --table --external-tokens Tokens) - (merge_into parser) -) +(menhir + (modules tokens parser qsp_instruction qsp_expression qsp_single_line) + (flags --table --external-tokens Tokens) + (merge_into parser)) diff --git a/lib/qparser/expression_parser.messages b/lib/qparser/expression_parser.messages index b708d36..8040f05 100644 --- a/lib/qparser/expression_parser.messages +++ b/lib/qparser/expression_parser.messages @@ -1,3 +1,4 @@ +main: LOCATION_START EOL INTEGER SET main: LOCATION_START EOL IDENT SET Unexpected expression here. @@ -45,10 +46,6 @@ main: STAR Missing location name -main: LOCATION_START EOL INTEGER SET - - Unexpected expression here. - main: LOCATION_START EOL IF IDENT COLUMN EOL ELIF INTEGER SET The `ELIF` expression does not end properly. A `:` is expected before any instruction. @@ -68,7 +65,6 @@ main: LOCATION_START EOL IF IDENT COLUMN EOL ELSE STAR main: LOCATION_START EOL IDENT DECR INTEGER SET main: LOCATION_START EOL SET IDENT DECR INTEGER SET main: LOCATION_START EOL LET IDENT DECR INTEGER SET -main: LOCATION_START EOL KEYWORD INTEGER TEXT_MARKER main: LOCATION_START EOL KEYWORD IDENT COMA INTEGER TEXT_MARKER Missing separator between instructions @@ -114,3 +110,13 @@ main: LOCATION_START EOL IDENT STAR STAR main: LOCATION_START EOL IDENT MINUS STAR Unknown operator. Did you write '+ =' instead of '+=' ? + +dynamics: IDENT R_PAREN +dynamics: TEXT_MARKER ENTER_EMBED FUNCTION_NOARGS TEXT_MARKER +dynamics: TEXT_MARKER ENTER_EMBED INTEGER TEXT_MARKER + + Unbalanced paren + +dynamics: IDENT PLUS INTEGER TEXT_MARKER + + Missing operator before text diff --git a/lib/qparser/idents.ml b/lib/qparser/idents.ml index be3d76c..a74fce2 100644 --- a/lib/qparser/idents.ml +++ b/lib/qparser/idents.ml @@ -99,7 +99,7 @@ let _ = ("MIN", FUNCTION T.Min); ("$MIN", FUNCTION T.Min'); ("MOD", MOD); - ("MSECSCOUNT", FUNCTION T.Msecscount); + ("MSECSCOUNT", FUNCTION_NOARGS T.Msecscount); ("MSG", KEYWORD T.Msg); ("NL", KEYWORD T.Nl); ("*NL", KEYWORD T.Nl'); diff --git a/lib/qparser/lexbuf.ml b/lib/qparser/lexbuf.ml index afc3bac..9ba7938 100644 --- a/lib/qparser/lexbuf.ml +++ b/lib/qparser/lexbuf.ml @@ -41,6 +41,7 @@ let pp_state format = function let state : t -> state option = fun t -> Stack.top_opt t.state let enter_state : t -> state -> unit = fun t state -> Stack.push state t.state let leave_state : t -> unit = fun t -> ignore @@ Stack.pop_opt t.state +let clear_state : t -> unit = fun t -> Stack.clear t.state let buffer : t -> Sedlexing.lexbuf = fun t -> t.buffer let start : t -> unit = @@ -62,8 +63,10 @@ let positions : t -> Lexing.position * Lexing.position = 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 -> +let from_lexbuf : + ?position:Lexing.position -> ?reset_line:bool -> Sedlexing.lexbuf -> t = + fun ?position ?(reset_line = true) t -> + Option.iter (Sedlexing.set_position t) position; { buffer = t; start_p = None; @@ -90,6 +93,7 @@ let tokenize : (t -> 'a) -> t -> unit -> 'a * Lexing.position * Lexing.position let default, curr_p = positions t in let start_p = Option.value ~default t.start_p in + t.recovering <- false; t.start_p <- None; (token, start_p, curr_p) diff --git a/lib/qparser/lexbuf.mli b/lib/qparser/lexbuf.mli index 4283db1..8beb9da 100644 --- a/lib/qparser/lexbuf.mli +++ b/lib/qparser/lexbuf.mli @@ -3,8 +3,11 @@ type t (** The state of the buffer *) -val from_lexbuf : ?reset_line:bool -> Sedlexing.lexbuf -> t -(** Create a new buffer *) +val from_lexbuf : + ?position:Lexing.position -> ?reset_line:bool -> Sedlexing.lexbuf -> t +(** Create a new buffer. + + If a position is given, start from this position in the file. *) val start : t -> unit (** Intialize a new run. *) @@ -13,11 +16,10 @@ val buffer : t -> Sedlexing.lexbuf (** Extract the sedlex buffer. Required in each rule. *) val positions : t -> Lexing.position * Lexing.position -(** Extract the starting and ending position for the matched token. +(** Extract the starting and ending position for the matched token. - This function is used outside of the parser, in order to get the position - of the latest token in the case of an error. - *) + This function is used outside of the parser, in order to get the position of + the latest token in the case of an error. *) val content : t -> string (** Extract the token matched by the rule *) @@ -33,15 +35,14 @@ val tokenize : (t -> 'a) -> t -> unit -> 'a * Lexing.position * Lexing.position val rollback : t -> unit (** Rollback the latest token matched *) -(** {1 State in expressions} +(** {1 State in expressions} - The comment system is terrible. The same symbol can be used for : - - starting a comment - - inequality operation + The comment system is terrible. The same symbol can be used for : + - starting a comment + - inequality operation - In order to manage this, I try to identify the context in a very basic way, - using a stack for determining the token to send. -*) + In order to manage this, I try to identify the context in a very basic way, + using a stack for determining the token to send. *) type lexer = t -> Tokens.token and buffer_builder = ?nested:bool -> Buffer.t -> t -> Tokens.token @@ -64,14 +65,14 @@ type state = | String of stringWraper (** String enclosed by [''] *) | MString of int (** String enclosed by [{}]*) | EndString of stringWraper - (** State raised just before closing the string. - The buffer is rollbacked and the position is the closing symbol. *) + (** State raised just before closing the string. The buffer is rollbacked + and the position is the closing symbol. *) | Expression (** Expression where [!] is an operator *) val pp_state : Format.formatter -> state -> unit val state : t -> state option -(** Get the current state for the lexer. +(** Get the current state for the lexer. @return [None] when in the default state *) @@ -81,11 +82,14 @@ val enter_state : t -> state -> unit val leave_state : t -> unit (** Leave the current state *) +val clear_state : t -> unit +(** Remove all the elements from the stack *) + 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 *) +(** 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 814c97f..0bd214a 100644 --- a/lib/qparser/lexer.ml +++ b/lib/qparser/lexer.ml @@ -1,6 +1,4 @@ -(** - Lexer using sedlex - *) +(** Lexer using sedlex *) open Tokens open StdLabels @@ -12,7 +10,8 @@ exception EOF (* Extract the location name from the pattern *) let location_name = Str.regexp {|# *\(.*\)|} -(** Remove all the expression state when we are leaving the expression itself. *) +(** Remove all the expression state when we are leaving the expression itself. +*) let rec leave_expression buffer = match Lexbuf.state buffer with | Some Lexbuf.Expression -> @@ -21,7 +20,7 @@ let rec leave_expression buffer = | _ -> () (** Try to read the identifier and check if this is a function, a keyword, or - just a variable. + just a variable. See the tests [Syntax.Operator2] and [Syntax.Call Nl] for two cases. *) let build_ident buffer = @@ -124,8 +123,7 @@ let rec read_long_string : ?nested:bool -> int -> Buffer.t -> Lexbuf.t -> token rollbacked, leaving the state in [Lexbuf.EndString _]. The next call to [main] will call the associated function, effectively - leaving the string mode in the parser. - *) + leaving the string mode in the parser. *) let rec read_quoted_string : Lexbuf.stringWraper -> Lexbuf.buffer_builder = fun f ?(nested = false) buf buffer -> let lexbuf = Lexbuf.buffer buffer in @@ -153,11 +151,9 @@ let rec read_quoted_string : Lexbuf.stringWraper -> Lexbuf.buffer_builder = (f.wrap ~nested (read_quoted_string f)) buf buffer | _ -> raise Not_found -(** Track the kind of nested string inside a multiline string inside a - comment. +(** Track the kind of nested string inside a multiline string inside a comment. - Some constructions are not allowed in this specific case (see later) -*) + Some constructions are not allowed in this specific case (see later) *) type commentedString = None | Quote | DQuote let rec skip_comment buffer = @@ -333,6 +329,10 @@ let main buffer = in parser buffer +(** Function used inside the dynamics expressions. Here, we give the EOF token + to the parser. *) +let dynamics buffer = try main buffer with EOF -> Tokens.EOF + let rec discard buffer = let () = Lexbuf.start_recovery buffer in let lexbuf = Lexbuf.buffer buffer in @@ -347,7 +347,6 @@ let rec discard buffer = We are here because an error was raised, so can have any situation (for example a missing quote). *) - leave_expression buffer; - () + Lexbuf.clear_state buffer | any -> discard buffer | _ -> raise EOF diff --git a/lib/qparser/lexer.mli b/lib/qparser/lexer.mli index 854bb1e..70902e6 100644 --- a/lib/qparser/lexer.mli +++ b/lib/qparser/lexer.mli @@ -18,3 +18,5 @@ val discard : Lexbuf.t -> unit val main : Lexbuf.t -> Tokens.token (** Main entry point. This function is called after each token returned *) + +val dynamics : Lexbuf.t -> Tokens.token diff --git a/lib/qparser/parser.mly b/lib/qparser/parser.mly index d075e3e..55e729e 100644 --- a/lib/qparser/parser.mly +++ b/lib/qparser/parser.mly @@ -17,13 +17,15 @@ module Helper = Qsp_syntax.S.Helper(Analyzer.Expression) %} -%parameter<Analyzer: Qsp_syntax.S.Analyzer> -%start <(Analyzer.context -> Analyzer.Location.t)>main -%on_error_reduce expression instruction unary_operator assignation_operator +%parameter<Analyzer: Qsp_syntax.Analyzer.T> +%start<(Analyzer.context -> Analyzer.Location.t)>main +%start<(Analyzer.context -> Analyzer.Location.t)>dynamics + +%on_error_reduce instruction unary_operator assignation_operator %% -main: +main: | before_location* start_location EOL+ @@ -34,6 +36,21 @@ main: fun context -> Analyzer.Location.location context $loc instructions } +dynamics: + | EOL* + instructions = line_statement+ + EOF + { + let instructions = List.map instructions ~f:(Analyzer.Instruction.v) in + fun context -> Analyzer.Location.location context $loc instructions + } + | EOL* + b = inlined_block(EOF) + { + let instruction = (Analyzer.Instruction.v b) in + fun context -> Analyzer.Location.location context $loc [instruction] + } + before_location: | EOL {} | COMMENT EOL { } diff --git a/lib/qparser/qsp_expression.mly b/lib/qparser/qsp_expression.mly index c6b7564..0b8406c 100644 --- a/lib/qparser/qsp_expression.mly +++ b/lib/qparser/qsp_expression.mly @@ -1,93 +1,109 @@ %% %public arguments(X): - (** This rule allow the difference between elements with a single argument - (when the separator is required) which allow to write a spectif case when - we only have one element. + (** This rule allow the difference between elements with a single argument + (when the separator is required) which allow to write a spectif case when + we only have one element. *) - | hd = X - COMA - tl = separated_nonempty_list(COMA, X) - { hd :: tl } - (** The case where we have nothing is easy to manage here *) - | - { [] } - (** The remaining case (only one argument) is handled outside of this + | hd = X COMA tl = separated_nonempty_list(COMA, X) { hd :: tl } + (** The case where we have nothing is easy to manage here *) + | { [] } + +(** The remaining case (only one argument) is handled outside of this block: if we have a single argument we don’t have to bother with the paren, they belongs to the expression. *) %inline argument(X): - | a = delimited(L_PAREN, arguments(X), R_PAREN) { a } - | a = X { [ a ] } + | a = delimited(L_PAREN, arguments(X), R_PAREN) { a } + | a = X { [ a ] } (** Declare an expression *) %public expression: - | ex = delimited(L_PAREN, expression, R_PAREN) - { ex } - | op = unary_operator - expr = expression - { Analyzer.Expression.uoperator $loc op expr } - %prec NO - | - expr1 = expression - op = binary_operator - expr2 = expression - { Analyzer.Expression.boperator $loc op expr1 expr2 } - | v = delimited(TEXT_MARKER, literal*, TEXT_MARKER) - { Analyzer.Expression.literal $loc v } - | i = INTEGER { Analyzer.Expression.integer $loc i } - | v = variable { Analyzer.Expression.ident v } + | ex = delimited(L_PAREN, expression, R_PAREN) { ex } + | op = unary_operator expr = expression + { + Analyzer.Expression.uoperator ~ctx:{ f = (fun _ -> None) } $loc op expr + } + %prec NO + | expr1 = expression op = binary_operator expr2 = expression + { + Analyzer.Expression.boperator ~ctx:{ f = (fun _ -> None) } $loc op expr1 expr2 + } + | v = delimited(TEXT_MARKER, list(literal), TEXT_MARKER) + { + Analyzer.Expression.literal ~ctx:{ f = (fun _ -> None) } $loc v + } + | i = INTEGER + { + Analyzer.Expression.integer ~ctx:{ f = (fun _ -> None) } $loc i + } + | v = variable + { Analyzer.Expression.ident ~ctx:{ f = (fun _ -> None) } v } %prec p_variable - | k = FUNCTION - arg = argument(expression) + | k = FUNCTION arg = argument(expression) { - (Analyzer.Expression.function_ $loc k arg) + Analyzer.Expression.function_ ~ctx:{ f = (fun _ -> None) } $loc k arg } - | k = FUNCTION_NOARGS + + (* Function without any argument can be used either + - without any parens + - or with parens but empty and with nothing inside + *) + | k = FUNCTION_NOARGS { - (Analyzer.Expression.function_ $loc k []) + Analyzer.Expression.function_ ~ctx:{ f = (fun _ -> None) } $loc k [] } + | k = FUNCTION_NOARGS L_PAREN R_PAREN + { + Analyzer.Expression.function_ ~ctx:{ f = (fun _ -> None) } $loc k [] + } + literal: - | v = LITERAL { Qsp_syntax.T.Text v } - | e = delimited(ENTER_EMBED, expression, LEAVE_EMBED) + | v = LITERAL { Qsp_syntax.T.Text v } + | e = delimited(ENTER_EMBED, expression, LEAVE_EMBED) { Qsp_syntax.T.Expression e } unary_operator: - | OBJ - | NO { T.No } - | MINUS { T.Neg } - | PLUS { T.Add } + | OBJ + | NO + { T.No } + | MINUS { T.Neg } + | PLUS { T.Add } %inline binary_operator: - | EQUAL { T.Eq } - | LT GT { T.Neq } - | EXCLAMATION { T.Neq } - | PLUS { T.Plus } - | MINUS { T.Minus } - | STAR { T.Product } - | DIV { T.Div } - | MOD { T.Mod } - | GT { T.Gt } - | LT { T.Lt } - | AND { T.And } - | GT EQUAL { T.Gte } - | LT EQUAL { T.Lte } - | EQUAL GT { T.Gte } - | EQUAL LT { T.Lte } - | OR { T.Or } + | EQUAL { T.Eq } + | LT GT { T.Neq } + | EXCLAMATION { T.Neq } + | PLUS { T.Plus } + | MINUS { T.Minus } + | STAR { T.Product } + | DIV { T.Div } + | MOD { T.Mod } + | GT { T.Gt } + | LT { T.Lt } + | AND { T.And } + | GT EQUAL { T.Gte } + | LT EQUAL { T.Lte } + | EQUAL GT { T.Gte } + | EQUAL LT { T.Lte } + | OR { T.Or } (** Declare a variable, either in the assignation (let var = …) or as a reference is an expression *) %public variable: - | name = IDENT - brackets = delimited(L_BRACKET, expression?, R_BRACKET)? - { - let index = match brackets with - | None -> + | name = IDENT + brackets = option( + delimited(L_BRACKET, option(expression), R_BRACKET) + ) + { + let index = + match brackets with + | None -> (* No declaration, consider index at 0 *) None - | Some other -> other in - Qsp_syntax.S.{ pos = $loc ; name ; index } + | Some other -> other + in + Qsp_syntax.S.{ pos = $loc; name; index } } diff --git a/lib/qparser/tokens.mly b/lib/qparser/tokens.mly index 0ba5486..42856ef 100644 --- a/lib/qparser/tokens.mly +++ b/lib/qparser/tokens.mly @@ -20,6 +20,7 @@ %token AND OR %token EOL +%token EOF %token <string>IDENT %token <string>LITERAL |