From ff4822674872dfaa5794ec38c1aed945076e390e Mon Sep 17 00:00:00 2001 From: Galfour Date: Wed, 13 Mar 2019 13:44:32 +0000 Subject: [PATCH] add ligo-helpers moved helpers modified ligo-helpers opam --- src/lib_ligo/src/helpers/.gitignore | 6 + src/lib_ligo/src/helpers/dictionary.ml | 33 +++++ src/lib_ligo/src/helpers/dictionary.mli | 16 +++ src/lib_ligo/src/helpers/dune | 8 ++ src/lib_ligo/src/helpers/environment.ml | 53 +++++++ src/lib_ligo/src/helpers/ligo-helpers.opam | 23 +++ src/lib_ligo/src/helpers/location.ml | 24 ++++ src/lib_ligo/src/helpers/option.ml | 3 + src/lib_ligo/src/helpers/trace.ml | 157 +++++++++++++++++++++ src/lib_ligo/src/helpers/wrap.ml | 21 +++ src/ligo/helpers/dictionary.ml | 33 +++++ src/ligo/helpers/dictionary.mli | 16 +++ src/ligo/helpers/dune | 8 ++ src/ligo/helpers/environment.ml | 53 +++++++ src/ligo/helpers/ligo-helpers.opam | 22 +++ src/ligo/helpers/location.ml | 24 ++++ src/ligo/helpers/option.ml | 3 + src/ligo/helpers/trace.ml | 157 +++++++++++++++++++++ src/ligo/helpers/wrap.ml | 21 +++ 19 files changed, 681 insertions(+) create mode 100644 src/lib_ligo/src/helpers/.gitignore create mode 100644 src/lib_ligo/src/helpers/dictionary.ml create mode 100644 src/lib_ligo/src/helpers/dictionary.mli create mode 100644 src/lib_ligo/src/helpers/dune create mode 100644 src/lib_ligo/src/helpers/environment.ml create mode 100644 src/lib_ligo/src/helpers/ligo-helpers.opam create mode 100644 src/lib_ligo/src/helpers/location.ml create mode 100644 src/lib_ligo/src/helpers/option.ml create mode 100644 src/lib_ligo/src/helpers/trace.ml create mode 100644 src/lib_ligo/src/helpers/wrap.ml create mode 100644 src/ligo/helpers/dictionary.ml create mode 100644 src/ligo/helpers/dictionary.mli create mode 100644 src/ligo/helpers/dune create mode 100644 src/ligo/helpers/environment.ml create mode 100644 src/ligo/helpers/ligo-helpers.opam create mode 100644 src/ligo/helpers/location.ml create mode 100644 src/ligo/helpers/option.ml create mode 100644 src/ligo/helpers/trace.ml create mode 100644 src/ligo/helpers/wrap.ml diff --git a/src/lib_ligo/src/helpers/.gitignore b/src/lib_ligo/src/helpers/.gitignore new file mode 100644 index 000000000..46d12ff04 --- /dev/null +++ b/src/lib_ligo/src/helpers/.gitignore @@ -0,0 +1,6 @@ +_build/* +*/_build +*~ +.merlin +*/.merlin +*.install \ No newline at end of file diff --git a/src/lib_ligo/src/helpers/dictionary.ml b/src/lib_ligo/src/helpers/dictionary.ml new file mode 100644 index 000000000..a4badb866 --- /dev/null +++ b/src/lib_ligo/src/helpers/dictionary.ml @@ -0,0 +1,33 @@ +open Trace + +type ('a, 'b) t = ('a * 'b) list + +let get_exn x y = List.assoc y x + +let get x y = generic_try (simple_error "Dictionry.get") @@ fun () -> get_exn x y + +let set ?equal lst a b = + let equal : 'a -> 'a -> bool = + Option.unopt + ~default:(=) equal + in + let rec aux acc = function + | [] -> List.rev acc + | (key, _)::tl when equal key a -> aux ((key, b) :: acc) tl + | hd::tl -> aux (hd :: acc) tl + in + aux [] lst + +let del ?equal lst a = + let equal : 'a -> 'a -> bool = + Option.unopt + ~default:(=) equal + in + let rec aux acc = function + | [] -> List.rev acc + | (key, _)::tl when equal key a -> aux acc tl + | hd::tl -> aux (hd :: acc) tl + in + aux [] lst + +let to_list x = x diff --git a/src/lib_ligo/src/helpers/dictionary.mli b/src/lib_ligo/src/helpers/dictionary.mli new file mode 100644 index 000000000..10204b467 --- /dev/null +++ b/src/lib_ligo/src/helpers/dictionary.mli @@ -0,0 +1,16 @@ +open Trace + +type ('a, 'b) t + +val get_exn : ('a, 'b) t -> 'a -> 'b +val get : ('a, 'b) t -> 'a -> 'b result + +val set : + ?equal:('a -> 'a -> bool) -> + ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t + +val del : + ?equal:('a -> 'a -> bool) -> + ('a, 'b) t -> 'a -> ('a, 'b) t + +val to_list : ('a, 'b) t -> ('a * 'b) list diff --git a/src/lib_ligo/src/helpers/dune b/src/lib_ligo/src/helpers/dune new file mode 100644 index 000000000..f3d586dbf --- /dev/null +++ b/src/lib_ligo/src/helpers/dune @@ -0,0 +1,8 @@ +(library + (libraries + tezos-base + tezos-utils + ) + (name ligo_helpers) + (public_name ligo-helpers) +) diff --git a/src/lib_ligo/src/helpers/environment.ml b/src/lib_ligo/src/helpers/environment.ml new file mode 100644 index 000000000..ecb5839d2 --- /dev/null +++ b/src/lib_ligo/src/helpers/environment.ml @@ -0,0 +1,53 @@ +module type PARAMETER = sig + type key + type value + val key_cmp : key -> key -> int + val value_cmp : value -> value -> int +end + +let parameter (type key value) ?key_cmp ?value_cmp () : (module PARAMETER with type key = key and type value = value) = + (module struct + type nonrec key = key + type nonrec value = value + let key_cmp = Option.unopt ~default:compare key_cmp + let value_cmp = Option.unopt ~default:compare value_cmp + end) + +let int_parameter = (parameter () : (module PARAMETER with type key = int and type value = int)) +module INT_PARAMETER = (val ((parameter () : (module PARAMETER with type key = int and type value = int)))) + +module type ENVIRONMENT = sig + type key + type value + type t + + val empty : t + val get_opt : t -> key -> value option + val gets : t -> key -> value list + val set : t -> key -> value -> t + val del : t -> key -> t +end + +module Make(P:PARAMETER) : ENVIRONMENT with type key = P.key and type value = P.value = struct + type key = P.key + type value = P.value + type t = (key * value) list + + let empty : t = [] + + let gets lst k = + let kvs = List.filter (fun (k', _) -> P.key_cmp k k' = 0) lst in + List.map snd kvs + let get_opt lst k = match gets lst k with + | [] -> None + | v :: _ -> Some v + + let set lst k v = (k, v) :: lst + + let del lst k = + let rec aux acc = function + | [] -> List.rev acc + | (key, _) :: tl when P.key_cmp key k = 0 -> List.rev acc @ tl + | hd :: tl -> aux (hd :: acc) tl in + aux [] lst +end diff --git a/src/lib_ligo/src/helpers/ligo-helpers.opam b/src/lib_ligo/src/helpers/ligo-helpers.opam new file mode 100644 index 000000000..4f2cf5cb5 --- /dev/null +++ b/src/lib_ligo/src/helpers/ligo-helpers.opam @@ -0,0 +1,23 @@ +name: "ligo-helpers" +opam-version: "2.0" +version: "1.0" +maintainer: "gabriel.alfour@gmail.com" +authors: [ "Galfour" ] +homepage: "https://gitlab.com/gabriel.alfour/tezos" +bug-reports: "https://gitlab.com/gabriel.alfour/tezos/issues" +dev-repo: "git+https://gitlab.com/gabriel.alfour/tezos.git" +license: "MIT" +depends: [ + "ocamlfind" { build } + "dune" { build & >= "1.0.1" } + "meta-michelson" + "tezos-utils" + "tezos-base" +] +build: [ + [ "dune" "build" "-p" name "-j" jobs ] + [ "mv" "src/lib_ligo/src/helpers/ligo-helpers.install" "." ] +] +url { + src: "https://gitlab.com/gabriel.alfour/tezos/-/archive/master/tezos.tar.gz" +} diff --git a/src/lib_ligo/src/helpers/location.ml b/src/lib_ligo/src/helpers/location.ml new file mode 100644 index 000000000..776cd7f93 --- /dev/null +++ b/src/lib_ligo/src/helpers/location.ml @@ -0,0 +1,24 @@ +type file_location = { + filename : string ; + start_line : int ; + start_column : int ; + end_line : int ; + end_column : int ; +} + +type virtual_location = string + +type t = + | File of file_location + | Virtual of virtual_location + +let make (start_pos:Lexing.position) (end_pos:Lexing.position) : t = + let filename = start_pos.pos_fname in + let start_line = start_pos.pos_lnum in + let end_line = end_pos.pos_lnum in + let start_column = start_pos.pos_cnum - start_pos.pos_bol in + let end_column = end_pos.pos_cnum - end_pos.pos_bol in + File { filename ; start_line ; start_column ; end_line ; end_column } + +let virtual_location s = Virtual s +let dummy = virtual_location "dummy" diff --git a/src/lib_ligo/src/helpers/option.ml b/src/lib_ligo/src/helpers/option.ml new file mode 100644 index 000000000..4ee7859ff --- /dev/null +++ b/src/lib_ligo/src/helpers/option.ml @@ -0,0 +1,3 @@ +let unopt ~default = function + | None -> default + | Some x -> x diff --git a/src/lib_ligo/src/helpers/trace.ml b/src/lib_ligo/src/helpers/trace.ml new file mode 100644 index 000000000..a99e7ea8b --- /dev/null +++ b/src/lib_ligo/src/helpers/trace.ml @@ -0,0 +1,157 @@ +type error = { + message : string ; + title : string ; +} + +type 'a result = + Ok of 'a + | Errors of error list + +let ok x = Ok x +let fail err = Errors [err] + +let simple_error str = { + message = "" ; + title = str ; +} + +let error title message = { title ; message } + +let simple_fail str = fail @@ simple_error str + +let map f = function + | Ok x -> f x + | Errors _ as e -> e + +let apply f = function + | Ok x -> Ok (f x) + | Errors _ as e -> e + +let (>>?) x f = map f x +let (>>|?) = apply + +module Let_syntax = struct + let bind m ~f = m >>? f +end + +let trace err = function + | Ok _ as o -> o + | Errors errs -> Errors (err :: errs) + +let trace_option error = function + | None -> fail error + | Some s -> ok s + +let rec bind_list = function + | [] -> ok [] + | hd :: tl -> ( + hd >>? fun hd -> + bind_list tl >>? fun tl -> + ok @@ hd :: tl + ) + +let bind_or (a, b) = + match a with + | Ok x -> ok x + | _ -> b + +let bind_lr (type a b) ((a : a result), (b:b result)) : [`Left of a | `Right of b] result = + match (a, b) with + | Ok x, _ -> ok @@ `Left x + | _, Ok x -> ok @@ `Right x + | _, Errors b -> Errors b + +let bind_and (a, b) = + a >>? fun a -> + b >>? fun b -> + ok (a, b) + +module AE = Tezos_utils.Memory_proto_alpha.Alpha_environment +module TP = Tezos_base__TzPervasives + +let of_tz_error (err:Tezos_utils.Error_monad.error) : error = + let str = Tezos_utils.Error_monad.(to_string err) in + error "alpha error" str + +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 + | Error errs -> Errors (err :: List.map of_alpha_tz_error errs) + +let trace_alpha_tzresult_lwt error (x:_ AE.Error_monad.tzresult Lwt.t) : _ result = + trace_alpha_tzresult error @@ Lwt_main.run x + +let trace_tzresult err = + function + | Result.Ok x -> ok x + | Error errs -> Errors (err :: List.map of_tz_error errs) + +let trace_tzresult_lwt err (x:_ TP.Error_monad.tzresult Lwt.t) : _ result = + trace_tzresult err @@ Lwt_main.run x + +let generic_try err f = + try ( + ok @@ f () + ) with _ -> fail err + +let specific_try handler f = + try ( + ok @@ f () + ) with exn -> fail (handler exn) + +let sequence f lst = + let rec aux acc = function + | hd :: tl -> ( + match f hd with + | Ok x -> aux (x :: acc) tl + | Errors _ as errs -> errs + ) + | [] -> ok @@ List.rev acc in + aux [] lst + +let error_pp fmt error = + if error.message = "" + then Format.fprintf fmt "%s" error.title + else Format.fprintf fmt "%s : %s" error.title error.message + +let error_pp_short fmt error = + Format.fprintf fmt "%s" error.title + +let errors_pp = + Format.pp_print_list + ~pp_sep:Format.pp_print_newline + error_pp + +let errors_pp_short = + Format.pp_print_list + ~pp_sep:Format.pp_print_newline + error_pp_short + +let pp_to_string pp () x = + Format.fprintf Format.str_formatter "%a" pp x ; + Format.flush_str_formatter () + +let errors_to_string = pp_to_string errors_pp + +module Assert = struct + let assert_true ~msg = function + | true -> ok () + | false -> simple_fail msg + + let assert_equal_int ?msg a b = + let msg = Option.unopt ~default:"not equal int" msg in + assert_true ~msg (a = b) + + let assert_list_size ~msg lst n = + assert_true ~msg (List.length lst = n) + + let assert_list_size_2 ~msg = function + | [a;b] -> ok (a, b) + | _ -> simple_fail msg + + let assert_list_size_1 ~msg = function + | [a] -> ok a + | _ -> simple_fail msg +end diff --git a/src/lib_ligo/src/helpers/wrap.ml b/src/lib_ligo/src/helpers/wrap.ml new file mode 100644 index 000000000..2a9b1eab4 --- /dev/null +++ b/src/lib_ligo/src/helpers/wrap.ml @@ -0,0 +1,21 @@ +module Make (P : sig type meta end) = struct + type meta = P.meta + type 'value t = { + value : 'value ; + meta : meta ; + } + + let make meta value = { value ; meta } + let value t = t.value + let meta t = t.meta + + let apply : ('a -> 'b) -> 'a t -> 'b = fun f x -> f x.value +end + +module Location = struct + include Make(struct type meta = Location.t end) + + let make_f f : loc:_ -> _ -> _ t = fun ~loc x -> make loc (f x) + let make ~loc x : _ t = make loc x + let update_location ~loc t = {t with meta = loc} +end diff --git a/src/ligo/helpers/dictionary.ml b/src/ligo/helpers/dictionary.ml new file mode 100644 index 000000000..a4badb866 --- /dev/null +++ b/src/ligo/helpers/dictionary.ml @@ -0,0 +1,33 @@ +open Trace + +type ('a, 'b) t = ('a * 'b) list + +let get_exn x y = List.assoc y x + +let get x y = generic_try (simple_error "Dictionry.get") @@ fun () -> get_exn x y + +let set ?equal lst a b = + let equal : 'a -> 'a -> bool = + Option.unopt + ~default:(=) equal + in + let rec aux acc = function + | [] -> List.rev acc + | (key, _)::tl when equal key a -> aux ((key, b) :: acc) tl + | hd::tl -> aux (hd :: acc) tl + in + aux [] lst + +let del ?equal lst a = + let equal : 'a -> 'a -> bool = + Option.unopt + ~default:(=) equal + in + let rec aux acc = function + | [] -> List.rev acc + | (key, _)::tl when equal key a -> aux acc tl + | hd::tl -> aux (hd :: acc) tl + in + aux [] lst + +let to_list x = x diff --git a/src/ligo/helpers/dictionary.mli b/src/ligo/helpers/dictionary.mli new file mode 100644 index 000000000..10204b467 --- /dev/null +++ b/src/ligo/helpers/dictionary.mli @@ -0,0 +1,16 @@ +open Trace + +type ('a, 'b) t + +val get_exn : ('a, 'b) t -> 'a -> 'b +val get : ('a, 'b) t -> 'a -> 'b result + +val set : + ?equal:('a -> 'a -> bool) -> + ('a, 'b) t -> 'a -> 'b -> ('a, 'b) t + +val del : + ?equal:('a -> 'a -> bool) -> + ('a, 'b) t -> 'a -> ('a, 'b) t + +val to_list : ('a, 'b) t -> ('a * 'b) list diff --git a/src/ligo/helpers/dune b/src/ligo/helpers/dune new file mode 100644 index 000000000..f3d586dbf --- /dev/null +++ b/src/ligo/helpers/dune @@ -0,0 +1,8 @@ +(library + (libraries + tezos-base + tezos-utils + ) + (name ligo_helpers) + (public_name ligo-helpers) +) diff --git a/src/ligo/helpers/environment.ml b/src/ligo/helpers/environment.ml new file mode 100644 index 000000000..ecb5839d2 --- /dev/null +++ b/src/ligo/helpers/environment.ml @@ -0,0 +1,53 @@ +module type PARAMETER = sig + type key + type value + val key_cmp : key -> key -> int + val value_cmp : value -> value -> int +end + +let parameter (type key value) ?key_cmp ?value_cmp () : (module PARAMETER with type key = key and type value = value) = + (module struct + type nonrec key = key + type nonrec value = value + let key_cmp = Option.unopt ~default:compare key_cmp + let value_cmp = Option.unopt ~default:compare value_cmp + end) + +let int_parameter = (parameter () : (module PARAMETER with type key = int and type value = int)) +module INT_PARAMETER = (val ((parameter () : (module PARAMETER with type key = int and type value = int)))) + +module type ENVIRONMENT = sig + type key + type value + type t + + val empty : t + val get_opt : t -> key -> value option + val gets : t -> key -> value list + val set : t -> key -> value -> t + val del : t -> key -> t +end + +module Make(P:PARAMETER) : ENVIRONMENT with type key = P.key and type value = P.value = struct + type key = P.key + type value = P.value + type t = (key * value) list + + let empty : t = [] + + let gets lst k = + let kvs = List.filter (fun (k', _) -> P.key_cmp k k' = 0) lst in + List.map snd kvs + let get_opt lst k = match gets lst k with + | [] -> None + | v :: _ -> Some v + + let set lst k v = (k, v) :: lst + + let del lst k = + let rec aux acc = function + | [] -> List.rev acc + | (key, _) :: tl when P.key_cmp key k = 0 -> List.rev acc @ tl + | hd :: tl -> aux (hd :: acc) tl in + aux [] lst +end diff --git a/src/ligo/helpers/ligo-helpers.opam b/src/ligo/helpers/ligo-helpers.opam new file mode 100644 index 000000000..8a47a95ff --- /dev/null +++ b/src/ligo/helpers/ligo-helpers.opam @@ -0,0 +1,22 @@ +name: "ligo-helpers" +opam-version: "2.0" +version: "1.0" +maintainer: "gabriel.alfour@gmail.com" +authors: [ "Galfour" ] +homepage: "https://gitlab.com/gabriel.alfour/tezos" +bug-reports: "https://gitlab.com/gabriel.alfour/tezos/issues" +dev-repo: "git+https://gitlab.com/gabriel.alfour/tezos.git" +license: "MIT" +depends: [ + "ocamlfind" { build } + "dune" { build & >= "1.0.1" } + "meta-michelson" + "tezos-utils" + "tezos-base" +] +build: [ + [ "dune" "build" "-p" name "-j" jobs ] +] +url { + src: "https://gitlab.com/gabriel.alfour/tezos/-/archive/master/tezos.tar.gz" +} diff --git a/src/ligo/helpers/location.ml b/src/ligo/helpers/location.ml new file mode 100644 index 000000000..776cd7f93 --- /dev/null +++ b/src/ligo/helpers/location.ml @@ -0,0 +1,24 @@ +type file_location = { + filename : string ; + start_line : int ; + start_column : int ; + end_line : int ; + end_column : int ; +} + +type virtual_location = string + +type t = + | File of file_location + | Virtual of virtual_location + +let make (start_pos:Lexing.position) (end_pos:Lexing.position) : t = + let filename = start_pos.pos_fname in + let start_line = start_pos.pos_lnum in + let end_line = end_pos.pos_lnum in + let start_column = start_pos.pos_cnum - start_pos.pos_bol in + let end_column = end_pos.pos_cnum - end_pos.pos_bol in + File { filename ; start_line ; start_column ; end_line ; end_column } + +let virtual_location s = Virtual s +let dummy = virtual_location "dummy" diff --git a/src/ligo/helpers/option.ml b/src/ligo/helpers/option.ml new file mode 100644 index 000000000..4ee7859ff --- /dev/null +++ b/src/ligo/helpers/option.ml @@ -0,0 +1,3 @@ +let unopt ~default = function + | None -> default + | Some x -> x diff --git a/src/ligo/helpers/trace.ml b/src/ligo/helpers/trace.ml new file mode 100644 index 000000000..a99e7ea8b --- /dev/null +++ b/src/ligo/helpers/trace.ml @@ -0,0 +1,157 @@ +type error = { + message : string ; + title : string ; +} + +type 'a result = + Ok of 'a + | Errors of error list + +let ok x = Ok x +let fail err = Errors [err] + +let simple_error str = { + message = "" ; + title = str ; +} + +let error title message = { title ; message } + +let simple_fail str = fail @@ simple_error str + +let map f = function + | Ok x -> f x + | Errors _ as e -> e + +let apply f = function + | Ok x -> Ok (f x) + | Errors _ as e -> e + +let (>>?) x f = map f x +let (>>|?) = apply + +module Let_syntax = struct + let bind m ~f = m >>? f +end + +let trace err = function + | Ok _ as o -> o + | Errors errs -> Errors (err :: errs) + +let trace_option error = function + | None -> fail error + | Some s -> ok s + +let rec bind_list = function + | [] -> ok [] + | hd :: tl -> ( + hd >>? fun hd -> + bind_list tl >>? fun tl -> + ok @@ hd :: tl + ) + +let bind_or (a, b) = + match a with + | Ok x -> ok x + | _ -> b + +let bind_lr (type a b) ((a : a result), (b:b result)) : [`Left of a | `Right of b] result = + match (a, b) with + | Ok x, _ -> ok @@ `Left x + | _, Ok x -> ok @@ `Right x + | _, Errors b -> Errors b + +let bind_and (a, b) = + a >>? fun a -> + b >>? fun b -> + ok (a, b) + +module AE = Tezos_utils.Memory_proto_alpha.Alpha_environment +module TP = Tezos_base__TzPervasives + +let of_tz_error (err:Tezos_utils.Error_monad.error) : error = + let str = Tezos_utils.Error_monad.(to_string err) in + error "alpha error" str + +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 + | Error errs -> Errors (err :: List.map of_alpha_tz_error errs) + +let trace_alpha_tzresult_lwt error (x:_ AE.Error_monad.tzresult Lwt.t) : _ result = + trace_alpha_tzresult error @@ Lwt_main.run x + +let trace_tzresult err = + function + | Result.Ok x -> ok x + | Error errs -> Errors (err :: List.map of_tz_error errs) + +let trace_tzresult_lwt err (x:_ TP.Error_monad.tzresult Lwt.t) : _ result = + trace_tzresult err @@ Lwt_main.run x + +let generic_try err f = + try ( + ok @@ f () + ) with _ -> fail err + +let specific_try handler f = + try ( + ok @@ f () + ) with exn -> fail (handler exn) + +let sequence f lst = + let rec aux acc = function + | hd :: tl -> ( + match f hd with + | Ok x -> aux (x :: acc) tl + | Errors _ as errs -> errs + ) + | [] -> ok @@ List.rev acc in + aux [] lst + +let error_pp fmt error = + if error.message = "" + then Format.fprintf fmt "%s" error.title + else Format.fprintf fmt "%s : %s" error.title error.message + +let error_pp_short fmt error = + Format.fprintf fmt "%s" error.title + +let errors_pp = + Format.pp_print_list + ~pp_sep:Format.pp_print_newline + error_pp + +let errors_pp_short = + Format.pp_print_list + ~pp_sep:Format.pp_print_newline + error_pp_short + +let pp_to_string pp () x = + Format.fprintf Format.str_formatter "%a" pp x ; + Format.flush_str_formatter () + +let errors_to_string = pp_to_string errors_pp + +module Assert = struct + let assert_true ~msg = function + | true -> ok () + | false -> simple_fail msg + + let assert_equal_int ?msg a b = + let msg = Option.unopt ~default:"not equal int" msg in + assert_true ~msg (a = b) + + let assert_list_size ~msg lst n = + assert_true ~msg (List.length lst = n) + + let assert_list_size_2 ~msg = function + | [a;b] -> ok (a, b) + | _ -> simple_fail msg + + let assert_list_size_1 ~msg = function + | [a] -> ok a + | _ -> simple_fail msg +end diff --git a/src/ligo/helpers/wrap.ml b/src/ligo/helpers/wrap.ml new file mode 100644 index 000000000..2a9b1eab4 --- /dev/null +++ b/src/ligo/helpers/wrap.ml @@ -0,0 +1,21 @@ +module Make (P : sig type meta end) = struct + type meta = P.meta + type 'value t = { + value : 'value ; + meta : meta ; + } + + let make meta value = { value ; meta } + let value t = t.value + let meta t = t.meta + + let apply : ('a -> 'b) -> 'a t -> 'b = fun f x -> f x.value +end + +module Location = struct + include Make(struct type meta = Location.t end) + + let make_f f : loc:_ -> _ -> _ t = fun ~loc x -> make loc (f x) + let make ~loc x : _ t = make loc x + let update_location ~loc t = {t with meta = loc} +end