Skip to content

Instantly share code, notes, and snippets.

@smondet smondet/example.ml
Last active Jun 23, 2020

Embed
What would you like to do?
Data for michokit blog post
(* Generated code for
pair (pair (nat %some_counter) (string %some_name))
(or %a_variant_thing (bytes %some_data) (key %the_key))
*)
module Big_int = struct
include Big_int
let equal_big_int = eq_big_int
let pp_big_int ppf bi = Format.pp_print_string ppf (string_of_big_int bi)
type t = big_int [@@deriving show, eq]
(* no layout here *)
end
module Pairing_layout = struct
type t = [ `P of t * t | `V ] [@@deriving show, eq]
(* no layout here *)
end
module Result_extras = struct
let ( >>= ) x f = match x with Ok o -> f o | Error _ as e -> e
end
module Json_value = struct
type t =
[ `A of t list
| `Bool of bool
| `Float of float
| `Null
| `O of (string * t) list
| `String of string ]
[@@deriving show, eq]
type parse_error = [ `Of_json of string * t ] [@@deriving show, eq]
(* no layout here *)
end
module M_nat = struct
type t = Int of int | Big_int of Big_int.t [@@deriving show, eq]
(* no layout here *)
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string = function
| Int x -> string_of_int x
| Big_int x -> Big_int.string_of_big_int x
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O [ ("int", `String s) ] as j -> (
try Ok (Int (int_of_string s))
with _ -> Error (`Of_json ("int_of_string exception for Int", j)) )
| other -> Error (`Of_json ("wrong json for M_nat", other))
end
module M_string = struct
type t = Raw_string of string | Raw_hex_bytes of string
[@@deriving show, eq]
(* no layout here *)
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string = function
| Raw_string x -> (Printf.sprintf "%S") x
| Raw_hex_bytes x -> (fun x -> x) x
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O [ ("string", `String s) ] -> Ok (Raw_string s)
| `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
| other -> Error (`Of_json ("wrong json for M_string", other))
end
module M_bytes = struct
type t = Raw_string of string | Raw_hex_bytes of string
[@@deriving show, eq]
(* no layout here *)
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string = function
| Raw_string x -> (Printf.sprintf "%S") x
| Raw_hex_bytes x -> (fun x -> x) x
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O [ ("string", `String s) ] -> Ok (Raw_string s)
| `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
| other -> Error (`Of_json ("wrong json for M_bytes", other))
end
module M_key = struct
type t = Raw_b58 of string | Raw_hex_bytes of string [@@deriving show, eq]
(* no layout here *)
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string = function
| Raw_b58 x -> (Printf.sprintf "%S") x
| Raw_hex_bytes x -> (fun x -> x) x
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O [ ("string", `String s) ] -> Ok (Raw_b58 s)
| `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
| other -> Error (`Of_json ("wrong json for M_key", other))
end
module A_variant_thing = struct
open! Result_extras
type t = Some_data of M_bytes.t | The_key of M_key.t [@@deriving show, eq]
let layout () : Pairing_layout.t = `P (`V, `V)
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string =
fun x ->
match x with
| Some_data x -> Printf.sprintf "(Left %s)" (M_bytes.to_concrete x)
| The_key x -> Printf.sprintf "(Right %s)" (M_key.to_concrete x)
(** Like {!to_concrete} but assume this variant is defining an entry point (i.e. forget about the [Left|Right] wrapping). *)
let to_concrete_entry_point : t -> [ `Name of string ] * [ `Literal of string ]
=
fun x ->
match x with
| Some_data x -> (`Name "some_data", `Literal (M_bytes.to_concrete x))
| The_key x -> (`Name "the_key", `Literal (M_key.to_concrete x))
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O (("prim", `String "Right") :: ("args", `A [ the_key_v ]) :: _) ->
M_key.of_json the_key_v >>= fun the_key_v -> Ok (The_key the_key_v)
| `O (("prim", `String "Left") :: ("args", `A [ some_data_v ]) :: _) ->
M_bytes.of_json some_data_v >>= fun some_data_v ->
Ok (Some_data some_data_v)
| other -> Error (`Of_json ("wrong json for A_variant_thing", other))
end
module Storage = struct
open! Result_extras
type t = {
a_variant_thing : A_variant_thing.t;
some_counter : M_nat.t;
some_name : M_string.t;
}
[@@deriving show, eq, make]
let layout () : Pairing_layout.t = `P (`P (`V, `V), `V)
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string =
fun x ->
Printf.sprintf "(Pair %s %s)"
(Printf.sprintf "(Pair %s %s)"
(M_nat.to_concrete x.some_counter)
(M_string.to_concrete x.some_name))
(A_variant_thing.to_concrete x.a_variant_thing)
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O
(("prim", `String "Pair")
:: ( "args",
`A
[
`O
(("prim", `String "Pair")
:: ("args", `A [ some_counter; some_name ]) :: _);
a_variant_thing;
] )
:: _) ->
M_nat.of_json some_counter >>= fun some_counter ->
M_string.of_json some_name >>= fun some_name ->
A_variant_thing.of_json a_variant_thing >>= fun a_variant_thing ->
Ok { some_counter; some_name; a_variant_thing }
| other -> Error (`Of_json ("wrong json for Storage", other))
end
(* Generated code for
or (address %ep1) (or (signature %sign_stuff) (unit %default))
*)
(* Removed Big_int (duplicate) *)
(* Removed Pairing_layout (duplicate) *)
(* Removed Result_extras (duplicate) *)
(* Removed Json_value (duplicate) *)
module M_address = struct
type t = Raw_b58 of string | Raw_hex_bytes of string [@@deriving show, eq]
(* no layout here *)
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string = function
| Raw_b58 x -> (Printf.sprintf "%S") x
| Raw_hex_bytes x -> (fun x -> x) x
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O [ ("string", `String s) ] -> Ok (Raw_b58 s)
| `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
| other -> Error (`Of_json ("wrong json for M_address", other))
end
module M_signature = struct
type t = Raw_b58 of string | Raw_hex_bytes of string [@@deriving show, eq]
(* no layout here *)
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string = function
| Raw_b58 x -> (Printf.sprintf "%S") x
| Raw_hex_bytes x -> (fun x -> x) x
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O [ ("string", `String s) ] -> Ok (Raw_b58 s)
| `O [ ("bytes", `String s) ] -> Ok (Raw_hex_bytes s)
| other -> Error (`Of_json ("wrong json for M_signature", other))
end
module M_unit = struct
type t = Unit [@@deriving show, eq]
(* no layout here *)
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string = function Unit -> "Unit"
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O (("prim", `String "Unit") :: _) -> Ok Unit
| `O (_ :: ("prim", `String "Unit") :: _) -> Ok Unit
| other -> Error (`Of_json ("wrong json for M_unit", other))
end
module Parameter = struct
open! Result_extras
type t =
| Default of M_unit.t
| Ep1 of M_address.t
| Sign_stuff of M_signature.t
[@@deriving show, eq]
let layout () : Pairing_layout.t = `P (`V, `P (`V, `V))
(** Convert a value to a string in concrete Michelson syntax. *)
let to_concrete : t -> string =
fun x ->
match x with
| Ep1 x -> Printf.sprintf "(Left %s)" (M_address.to_concrete x)
| Sign_stuff x ->
Printf.sprintf "(Right (Left %s))" (M_signature.to_concrete x)
| Default x -> Printf.sprintf "(Right (Right %s))" (M_unit.to_concrete x)
(** Like {!to_concrete} but assume this variant is defining an entry point (i.e. forget about the [Left|Right] wrapping). *)
let to_concrete_entry_point : t -> [ `Name of string ] * [ `Literal of string ]
=
fun x ->
match x with
| Ep1 x -> (`Name "ep1", `Literal (M_address.to_concrete x))
| Sign_stuff x -> (`Name "sign_stuff", `Literal (M_signature.to_concrete x))
| Default x -> (`Name "default", `Literal (M_unit.to_concrete x))
(** Parse “micheline” JSON representation. *)
let of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result =
function
| `O
(("prim", `String "Right")
:: ( "args",
`A
[
`O
(("prim", `String "Right")
:: ("args", `A [ default_v ]) :: _);
] )
:: _) ->
M_unit.of_json default_v >>= fun default_v -> Ok (Default default_v)
| `O
(("prim", `String "Right")
:: ( "args",
`A
[
`O
(("prim", `String "Left")
:: ("args", `A [ sign_stuff_v ]) :: _);
] )
:: _) ->
M_signature.of_json sign_stuff_v >>= fun sign_stuff_v ->
Ok (Sign_stuff sign_stuff_v)
| `O (("prim", `String "Left") :: ("args", `A [ ep1_v ]) :: _) ->
M_address.of_json ep1_v >>= fun ep1_v -> Ok (Ep1 ep1_v)
| other -> Error (`Of_json ("wrong json for Parameter", other))
end
parameter
(or
(address %ep1)
(or
(signature %sign_stuff)
(unit %default)));
storage
(pair
(pair
(nat %some_counter)
(string %some_name))
(or %a_variant_thing (bytes %some_data) (key %the_key)));
code {FAILWITH};
module Big_int :
sig
type big_int = Big_int.big_int
val zero_big_int : big_int
val unit_big_int : big_int
val minus_big_int : big_int -> big_int
val abs_big_int : big_int -> big_int
val add_big_int : big_int -> big_int -> big_int
val succ_big_int : big_int -> big_int
val add_int_big_int : int -> big_int -> big_int
val sub_big_int : big_int -> big_int -> big_int
val pred_big_int : big_int -> big_int
val mult_big_int : big_int -> big_int -> big_int
val mult_int_big_int : int -> big_int -> big_int
val square_big_int : big_int -> big_int
val sqrt_big_int : big_int -> big_int
val quomod_big_int : big_int -> big_int -> big_int * big_int
val div_big_int : big_int -> big_int -> big_int
val mod_big_int : big_int -> big_int -> big_int
val gcd_big_int : big_int -> big_int -> big_int
val power_int_positive_int : int -> int -> big_int
val power_big_int_positive_int : big_int -> int -> big_int
val power_int_positive_big_int : int -> big_int -> big_int
val power_big_int_positive_big_int : big_int -> big_int -> big_int
val sign_big_int : big_int -> int
val compare_big_int : big_int -> big_int -> int
val eq_big_int : big_int -> big_int -> bool
val le_big_int : big_int -> big_int -> bool
val ge_big_int : big_int -> big_int -> bool
val lt_big_int : big_int -> big_int -> bool
val gt_big_int : big_int -> big_int -> bool
val max_big_int : big_int -> big_int -> big_int
val min_big_int : big_int -> big_int -> big_int
val num_digits_big_int : big_int -> int
val num_bits_big_int : big_int -> int
val string_of_big_int : big_int -> string
val big_int_of_string : string -> big_int
val big_int_of_string_opt : string -> big_int option
val big_int_of_int : int -> big_int
val is_int_big_int : big_int -> bool
val int_of_big_int : big_int -> int
val int_of_big_int_opt : big_int -> int option
val big_int_of_int32 : int32 -> big_int
val big_int_of_nativeint : nativeint -> big_int
val big_int_of_int64 : int64 -> big_int
val int32_of_big_int : big_int -> int32
val int32_of_big_int_opt : big_int -> int32 option
val nativeint_of_big_int : big_int -> nativeint
val nativeint_of_big_int_opt : big_int -> nativeint option
val int64_of_big_int : big_int -> int64
val int64_of_big_int_opt : big_int -> int64 option
val float_of_big_int : big_int -> float
val and_big_int : big_int -> big_int -> big_int
val or_big_int : big_int -> big_int -> big_int
val xor_big_int : big_int -> big_int -> big_int
val shift_left_big_int : big_int -> int -> big_int
val shift_right_big_int : big_int -> int -> big_int
val shift_right_towards_zero_big_int : big_int -> int -> big_int
val extract_big_int : big_int -> int -> int -> big_int
val nat_of_big_int : big_int -> Nat.nat
val big_int_of_nat : Nat.nat -> big_int
val base_power_big_int : int -> int -> big_int -> big_int
val sys_big_int_of_string : string -> int -> int -> big_int
val round_futur_last_digit : bytes -> int -> int -> bool
val approx_big_int : int -> big_int -> string
val round_big_int_to_float : big_int -> bool -> float
val equal_big_int : big_int -> big_int -> bool
val pp_big_int : Format.formatter -> big_int -> unit
type t = big_int
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
end
module Pairing_layout :
sig
type t = [ `P of t * t | `V ]
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
end
module Result_extras :
sig
val ( >>= ) :
('a, 'b) result -> ('a -> ('c, 'b) result) -> ('c, 'b) result
end
module Json_value :
sig
type t =
[ `A of t list
| `Bool of bool
| `Float of float
| `Null
| `O of (string * t) list
| `String of string ]
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
type parse_error = [ `Of_json of string * t ]
val pp_parse_error :
Ppx_deriving_runtime.Format.formatter ->
parse_error -> Ppx_deriving_runtime.unit
val show_parse_error : parse_error -> Ppx_deriving_runtime.string
val equal_parse_error :
parse_error -> parse_error -> Ppx_deriving_runtime.bool
end
module M_nat :
sig
type t = Int of int | Big_int of Big_int.t
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val to_concrete : t -> string
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
module M_string :
sig
type t = Raw_string of string | Raw_hex_bytes of string
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val to_concrete : t -> string
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
module M_bytes :
sig
type t = Raw_string of string | Raw_hex_bytes of string
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val to_concrete : t -> string
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
module M_key :
sig
type t = Raw_b58 of string | Raw_hex_bytes of string
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val to_concrete : t -> string
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
module A_variant_thing :
sig
type t = Some_data of M_bytes.t | The_key of M_key.t
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val layout : unit -> Pairing_layout.t
val to_concrete : t -> string
val to_concrete_entry_point :
t -> [ `Name of string ] * [ `Literal of string ]
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
module Storage :
sig
type t = {
a_variant_thing : A_variant_thing.t;
some_counter : M_nat.t;
some_name : M_string.t;
}
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val make :
a_variant_thing:A_variant_thing.t ->
some_counter:M_nat.t -> some_name:M_string.t -> t
val layout : unit -> Pairing_layout.t
val to_concrete : t -> string
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
module M_address :
sig
type t = Raw_b58 of string | Raw_hex_bytes of string
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val to_concrete : t -> string
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
module M_signature :
sig
type t = Raw_b58 of string | Raw_hex_bytes of string
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val to_concrete : t -> string
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
module M_unit :
sig
type t = Unit
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val to_concrete : t -> string
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
module Parameter :
sig
type t =
Default of M_unit.t
| Ep1 of M_address.t
| Sign_stuff of M_signature.t
val pp :
Ppx_deriving_runtime.Format.formatter -> t -> Ppx_deriving_runtime.unit
val show : t -> Ppx_deriving_runtime.string
val equal : t -> t -> Ppx_deriving_runtime.bool
val layout : unit -> Pairing_layout.t
val to_concrete : t -> string
val to_concrete_entry_point :
t -> [ `Name of string ] * [ `Literal of string ]
val of_json : Json_value.t -> (t, [> Json_value.parse_error ]) result
end
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.