aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--bin/qsp_parser.ml8
-rw-r--r--lib/qparser/analyzer.ml53
-rw-r--r--lib/qparser/analyzer.mli4
-rw-r--r--lib/qparser/parser.mly2
-rw-r--r--lib/syntax/S.ml4
-rw-r--r--lib/syntax/tree.ml8
-rw-r--r--lib/syntax/tree.mli2
-rw-r--r--lib/syntax/type_of.ml29
-rw-r--r--lib/syntax/type_of.mli2
-rw-r--r--test/syntax.ml2
10 files changed, 57 insertions, 57 deletions
diff --git a/bin/qsp_parser.ml b/bin/qsp_parser.ml
index fc40971..8f4cf26 100644
--- a/bin/qsp_parser.ml
+++ b/bin/qsp_parser.ml
@@ -21,12 +21,10 @@ type ctx = { error_nb : int; warn_nb : int; debug_nb : int }
*)
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 =
- Result.map
- (fun f -> List.fold_left (f []) ~init:[] ~f:(filter_report filters))
- result
+ Qparser.Analyzer.parse (module Qsp_syntax.Type_of) lexbuf
+ |> Result.map (fun (_, f) ->
+ List.fold_left f ~init:[] ~f:(filter_report filters))
in
match result with
| Ok report -> (
diff --git a/lib/qparser/analyzer.ml b/lib/qparser/analyzer.ml
index fba96e0..06960f6 100644
--- a/lib/qparser/analyzer.ml
+++ b/lib/qparser/analyzer.ml
@@ -4,10 +4,11 @@
See [syntax/S]
*)
let parse :
- (module Qsp_syntax.S.Analyzer with type Location.repr = 'a) ->
+ type a.
+ (module Qsp_syntax.S.Analyzer with type Location.t = a) ->
Lexbuf.t ->
- ('a, Qsp_syntax.Report.t) Result.t =
- fun (type a) (module S : Qsp_syntax.S.Analyzer with type Location.repr = a) ->
+ (a * Qsp_syntax.Report.t list, Qsp_syntax.Report.t) Result.t =
+ fun (module S : Qsp_syntax.S.Analyzer with type Location.t = a) ->
let module Parser = Parser.Make (S) in
let module IncrementalParser =
Interpreter.Interpreter (Parser.MenhirInterpreter) in
@@ -34,28 +35,30 @@ let parse :
Error err
in
- 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
+ evaluation
+ |> Result.map (fun e -> e [])
+ |> 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
- String.concat "" [ String.trim @@ message_content ]
- in
- let report = Qsp_syntax.Report.error (e.start_pos, e.end_pos) message in
+ String.concat "" [ String.trim @@ message_content ]
+ in
+ let report =
+ Qsp_syntax.Report.error (e.start_pos, e.end_pos) message
+ 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
+ (* 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)
- evaluation
+ report)
diff --git a/lib/qparser/analyzer.mli b/lib/qparser/analyzer.mli
index 30b6625..e6dcc14 100644
--- a/lib/qparser/analyzer.mli
+++ b/lib/qparser/analyzer.mli
@@ -1,7 +1,7 @@
val parse :
- (module Qsp_syntax.S.Analyzer with type Location.repr = 'a) ->
+ (module Qsp_syntax.S.Analyzer with type Location.t = 'a) ->
Lexbuf.t ->
- ('a, Qsp_syntax.Report.t) Result.t
+ ('a * Qsp_syntax.Report.t list, 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/parser.mly b/lib/qparser/parser.mly
index 556a9ec..fd3f85b 100644
--- a/lib/qparser/parser.mly
+++ b/lib/qparser/parser.mly
@@ -21,7 +21,7 @@
%}
%parameter<Analyzer: Qsp_syntax.S.Analyzer>
-%start <Analyzer.Location.repr>main
+%start <Analyzer.Location.t Qsp_syntax.S.repr>main
%on_error_reduce expression instruction unary_operator assignation_operator
%%
diff --git a/lib/syntax/S.ml b/lib/syntax/S.ml
index e6c472d..6cab8c9 100644
--- a/lib/syntax/S.ml
+++ b/lib/syntax/S.ml
@@ -95,10 +95,10 @@ module type Instruction = sig
end
module type Location = sig
- type repr
+ type t
type instruction
- val location : pos -> instruction list -> repr
+ val location : pos -> instruction list -> t repr
end
module type Analyzer = sig
diff --git a/lib/syntax/tree.ml b/lib/syntax/tree.ml
index db8abd9..e5a60f4 100644
--- a/lib/syntax/tree.ml
+++ b/lib/syntax/tree.ml
@@ -126,10 +126,10 @@ end
module Location = struct
type instruction = S.pos Ast.statement S.repr
- type repr = S.pos * S.pos Ast.statement list
+ type t = S.pos * S.pos Ast.statement list
- let location : S.pos -> instruction list -> repr =
- fun pos block ->
+ let location : S.pos -> instruction list -> t S.repr =
+ fun pos block _report ->
let block = List.map block ~f:(fun b -> fst @@ b []) in
- (pos, block)
+ ((pos, block), [])
end
diff --git a/lib/syntax/tree.mli b/lib/syntax/tree.mli
index c16a02a..6b864e9 100644
--- a/lib/syntax/tree.mli
+++ b/lib/syntax/tree.mli
@@ -46,4 +46,4 @@ include
S.Analyzer
with type Expression.t' = S.pos Ast.expression
and type Instruction.t' = S.pos Ast.statement
- and type Location.repr = S.pos * S.pos Ast.statement list
+ and type Location.t = S.pos * S.pos Ast.statement list
diff --git a/lib/syntax/type_of.ml b/lib/syntax/type_of.ml
index a04d37b..e7222fc 100644
--- a/lib/syntax/type_of.ml
+++ b/lib/syntax/type_of.ml
@@ -313,6 +313,17 @@ module Instruction = struct
let expression : expression -> t S.repr =
fun expression report -> ((), snd (expression report))
+ (** Helper function used in the [if_] function. *)
+ let fold_clause :
+ t * Report.t list -> (expression, t) S.clause -> t * Report.t list =
+ fun ((), report) (_pos, expr, instructions) ->
+ let result, report = expr report in
+ let report =
+ Helper.compare Helper.Bool (Expression.arg_of_repr result) report
+ in
+ List.fold_left instructions ~init:((), report)
+ ~f:(fun ((), report) instruction -> instruction report)
+
let if_ :
S.pos ->
(expression, t) S.clause ->
@@ -320,18 +331,6 @@ module Instruction = struct
else_:t S.repr list ->
t S.repr =
fun _pos clause ~elifs ~else_ report ->
- (* Helper function *)
- let fold_clause :
- t * Report.t list -> (expression, t) S.clause -> t * Report.t list =
- fun ((), report) (_pos, expr, instructions) ->
- let result, report = expr report in
- let report =
- Helper.compare Helper.Bool (Expression.arg_of_repr result) report
- in
- List.fold_left instructions ~init:((), report)
- ~f:(fun ((), report) instruction -> instruction report)
- in
-
(* Traverse the whole block recursively *)
let report = fold_clause ((), report) clause in
let report = List.fold_left elifs ~f:fold_clause ~init:report in
@@ -371,14 +370,14 @@ module Instruction = struct
end
module Location = struct
- type repr = Report.t list -> Report.t list
+ type t = unit
type instruction = Instruction.t S.repr
- let location : S.pos -> instruction list -> repr =
+ let location : S.pos -> instruction list -> t S.repr =
fun _pos instructions report ->
let (), report =
List.fold_left instructions ~init:((), report)
~f:(fun ((), report) instruction -> instruction report)
in
- report
+ ((), report)
end
diff --git a/lib/syntax/type_of.mli b/lib/syntax/type_of.mli
index 719becd..a7850e5 100644
--- a/lib/syntax/type_of.mli
+++ b/lib/syntax/type_of.mli
@@ -4,4 +4,4 @@
- Assigning a [string] value in an [integer] variable
- Comparing a [string] with an [integer]
- Giving the wrong type in the argument for a function and so one. *)
-include S.Analyzer with type Location.repr = Report.t list -> Report.t list
+include S.Analyzer with type Location.t = unit
diff --git a/test/syntax.ml b/test/syntax.ml
index 487f85b..9aca3b6 100644
--- a/test/syntax.ml
+++ b/test/syntax.ml
@@ -21,7 +21,7 @@ let parse : string -> (S.pos location, Qsp_syntax.Report.t) result =
let lexing =
Sedlexing.Latin1.from_string content |> Qparser.Lexbuf.from_lexbuf
in
- Qparser.Analyzer.parse (module Qsp_syntax.Tree) lexing
+ Qparser.Analyzer.parse (module Qsp_syntax.Tree) lexing |> Result.map fst
let location : S.pos location Alcotest.testable =
let equal = equal_location (fun _ _ -> true) in
generated by cgit v1.2.3 (git 2.39.1) at 2025-01-18 13:05:38 +0000