From 172038cef05df392fa974066df07a052a5c721d1 Mon Sep 17 00:00:00 2001 From: Tom Jack Date: Tue, 10 Dec 2019 12:00:21 -0600 Subject: [PATCH] Kill warning 45 by reusing Pervasives.result for Trace --- src/main/display.ml | 2 +- src/passes/2-simplify/pascaligo.ml | 2 +- src/passes/6-transpiler/transpiler.ml | 2 +- src/passes/6-transpiler/transpiler.mli | 2 +- src/passes/7-self_mini_c/self_mini_c.ml | 2 +- src/passes/8-compiler/compiler_program.ml | 6 ++-- src/test/test_helpers.ml | 4 +-- vendors/ligo-utils/proto-alpha-utils/trace.ml | 8 +++--- vendors/ligo-utils/simple-utils/trace.ml | 28 +++++++++++-------- 9 files changed, 30 insertions(+), 26 deletions(-) diff --git a/src/main/display.ml b/src/main/display.ml index da22fa883..991f7c2cc 100644 --- a/src/main/display.ml +++ b/src/main/display.ml @@ -1,4 +1,4 @@ -open! Trace +open Trace let rec error_pp ?(dev = false) out (e : error) = let open JSON_string_utils in diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index ae96ddc27..6aea532e0 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -1,4 +1,4 @@ -open! Trace +open Trace open Ast_simplified module Raw = Parser.Pascaligo.AST diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index dd967680e..916c7c88d 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/src/passes/6-transpiler/transpiler.ml @@ -2,7 +2,7 @@ For more info, see back-end.md: https://gitlab.com/ligolang/ligo/blob/dev/gitlab-pages/docs/contributors/big-picture/back-end.md *) -open! Trace +open Trace open Helpers module AST = Ast_typed diff --git a/src/passes/6-transpiler/transpiler.mli b/src/passes/6-transpiler/transpiler.mli index bebd4aa94..5defe6eba 100644 --- a/src/passes/6-transpiler/transpiler.mli +++ b/src/passes/6-transpiler/transpiler.mli @@ -1,4 +1,4 @@ -open! Trace +open Trace module AST = Ast_typed module Append_tree = Tree.Append diff --git a/src/passes/7-self_mini_c/self_mini_c.ml b/src/passes/7-self_mini_c/self_mini_c.ml index cda2591a1..e025eed42 100644 --- a/src/passes/7-self_mini_c/self_mini_c.ml +++ b/src/passes/7-self_mini_c/self_mini_c.ml @@ -1,5 +1,5 @@ open Mini_c -open! Trace +open Trace (* TODO hack to specialize map_expression to identity monad *) let map_expression : diff --git a/src/passes/8-compiler/compiler_program.ml b/src/passes/8-compiler/compiler_program.ml index 1c370b50a..37c44b7f3 100644 --- a/src/passes/8-compiler/compiler_program.ml +++ b/src/passes/8-compiler/compiler_program.ml @@ -29,8 +29,8 @@ open Errors (* This does not makes sense to me *) let get_operator : constant -> type_value -> expression list -> predicate result = fun s ty lst -> match Operators.Compiler.get_operators s with - | Trace.Ok (x,_) -> ok x - | Trace.Error _ -> ( + | Ok (x,_) -> ok x + | Error _ -> ( match s with | C_NONE -> ( let%bind ty' = Mini_c.get_t_option ty in @@ -452,4 +452,4 @@ and translate_function anon env input_ty output_ty : michelson result = type compiled_expression = { expr_ty : ex_ty ; expr : michelson ; -} \ No newline at end of file +} diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 5c3e6d771..928e828e8 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -1,4 +1,4 @@ -open! Trace +open Trace type test_case = unit Alcotest.test_case type test = @@ -17,7 +17,7 @@ let wrap_test name f = let wrap_test_raw f = match f () with - | Trace.Ok ((), annotations) -> ignore annotations; () + | Ok ((), annotations) -> ignore annotations; () | Error err -> Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ()) diff --git a/vendors/ligo-utils/proto-alpha-utils/trace.ml b/vendors/ligo-utils/proto-alpha-utils/trace.ml index 812ce0405..54bf77db3 100644 --- a/vendors/ligo-utils/proto-alpha-utils/trace.ml +++ b/vendors/ligo-utils/proto-alpha-utils/trace.ml @@ -11,7 +11,7 @@ let of_alpha_tz_error err = of_tz_error (AE.Ecoproto_error err) let trace_alpha_tzresult err : 'a AE.Error_monad.tzresult -> 'a result = function - | Result.Ok x -> ok x + | Ok x -> ok x | Error errs -> fail @@ thunk @@ patch_children (List.map of_alpha_tz_error errs) (err ()) let trace_alpha_tzresult_lwt error (x:_ AE.Error_monad.tzresult Lwt.t) : _ result = @@ -19,17 +19,17 @@ let trace_alpha_tzresult_lwt error (x:_ AE.Error_monad.tzresult Lwt.t) : _ resul let trace_tzresult err = function - | Result.Ok x -> ok x + | Ok x -> ok x | Error errs -> fail @@ thunk @@ patch_children (List.map of_tz_error errs) (err ()) (* TODO: should be a combination of trace_tzresult and trace_r *) let trace_tzresult_r err_thunk_may_fail = function - | Result.Ok x -> ok x + | Ok x -> ok x | Error errs -> let tz_errs = List.map of_tz_error errs in match err_thunk_may_fail () with - | Simple_utils.Trace.Ok (err, annotations) -> + | Ok (err, annotations) -> ignore annotations ; Error (fun () -> patch_children tz_errs (err ())) | Error errors_while_generating_error -> diff --git a/vendors/ligo-utils/simple-utils/trace.ml b/vendors/ligo-utils/simple-utils/trace.ml index 7464d8fb1..dc80894d4 100644 --- a/vendors/ligo-utils/simple-utils/trace.ml +++ b/vendors/ligo-utils/simple-utils/trace.ml @@ -6,8 +6,8 @@ *) module Trace_tutorial = struct - (** The trace monad is fairly similar to the predefined option - type. *) + (** The trace monad is fairly similar to the predefined [option] + type. It is an instance of the predefined [result] type. *) type annotation = string type error = string @@ -23,18 +23,20 @@ module Trace_tutorial = struct list of annotations (information about past successful computations), or it is a list of errors accumulated so far. The former case is denoted by the data constructor [Ok], and the - second by [Errors]. + second by [Error]. *) - type 'a result = - Ok of 'a * annotation list - | Errors of error list + type nonrec 'a result = ('a * annotation list, error list) result + (* + = Ok of 'a * annotation list + | Error of error list + *) (** The function [divide_trace] shows the basic use of the trace monad. *) let divide_trace a b = if b = 0 - then Errors [Printf.sprintf "division by zero: %d/%d" a b] + then Error [Printf.sprintf "division by zero: %d/%d" a b] else Ok (a/b, []) (** The function [divide_three] shows that when composing two @@ -81,7 +83,7 @@ module Trace_tutorial = struct match f x with Ok (x', annot') -> Ok (x', annot' @ annot) | errors -> ignore annot; errors) - | Errors _ as e -> e + | Error _ as e -> e (** The function [divide_three_bind] is equivalent to the verbose [divide_three] above, but makes use of [bind]. @@ -169,7 +171,7 @@ module Trace_tutorial = struct {li If the list only contains [Ok] values, it strips the [Ok] of each element and returns that list wrapped with [Ok].} {li Otherwise, one or more of the elements of the input list - is [Errors], then [bind_list] returns the first error in the + is [Error], then [bind_list] returns the first error in the list.}} *) let rec bind_list = function @@ -199,7 +201,7 @@ module Trace_tutorial = struct And this will pass along the error triggered by [get key map]. *) let trace err = function - Errors e -> Errors (err::e) + Error e -> Error (err::e) | ok -> ok (** The real trace monad is very similar to the one that we have @@ -293,9 +295,11 @@ type annotation_thunk = annotation thunk (** Types of traced elements. It might be good to rename it [trace] at some point. *) -type 'a result = - Ok of 'a * annotation_thunk list +type nonrec 'a result = ('a * annotation_thunk list, error_thunk) result +(* += Ok of 'a * annotation_thunk list | Error of error_thunk +*) (** {1 Constructors} *)