ligo/vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_primitives.ml

(*****************************************************************************)
(*                                                                           *)
(* Open Source License                                                       *)
(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
(*                                                                           *)
(* Permission is hereby granted, free of charge, to any person obtaining a   *)
(* copy of this software and associated documentation files (the "Software"),*)
(* to deal in the Software without restriction, including without limitation *)
(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)
(* and/or sell copies of the Software, and to permit persons to whom the     *)
(* Software is furnished to do so, subject to the following conditions:      *)
(*                                                                           *)
(* The above copyright notice and this permission notice shall be included   *)
(* in all copies or substantial portions of the Software.                    *)
(*                                                                           *)
(* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)
(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)
(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)
(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)
(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)
(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)
(* DEALINGS IN THE SOFTWARE.                                                 *)
(*                                                                           *)
(*****************************************************************************)

open Micheline

type error += Unknown_primitive_name of string

type error += Invalid_case of string

type error +=
  | Invalid_primitive_name of
      string Micheline.canonical * Micheline.canonical_location

type prim =
  | K_parameter
  | K_storage
  | K_code
  | D_False
  | D_Elt
  | D_Left
  | D_None
  | D_Pair
  | D_Right
  | D_Some
  | D_True
  | D_Unit
  | I_PACK
  | I_UNPACK
  | I_BLAKE2B
  | I_SHA256
  | I_SHA512
  | I_ABS
  | I_ADD
  | I_AMOUNT
  | I_AND
  | I_BALANCE
  | I_CAR
  | I_CDR
  | I_CHAIN_ID
  | I_CHECK_SIGNATURE
  | I_COMPARE
  | I_CONCAT
  | I_CONS
  | I_CREATE_ACCOUNT
  | I_CREATE_CONTRACT
  | I_IMPLICIT_ACCOUNT
  | I_DIP
  | I_DROP
  | I_DUP
  | I_EDIV
  | I_EMPTY_BIG_MAP
  | I_EMPTY_MAP
  | I_EMPTY_SET
  | I_EQ
  | I_EXEC
  | I_APPLY
  | I_FAILWITH
  | I_GE
  | I_GET
  | I_GT
  | I_HASH_KEY
  | I_IF
  | I_IF_CONS
  | I_IF_LEFT
  | I_IF_NONE
  | I_INT
  | I_LAMBDA
  | I_LE
  | I_LEFT
  | I_LOOP
  | I_LSL
  | I_LSR
  | I_LT
  | I_MAP
  | I_MEM
  | I_MUL
  | I_NEG
  | I_NEQ
  | I_NIL
  | I_NONE
  | I_NOT
  | I_NOW
  | I_OR
  | I_PAIR
  | I_PUSH
  | I_RIGHT
  | I_SIZE
  | I_SOME
  | I_SOURCE
  | I_SENDER
  | I_SELF
  | I_SLICE
  | I_STEPS_TO_QUOTA
  | I_SUB
  | I_SWAP
  | I_TRANSFER_TOKENS
  | I_SET_DELEGATE
  | I_UNIT
  | I_UPDATE
  | I_XOR
  | I_ITER
  | I_LOOP_LEFT
  | I_ADDRESS
  | I_CONTRACT
  | I_ISNAT
  | I_CAST
  | I_RENAME
  | I_DIG
  | I_DUG
  | T_bool
  | T_contract
  | T_int
  | T_key
  | T_key_hash
  | T_lambda
  | T_list
  | T_map
  | T_big_map
  | T_nat
  | T_option
  | T_or
  | T_pair
  | T_set
  | T_signature
  | T_string
  | T_bytes
  | T_mutez
  | T_timestamp
  | T_unit
  | T_operation
  | T_address
  | T_chain_id

let valid_case name =
  let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in
  let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in
  let rec for_all a b f =
    Compare.Int.(a > b) || (f a && for_all (a + 1) b f)
  in
  let len = String.length name in
  Compare.Int.(len <> 0)
  && Compare.Char.(name.[0] <> '_')
  && ( (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_upper name.[i]))
     || (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
     || (is_lower name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))
     )

let string_of_prim = function
  | K_parameter ->
      "parameter"
  | K_storage ->
      "storage"
  | K_code ->
      "code"
  | D_False ->
      "False"
  | D_Elt ->
      "Elt"
  | D_Left ->
      "Left"
  | D_None ->
      "None"
  | D_Pair ->
      "Pair"
  | D_Right ->
      "Right"
  | D_Some ->
      "Some"
  | D_True ->
      "True"
  | D_Unit ->
      "Unit"
  | I_PACK ->
      "PACK"
  | I_UNPACK ->
      "UNPACK"
  | I_BLAKE2B ->
      "BLAKE2B"
  | I_SHA256 ->
      "SHA256"
  | I_SHA512 ->
      "SHA512"
  | I_ABS ->
      "ABS"
  | I_ADD ->
      "ADD"
  | I_AMOUNT ->
      "AMOUNT"
  | I_AND ->
      "AND"
  | I_BALANCE ->
      "BALANCE"
  | I_CAR ->
      "CAR"
  | I_CDR ->
      "CDR"
  | I_CHAIN_ID ->
      "CHAIN_ID"
  | I_CHECK_SIGNATURE ->
      "CHECK_SIGNATURE"
  | I_COMPARE ->
      "COMPARE"
  | I_CONCAT ->
      "CONCAT"
  | I_CONS ->
      "CONS"
  | I_CREATE_ACCOUNT ->
      "CREATE_ACCOUNT"
  | I_CREATE_CONTRACT ->
      "CREATE_CONTRACT"
  | I_IMPLICIT_ACCOUNT ->
      "IMPLICIT_ACCOUNT"
  | I_DIP ->
      "DIP"
  | I_DROP ->
      "DROP"
  | I_DUP ->
      "DUP"
  | I_EDIV ->
      "EDIV"
  | I_EMPTY_BIG_MAP ->
      "EMPTY_BIG_MAP"
  | I_EMPTY_MAP ->
      "EMPTY_MAP"
  | I_EMPTY_SET ->
      "EMPTY_SET"
  | I_EQ ->
      "EQ"
  | I_EXEC ->
      "EXEC"
  | I_APPLY ->
      "APPLY"
  | I_FAILWITH ->
      "FAILWITH"
  | I_GE ->
      "GE"
  | I_GET ->
      "GET"
  | I_GT ->
      "GT"
  | I_HASH_KEY ->
      "HASH_KEY"
  | I_IF ->
      "IF"
  | I_IF_CONS ->
      "IF_CONS"
  | I_IF_LEFT ->
      "IF_LEFT"
  | I_IF_NONE ->
      "IF_NONE"
  | I_INT ->
      "INT"
  | I_LAMBDA ->
      "LAMBDA"
  | I_LE ->
      "LE"
  | I_LEFT ->
      "LEFT"
  | I_LOOP ->
      "LOOP"
  | I_LSL ->
      "LSL"
  | I_LSR ->
      "LSR"
  | I_LT ->
      "LT"
  | I_MAP ->
      "MAP"
  | I_MEM ->
      "MEM"
  | I_MUL ->
      "MUL"
  | I_NEG ->
      "NEG"
  | I_NEQ ->
      "NEQ"
  | I_NIL ->
      "NIL"
  | I_NONE ->
      "NONE"
  | I_NOT ->
      "NOT"
  | I_NOW ->
      "NOW"
  | I_OR ->
      "OR"
  | I_PAIR ->
      "PAIR"
  | I_PUSH ->
      "PUSH"
  | I_RIGHT ->
      "RIGHT"
  | I_SIZE ->
      "SIZE"
  | I_SOME ->
      "SOME"
  | I_SOURCE ->
      "SOURCE"
  | I_SENDER ->
      "SENDER"
  | I_SELF ->
      "SELF"
  | I_SLICE ->
      "SLICE"
  | I_STEPS_TO_QUOTA ->
      "STEPS_TO_QUOTA"
  | I_SUB ->
      "SUB"
  | I_SWAP ->
      "SWAP"
  | I_TRANSFER_TOKENS ->
      "TRANSFER_TOKENS"
  | I_SET_DELEGATE ->
      "SET_DELEGATE"
  | I_UNIT ->
      "UNIT"
  | I_UPDATE ->
      "UPDATE"
  | I_XOR ->
      "XOR"
  | I_ITER ->
      "ITER"
  | I_LOOP_LEFT ->
      "LOOP_LEFT"
  | I_ADDRESS ->
      "ADDRESS"
  | I_CONTRACT ->
      "CONTRACT"
  | I_ISNAT ->
      "ISNAT"
  | I_CAST ->
      "CAST"
  | I_RENAME ->
      "RENAME"
  | I_DIG ->
      "DIG"
  | I_DUG ->
      "DUG"
  | T_bool ->
      "bool"
  | T_contract ->
      "contract"
  | T_int ->
      "int"
  | T_key ->
      "key"
  | T_key_hash ->
      "key_hash"
  | T_lambda ->
      "lambda"
  | T_list ->
      "list"
  | T_map ->
      "map"
  | T_big_map ->
      "big_map"
  | T_nat ->
      "nat"
  | T_option ->
      "option"
  | T_or ->
      "or"
  | T_pair ->
      "pair"
  | T_set ->
      "set"
  | T_signature ->
      "signature"
  | T_string ->
      "string"
  | T_bytes ->
      "bytes"
  | T_mutez ->
      "mutez"
  | T_timestamp ->
      "timestamp"
  | T_unit ->
      "unit"
  | T_operation ->
      "operation"
  | T_address ->
      "address"
  | T_chain_id ->
      "chain_id"

let prim_of_string = function
  | "parameter" ->
      ok K_parameter
  | "storage" ->
      ok K_storage
  | "code" ->
      ok K_code
  | "False" ->
      ok D_False
  | "Elt" ->
      ok D_Elt
  | "Left" ->
      ok D_Left
  | "None" ->
      ok D_None
  | "Pair" ->
      ok D_Pair
  | "Right" ->
      ok D_Right
  | "Some" ->
      ok D_Some
  | "True" ->
      ok D_True
  | "Unit" ->
      ok D_Unit
  | "PACK" ->
      ok I_PACK
  | "UNPACK" ->
      ok I_UNPACK
  | "BLAKE2B" ->
      ok I_BLAKE2B
  | "SHA256" ->
      ok I_SHA256
  | "SHA512" ->
      ok I_SHA512
  | "ABS" ->
      ok I_ABS
  | "ADD" ->
      ok I_ADD
  | "AMOUNT" ->
      ok I_AMOUNT
  | "AND" ->
      ok I_AND
  | "BALANCE" ->
      ok I_BALANCE
  | "CAR" ->
      ok I_CAR
  | "CDR" ->
      ok I_CDR
  | "CHAIN_ID" ->
      ok I_CHAIN_ID
  | "CHECK_SIGNATURE" ->
      ok I_CHECK_SIGNATURE
  | "COMPARE" ->
      ok I_COMPARE
  | "CONCAT" ->
      ok I_CONCAT
  | "CONS" ->
      ok I_CONS
  | "CREATE_ACCOUNT" ->
      ok I_CREATE_ACCOUNT
  | "CREATE_CONTRACT" ->
      ok I_CREATE_CONTRACT
  | "IMPLICIT_ACCOUNT" ->
      ok I_IMPLICIT_ACCOUNT
  | "DIP" ->
      ok I_DIP
  | "DROP" ->
      ok I_DROP
  | "DUP" ->
      ok I_DUP
  | "EDIV" ->
      ok I_EDIV
  | "EMPTY_BIG_MAP" ->
      ok I_EMPTY_BIG_MAP
  | "EMPTY_MAP" ->
      ok I_EMPTY_MAP
  | "EMPTY_SET" ->
      ok I_EMPTY_SET
  | "EQ" ->
      ok I_EQ
  | "EXEC" ->
      ok I_EXEC
  | "APPLY" ->
      ok I_APPLY
  | "FAILWITH" ->
      ok I_FAILWITH
  | "GE" ->
      ok I_GE
  | "GET" ->
      ok I_GET
  | "GT" ->
      ok I_GT
  | "HASH_KEY" ->
      ok I_HASH_KEY
  | "IF" ->
      ok I_IF
  | "IF_CONS" ->
      ok I_IF_CONS
  | "IF_LEFT" ->
      ok I_IF_LEFT
  | "IF_NONE" ->
      ok I_IF_NONE
  | "INT" ->
      ok I_INT
  | "LAMBDA" ->
      ok I_LAMBDA
  | "LE" ->
      ok I_LE
  | "LEFT" ->
      ok I_LEFT
  | "LOOP" ->
      ok I_LOOP
  | "LSL" ->
      ok I_LSL
  | "LSR" ->
      ok I_LSR
  | "LT" ->
      ok I_LT
  | "MAP" ->
      ok I_MAP
  | "MEM" ->
      ok I_MEM
  | "MUL" ->
      ok I_MUL
  | "NEG" ->
      ok I_NEG
  | "NEQ" ->
      ok I_NEQ
  | "NIL" ->
      ok I_NIL
  | "NONE" ->
      ok I_NONE
  | "NOT" ->
      ok I_NOT
  | "NOW" ->
      ok I_NOW
  | "OR" ->
      ok I_OR
  | "PAIR" ->
      ok I_PAIR
  | "PUSH" ->
      ok I_PUSH
  | "RIGHT" ->
      ok I_RIGHT
  | "SIZE" ->
      ok I_SIZE
  | "SOME" ->
      ok I_SOME
  | "SOURCE" ->
      ok I_SOURCE
  | "SENDER" ->
      ok I_SENDER
  | "SELF" ->
      ok I_SELF
  | "SLICE" ->
      ok I_SLICE
  | "STEPS_TO_QUOTA" ->
      ok I_STEPS_TO_QUOTA
  | "SUB" ->
      ok I_SUB
  | "SWAP" ->
      ok I_SWAP
  | "TRANSFER_TOKENS" ->
      ok I_TRANSFER_TOKENS
  | "SET_DELEGATE" ->
      ok I_SET_DELEGATE
  | "UNIT" ->
      ok I_UNIT
  | "UPDATE" ->
      ok I_UPDATE
  | "XOR" ->
      ok I_XOR
  | "ITER" ->
      ok I_ITER
  | "LOOP_LEFT" ->
      ok I_LOOP_LEFT
  | "ADDRESS" ->
      ok I_ADDRESS
  | "CONTRACT" ->
      ok I_CONTRACT
  | "ISNAT" ->
      ok I_ISNAT
  | "CAST" ->
      ok I_CAST
  | "RENAME" ->
      ok I_RENAME
  | "DIG" ->
      ok I_DIG
  | "DUG" ->
      ok I_DUG
  | "bool" ->
      ok T_bool
  | "contract" ->
      ok T_contract
  | "int" ->
      ok T_int
  | "key" ->
      ok T_key
  | "key_hash" ->
      ok T_key_hash
  | "lambda" ->
      ok T_lambda
  | "list" ->
      ok T_list
  | "map" ->
      ok T_map
  | "big_map" ->
      ok T_big_map
  | "nat" ->
      ok T_nat
  | "option" ->
      ok T_option
  | "or" ->
      ok T_or
  | "pair" ->
      ok T_pair
  | "set" ->
      ok T_set
  | "signature" ->
      ok T_signature
  | "string" ->
      ok T_string
  | "bytes" ->
      ok T_bytes
  | "mutez" ->
      ok T_mutez
  | "timestamp" ->
      ok T_timestamp
  | "unit" ->
      ok T_unit
  | "operation" ->
      ok T_operation
  | "address" ->
      ok T_address
  | "chain_id" ->
      ok T_chain_id
  | n ->
      if valid_case n then error (Unknown_primitive_name n)
      else error (Invalid_case n)

let prims_of_strings expr =
  let rec convert = function
    | (Int _ | String _ | Bytes _) as expr ->
        ok expr
    | Prim (loc, prim, args, annot) ->
        Error_monad.record_trace
          (Invalid_primitive_name (expr, loc))
          (prim_of_string prim)
        >>? fun prim ->
        List.fold_left
          (fun acc arg ->
            acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
          (ok [])
          args
        >>? fun args -> ok (Prim (0, prim, List.rev args, annot))
    | Seq (_, args) ->
        List.fold_left
          (fun acc arg ->
            acc >>? fun args -> convert arg >>? fun arg -> ok (arg :: args))
          (ok [])
          args
        >>? fun args -> ok (Seq (0, List.rev args))
  in
  convert (root expr) >>? fun expr -> ok (strip_locations expr)

let strings_of_prims expr =
  let rec convert = function
    | (Int _ | String _ | Bytes _) as expr ->
        expr
    | Prim (_, prim, args, annot) ->
        let prim = string_of_prim prim in
        let args = List.map convert args in
        Prim (0, prim, args, annot)
    | Seq (_, args) ->
        let args = List.map convert args in
        Seq (0, args)
  in
  strip_locations (convert (root expr))

let prim_encoding =
  let open Data_encoding in
  def "michelson.v1.primitives"
  @@ string_enum
       [ (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("parameter", K_parameter);
         ("storage", K_storage);
         ("code", K_code);
         ("False", D_False);
         ("Elt", D_Elt);
         ("Left", D_Left);
         ("None", D_None);
         ("Pair", D_Pair);
         ("Right", D_Right);
         ("Some", D_Some);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("True", D_True);
         ("Unit", D_Unit);
         ("PACK", I_PACK);
         ("UNPACK", I_UNPACK);
         ("BLAKE2B", I_BLAKE2B);
         ("SHA256", I_SHA256);
         ("SHA512", I_SHA512);
         ("ABS", I_ABS);
         ("ADD", I_ADD);
         ("AMOUNT", I_AMOUNT);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("AND", I_AND);
         ("BALANCE", I_BALANCE);
         ("CAR", I_CAR);
         ("CDR", I_CDR);
         ("CHECK_SIGNATURE", I_CHECK_SIGNATURE);
         ("COMPARE", I_COMPARE);
         ("CONCAT", I_CONCAT);
         ("CONS", I_CONS);
         ("CREATE_ACCOUNT", I_CREATE_ACCOUNT);
         ("CREATE_CONTRACT", I_CREATE_CONTRACT);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("IMPLICIT_ACCOUNT", I_IMPLICIT_ACCOUNT);
         ("DIP", I_DIP);
         ("DROP", I_DROP);
         ("DUP", I_DUP);
         ("EDIV", I_EDIV);
         ("EMPTY_MAP", I_EMPTY_MAP);
         ("EMPTY_SET", I_EMPTY_SET);
         ("EQ", I_EQ);
         ("EXEC", I_EXEC);
         ("FAILWITH", I_FAILWITH);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("GE", I_GE);
         ("GET", I_GET);
         ("GT", I_GT);
         ("HASH_KEY", I_HASH_KEY);
         ("IF", I_IF);
         ("IF_CONS", I_IF_CONS);
         ("IF_LEFT", I_IF_LEFT);
         ("IF_NONE", I_IF_NONE);
         ("INT", I_INT);
         ("LAMBDA", I_LAMBDA);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("LE", I_LE);
         ("LEFT", I_LEFT);
         ("LOOP", I_LOOP);
         ("LSL", I_LSL);
         ("LSR", I_LSR);
         ("LT", I_LT);
         ("MAP", I_MAP);
         ("MEM", I_MEM);
         ("MUL", I_MUL);
         ("NEG", I_NEG);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("NEQ", I_NEQ);
         ("NIL", I_NIL);
         ("NONE", I_NONE);
         ("NOT", I_NOT);
         ("NOW", I_NOW);
         ("OR", I_OR);
         ("PAIR", I_PAIR);
         ("PUSH", I_PUSH);
         ("RIGHT", I_RIGHT);
         ("SIZE", I_SIZE);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("SOME", I_SOME);
         ("SOURCE", I_SOURCE);
         ("SENDER", I_SENDER);
         ("SELF", I_SELF);
         ("STEPS_TO_QUOTA", I_STEPS_TO_QUOTA);
         ("SUB", I_SUB);
         ("SWAP", I_SWAP);
         ("TRANSFER_TOKENS", I_TRANSFER_TOKENS);
         ("SET_DELEGATE", I_SET_DELEGATE);
         ("UNIT", I_UNIT);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("UPDATE", I_UPDATE);
         ("XOR", I_XOR);
         ("ITER", I_ITER);
         ("LOOP_LEFT", I_LOOP_LEFT);
         ("ADDRESS", I_ADDRESS);
         ("CONTRACT", I_CONTRACT);
         ("ISNAT", I_ISNAT);
         ("CAST", I_CAST);
         ("RENAME", I_RENAME);
         ("bool", T_bool);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("contract", T_contract);
         ("int", T_int);
         ("key", T_key);
         ("key_hash", T_key_hash);
         ("lambda", T_lambda);
         ("list", T_list);
         ("map", T_map);
         ("big_map", T_big_map);
         ("nat", T_nat);
         ("option", T_option);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("or", T_or);
         ("pair", T_pair);
         ("set", T_set);
         ("signature", T_signature);
         ("string", T_string);
         ("bytes", T_bytes);
         ("mutez", T_mutez);
         ("timestamp", T_timestamp);
         ("unit", T_unit);
         ("operation", T_operation);
         (* /!\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)
         ("address", T_address);
         (* Alpha_002 addition *)
         ("SLICE", I_SLICE);
         (* Alpha_005 addition *)
         ("DIG", I_DIG);
         ("DUG", I_DUG);
         ("EMPTY_BIG_MAP", I_EMPTY_BIG_MAP);
         ("APPLY", I_APPLY);
         ("chain_id", T_chain_id);
         ("CHAIN_ID", I_CHAIN_ID)
         (* New instructions must be added here, for backward compatibility of the encoding. *)
        ]

let () =
  register_error_kind
    `Permanent
    ~id:"michelson_v1.unknown_primitive_name"
    ~title:"Unknown primitive name"
    ~description:"In a script or data expression, a primitive was unknown."
    ~pp:(fun ppf n -> Format.fprintf ppf "Unknown primitive %s." n)
    Data_encoding.(obj1 (req "wrong_primitive_name" string))
    (function Unknown_primitive_name got -> Some got | _ -> None)
    (fun got -> Unknown_primitive_name got) ;
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive_name_case"
    ~title:"Invalid primitive name case"
    ~description:
      "In a script or data expression, a primitive name is neither uppercase, \
       lowercase or capitalized."
    ~pp:(fun ppf n -> Format.fprintf ppf "Primitive %s has invalid case." n)
    Data_encoding.(obj1 (req "wrong_primitive_name" string))
    (function Invalid_case name -> Some name | _ -> None)
    (fun name -> Invalid_case name) ;
  register_error_kind
    `Permanent
    ~id:"michelson_v1.invalid_primitive_name"
    ~title:"Invalid primitive name"
    ~description:
      "In a script or data expression, a primitive name is unknown or has a \
       wrong case."
    ~pp:(fun ppf _ -> Format.fprintf ppf "Invalid primitive.")
    Data_encoding.(
      obj2
        (req
           "expression"
           (Micheline.canonical_encoding ~variant:"generic" string))
        (req "location" Micheline.canonical_location_encoding))
    (function
      | Invalid_primitive_name (expr, loc) -> Some (expr, loc) | _ -> None)
    (fun (expr, loc) -> Invalid_primitive_name (expr, loc))