diff options
Diffstat (limited to 'lib')
| -rw-r--r-- | lib/qparser/analyzer.ml | 53 | ||||
| -rw-r--r-- | lib/qparser/analyzer.mli | 4 | ||||
| -rw-r--r-- | lib/qparser/parser.mly | 2 | ||||
| -rw-r--r-- | lib/syntax/S.ml | 4 | ||||
| -rw-r--r-- | lib/syntax/tree.ml | 8 | ||||
| -rw-r--r-- | lib/syntax/tree.mli | 2 | ||||
| -rw-r--r-- | lib/syntax/type_of.ml | 29 | ||||
| -rw-r--r-- | lib/syntax/type_of.mli | 2 |
8 files changed, 53 insertions, 51 deletions
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 |