Kill warning 45 by reusing Pervasives.result for Trace

This commit is contained in:
Tom Jack 2019-12-10 12:00:21 -06:00
parent 6d55d23628
commit 172038cef0
9 changed files with 30 additions and 26 deletions

View File

@ -1,4 +1,4 @@
open! Trace open Trace
let rec error_pp ?(dev = false) out (e : error) = let rec error_pp ?(dev = false) out (e : error) =
let open JSON_string_utils in let open JSON_string_utils in

View File

@ -1,4 +1,4 @@
open! Trace open Trace
open Ast_simplified open Ast_simplified
module Raw = Parser.Pascaligo.AST module Raw = Parser.Pascaligo.AST

View File

@ -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 *) 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 open Helpers
module AST = Ast_typed module AST = Ast_typed

View File

@ -1,4 +1,4 @@
open! Trace open Trace
module AST = Ast_typed module AST = Ast_typed
module Append_tree = Tree.Append module Append_tree = Tree.Append

View File

@ -1,5 +1,5 @@
open Mini_c open Mini_c
open! Trace open Trace
(* TODO hack to specialize map_expression to identity monad *) (* TODO hack to specialize map_expression to identity monad *)
let map_expression : let map_expression :

View File

@ -29,8 +29,8 @@ open Errors
(* This does not makes sense to me *) (* This does not makes sense to me *)
let get_operator : constant -> type_value -> expression list -> predicate result = fun s ty lst -> let get_operator : constant -> type_value -> expression list -> predicate result = fun s ty lst ->
match Operators.Compiler.get_operators s with match Operators.Compiler.get_operators s with
| Trace.Ok (x,_) -> ok x | Ok (x,_) -> ok x
| Trace.Error _ -> ( | Error _ -> (
match s with match s with
| C_NONE -> ( | C_NONE -> (
let%bind ty' = Mini_c.get_t_option ty in let%bind ty' = Mini_c.get_t_option ty in

View File

@ -1,4 +1,4 @@
open! Trace open Trace
type test_case = unit Alcotest.test_case type test_case = unit Alcotest.test_case
type test = type test =
@ -17,7 +17,7 @@ let wrap_test name f =
let wrap_test_raw f = let wrap_test_raw f =
match f () with match f () with
| Trace.Ok ((), annotations) -> ignore annotations; () | Ok ((), annotations) -> ignore annotations; ()
| Error err -> | Error err ->
Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ()) Format.printf "%a\n%!" (Ligo.Display.error_pp ~dev:true) (err ())

View File

@ -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 = let trace_alpha_tzresult err : 'a AE.Error_monad.tzresult -> 'a result =
function function
| Result.Ok x -> ok x | Ok x -> ok x
| Error errs -> fail @@ thunk @@ patch_children (List.map of_alpha_tz_error errs) (err ()) | 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 = 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 = let trace_tzresult err =
function function
| Result.Ok x -> ok x | Ok x -> ok x
| Error errs -> fail @@ thunk @@ patch_children (List.map of_tz_error errs) (err ()) | Error errs -> fail @@ thunk @@ patch_children (List.map of_tz_error errs) (err ())
(* TODO: should be a combination of trace_tzresult and trace_r *) (* TODO: should be a combination of trace_tzresult and trace_r *)
let trace_tzresult_r err_thunk_may_fail = let trace_tzresult_r err_thunk_may_fail =
function function
| Result.Ok x -> ok x | Ok x -> ok x
| Error errs -> | Error errs ->
let tz_errs = List.map of_tz_error errs in let tz_errs = List.map of_tz_error errs in
match err_thunk_may_fail () with match err_thunk_may_fail () with
| Simple_utils.Trace.Ok (err, annotations) -> | Ok (err, annotations) ->
ignore annotations ; ignore annotations ;
Error (fun () -> patch_children tz_errs (err ())) Error (fun () -> patch_children tz_errs (err ()))
| Error errors_while_generating_error -> | Error errors_while_generating_error ->

View File

@ -6,8 +6,8 @@
*) *)
module Trace_tutorial = struct module Trace_tutorial = struct
(** The trace monad is fairly similar to the predefined option (** The trace monad is fairly similar to the predefined [option]
type. *) type. It is an instance of the predefined [result] type. *)
type annotation = string type annotation = string
type error = string type error = string
@ -23,18 +23,20 @@ module Trace_tutorial = struct
list of annotations (information about past successful list of annotations (information about past successful
computations), or it is a list of errors accumulated so far. computations), or it is a list of errors accumulated so far.
The former case is denoted by the data constructor [Ok], and the The former case is denoted by the data constructor [Ok], and the
second by [Errors]. second by [Error].
*)
type nonrec 'a result = ('a * annotation list, error list) result
(*
= Ok of 'a * annotation list
| Error of error list
*) *)
type 'a result =
Ok of 'a * annotation list
| Errors of error list
(** The function [divide_trace] shows the basic use of the trace (** The function [divide_trace] shows the basic use of the trace
monad. monad.
*) *)
let divide_trace a b = let divide_trace a b =
if b = 0 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, []) else Ok (a/b, [])
(** The function [divide_three] shows that when composing two (** The function [divide_three] shows that when composing two
@ -81,7 +83,7 @@ module Trace_tutorial = struct
match f x with match f x with
Ok (x', annot') -> Ok (x', annot' @ annot) Ok (x', annot') -> Ok (x', annot' @ annot)
| errors -> ignore annot; errors) | errors -> ignore annot; errors)
| Errors _ as e -> e | Error _ as e -> e
(** The function [divide_three_bind] is equivalent to the verbose (** The function [divide_three_bind] is equivalent to the verbose
[divide_three] above, but makes use of [bind]. [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] {li If the list only contains [Ok] values, it strips the [Ok]
of each element and returns that list wrapped with [Ok].} of each element and returns that list wrapped with [Ok].}
{li Otherwise, one or more of the elements of the input list {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.}} list.}}
*) *)
let rec bind_list = function 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]. And this will pass along the error triggered by [get key map].
*) *)
let trace err = function let trace err = function
Errors e -> Errors (err::e) Error e -> Error (err::e)
| ok -> ok | ok -> ok
(** The real trace monad is very similar to the one that we have (** 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 (** Types of traced elements. It might be good to rename it [trace] at
some point. some point.
*) *)
type 'a result = type nonrec 'a result = ('a * annotation_thunk list, error_thunk) result
Ok of 'a * annotation_thunk list (*
= Ok of 'a * annotation_thunk list
| Error of error_thunk | Error of error_thunk
*)
(** {1 Constructors} *) (** {1 Constructors} *)