🍬 Script_ir_translator.v

Translated OCaml

File generated by coq-of-ocaml

Records for the constructor parameters

Module ConstructorRecords_judgement.
  Module judgement.
    Module Failed.
      Record record {descr : Set} : Set := Build {
        descr : descr;
      }.
      Arguments record : clear implicits.
      Definition with_descr {t_descr} descr (r : record t_descr) :=
        Build t_descr descr.
    End Failed.
    Definition Failed_skeleton := Failed.record.
  End judgement.
End ConstructorRecords_judgement.
Import ConstructorRecords_judgement.

Reserved Notation "'judgement.Failed".

Inductive judgement : Set :=
| Typed : descr → judgement
| Failed : 'judgement.Failed → judgement

where "'judgement.Failed" :=
  (judgement.Failed_skeleton (Script_typed_ir.stack_ty → descr)).

Module judgement.
  Include ConstructorRecords_judgement.judgement.
  Definition Failed := 'judgement.Failed.
End judgement.

Module branch.
  Record record : Set := Build {
    branch : descr → descr → descr;
  }.
  Definition with_branch branch (r : record) :=
    Build branch.
End branch.
Definition branch := branch.record.

Definition merge_branches
  (ctxt : Alpha_context.context) (loc_value : Alpha_context.Script.location)
  (btr : judgement) (bfr : judgement) (function_parameter : branch)
  : M ? (judgement × Alpha_context.context ) :=
  let '{| branch.branch := branch |} := function_parameter in
  match (btr, bfr) with
  |
    (Typed ({| descr.aft := aftbt |} as dbt),
      Typed ({| descr.aft := aftbf |} as dbf)) ⇒
    let unmatched_branches (function_parameter : unit) : Error_monad._error :=
      let '_ := function_parameter in
      let aftbt := Script_ir_unparser.serialize_stack_for_error ctxt aftbt in
      let aftbf := Script_ir_unparser.serialize_stack_for_error ctxt aftbf in
      Build_extensible "Unmatched_branches"
        (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty ×
          Script_tc_errors.unparsed_stack_ty) (loc_value, aftbt, aftbf) in
    Error_monad.record_trace_eval unmatched_branches
      (let ? '(Eq , ctxt ) := stack_eq loc_value ctxt 1 aftbt aftbf in
      return ? ((Typed (branch dbt dbf)), ctxt))
  |
    (Failed {| judgement.Failed.descr := descrt |},
      Failed {| judgement.Failed.descr := descrf |}) ⇒
    let descr_value (ret_value : Script_typed_ir.stack_ty) : descr :=
      branch (descrt ret_value) (descrf ret_value) in
    return ? ((Failed {| judgement.Failed.descr := descr_value; |}), ctxt)
  | (Typed dbt, Failed {| judgement.Failed.descr := descrf |}) ⇒
    return ? ((Typed (branch dbt (descrf dbt.(descr.aft)))), ctxt)
  | (Failed {| judgement.Failed.descr := descrt |}, Typed dbf) ⇒
    return ? ((Typed (branch (descrt dbf.(descr.aft)) dbf)), ctxt)
  end.

Definition parse_memo_size
  (n_value :
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim)
  : M ? Alpha_context.Sapling.Memo_size.t :=
  match n_value with
  | Micheline.Int _ z_value ⇒
    match Alpha_context.Sapling.Memo_size.parse_z z_value with
    | Pervasives.Ok memo_size ⇒ Pervasives.Ok memo_size
    | Pervasives.Error msg ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          ((location n_value), (Micheline.strip_locations n_value), msg))
    end
  | _ ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location n_value), [ Script_tc_errors.Int_kind ], (kind_value n_value)))
  end.

Inductive ex_comparable_ty : Set :=
| Ex_comparable_ty : Script_typed_ir.comparable_ty → ex_comparable_ty.

Records for the constructor parameters

[parse_ty_aux] can be used to parse regular types as well as parameter types together with their entrypoints.

In the first case, use [~ret:Don't_parse_entrypoints], [parse_ty_aux] will return an [ex_ty].

In the second case, use [~ret:Parse_entrypoints], [parse_ty_aux] will return an [ex_parameter_ty_and_entrypoints_node].

Records for the constructor parameters

Records for the constructor parameters

Records for the constructor parameters

Module ConstructorRecords_ex_ty_cstr.
  Module ex_ty_cstr.
    Module Ex_ty_cstr.
      Record record {ty construct original_type_expr : Set} : Set := Build {
        ty : ty;
        construct : construct;
        original_type_expr : original_type_expr;
      }.
      Arguments record : clear implicits.
      Definition with_ty {t_ty t_construct t_original_type_expr} ty
        (r : record t_ty t_construct t_original_type_expr) :=
        Build t_ty t_construct t_original_type_expr ty r.(construct)
          r.(original_type_expr).
      Definition with_construct {t_ty t_construct t_original_type_expr}
        construct (r : record t_ty t_construct t_original_type_expr) :=
        Build t_ty t_construct t_original_type_expr r.(ty) construct
          r.(original_type_expr).
      Definition with_original_type_expr {t_ty t_construct t_original_type_expr}
        original_type_expr (r : record t_ty t_construct t_original_type_expr) :=
        Build t_ty t_construct t_original_type_expr r.(ty) r.(construct)
          original_type_expr.
    End Ex_ty_cstr.
    Definition Ex_ty_cstr_skeleton := Ex_ty_cstr.record.
  End ex_ty_cstr.
End ConstructorRecords_ex_ty_cstr.
Import ConstructorRecords_ex_ty_cstr.

Reserved Notation "'ex_ty_cstr.Ex_ty_cstr".

Inductive ex_ty_cstr (a : Set) : Set :=
| Ex_ty_cstr : ∀ {b : Set}, 'ex_ty_cstr.Ex_ty_cstr a b → ex_ty_cstr a

where "'ex_ty_cstr.Ex_ty_cstr" :=
  (fun (t_a t_b : Set) ⇒ ex_ty_cstr.Ex_ty_cstr_skeleton Script_typed_ir.ty
    (t_b → t_a) Alpha_context.Script.node).

Module ex_ty_cstr.
  Include ConstructorRecords_ex_ty_cstr.ex_ty_cstr.
  Definition Ex_ty_cstr := 'ex_ty_cstr.Ex_ty_cstr.
End ex_ty_cstr.

Arguments Ex_ty_cstr {_ _}.

#[bypass_check(guard)]
Definition find_entrypoint {error_context full error_trace : Set}
  (error_details : Script_tc_errors.error_details error_context)
  (full_value : Script_typed_ir.ty) (entrypoints : Script_typed_ir.entrypoints)
  (entrypoint : Alpha_context.Entrypoint.t)
  : Gas_monad.t (ex_ty_cstr full) error_trace :=
  let fix find_entrypoint {t : Set}
    (ty_value : Script_typed_ir.ty)
    (entrypoints : Script_typed_ir.entrypoints_node)
    (entrypoint : Alpha_context.Entrypoint.t) {struct ty_value}
    : Gas_monad.t (ex_ty_cstr t) unit :=
    Gas_monad.Syntax.op_letstar
      (Gas_monad.consume_gas Typecheck_costs.find_entrypoint_cycle)
      (fun function_parameter ⇒
        let '_ := function_parameter in
        match
          ((ty_value, entrypoints),
            match (ty_value, entrypoints) with
            |
              (_, {|
                Script_typed_ir.entrypoints_node.at_node :=
                  Some {|
                    Script_typed_ir.entrypoint_info.name := name;
                      Script_typed_ir.entrypoint_info.original_type_expr
                        :=
                        original_type_expr
                      |}
                  |}) ⇒ Alpha_context.Entrypoint.op_eq name entrypoint
            | _ ⇒ false
            end) with
        |
          ((_, {|
            Script_typed_ir.entrypoints_node.at_node :=
              Some {|
                Script_typed_ir.entrypoint_info.name := name;
                  Script_typed_ir.entrypoint_info.original_type_expr
                    :=
                    original_type_expr
                  |}
              |}), true) ⇒
          let '[original_type_expr, name] :=
            cast [Alpha_context.Script.node ** Alpha_context.Entrypoint.t]
              [original_type_expr, name] in
          Gas_monad.Syntax._return
            (Ex_ty_cstr
              {| ex_ty_cstr.Ex_ty_cstr.ty := ty_value;
                ex_ty_cstr.Ex_ty_cstr.construct := fun (e_value : t) ⇒ e_value;
                ex_ty_cstr.Ex_ty_cstr.original_type_expr := original_type_expr;
                |})
        |
          ((Script_typed_ir.Union_t tl tr _ _, {|
            Script_typed_ir.entrypoints_node.nested :=
              Script_typed_ir.Entrypoints_Union {|
                Script_typed_ir.nested_entrypoints.Entrypoints_Union._left := _left;
                  Script_typed_ir.nested_entrypoints.Entrypoints_Union._right
                    := _right
                  |}
              |}), _) ⇒
          let 'existT _ [__1, __0] [_right, _left, tr, tl] :=
            cast_exists (Es := [Set ** Set])
              (fun '[__1 , __0 ] ⇒
                [Script_typed_ir.entrypoints_node **
                  Script_typed_ir.entrypoints_node ** Script_typed_ir.ty **
                  Script_typed_ir.ty]) [_right, _left, tr, tl] in
          cast (Gas_monad.t (ex_ty_cstr t) unit)
            (Gas_monad.bind_recover (find_entrypoint tl _left entrypoint)
              (fun (function_parameter :
                Pervasives.result (ex_ty_cstr __0) unit) ⇒
                match function_parameter with
                |
                  Pervasives.Ok
                    (Ex_ty_cstr {|
                      ex_ty_cstr.Ex_ty_cstr.ty := ty_value;
                        ex_ty_cstr.Ex_ty_cstr.construct := construct;
                        ex_ty_cstr.Ex_ty_cstr.original_type_expr :=
                          original_type_expr
                        |}) ⇒
                  let 'existT _ __Ex_ty_cstr_'b
                    [original_type_expr, construct, ty_value] :=
                    cast_exists (Es := Set)
                      (fun __Ex_ty_cstr_'b ⇒
                        [Alpha_context.Script.node ** __Ex_ty_cstr_'b → __0 **
                          Script_typed_ir.ty])
                      [original_type_expr, construct, ty_value] in
                  Gas_monad.Syntax._return
                    (Ex_ty_cstr
                      {| ex_ty_cstr.Ex_ty_cstr.ty := ty_value;
                        ex_ty_cstr.Ex_ty_cstr.construct :=
                          fun (e_value : __Ex_ty_cstr_'b) ⇒
                            Script_typed_ir.L (construct e_value);
                        ex_ty_cstr.Ex_ty_cstr.original_type_expr :=
                          original_type_expr; |})
                | Pervasives.Error _ ⇒
                  Gas_monad.Syntax.op_letplus
                    ((find_entrypoint tr _right entrypoint) :
                      Gas_monad.t (ex_ty_cstr __1) unit)
                    (fun x_value ⇒
                      let
                        'Ex_ty_cstr {|
                          ex_ty_cstr.Ex_ty_cstr.ty := ty_value;
                            ex_ty_cstr.Ex_ty_cstr.construct := construct;
                            ex_ty_cstr.Ex_ty_cstr.original_type_expr :=
                              original_type_expr
                            |} := x_value in
                      let 'existT _ __Ex_ty_cstr_'b1
                        [original_type_expr, construct, ty_value] :=
                        cast_exists (Es := Set)
                          (fun __Ex_ty_cstr_'b1 ⇒
                            [Alpha_context.Script.node **
                              __Ex_ty_cstr_'b1 → __1 ** Script_typed_ir.ty])
                          [original_type_expr, construct, ty_value] in
                      Ex_ty_cstr
                        {| ex_ty_cstr.Ex_ty_cstr.ty := ty_value;
                          ex_ty_cstr.Ex_ty_cstr.construct :=
                            fun (e_value : __Ex_ty_cstr_'b1) ⇒
                              Script_typed_ir.R (construct e_value);
                          ex_ty_cstr.Ex_ty_cstr.original_type_expr :=
                            original_type_expr; |})
                end))
        |
          ((_, {|
            Script_typed_ir.entrypoints_node.nested := Script_typed_ir.Entrypoints_None
              |}), _) ⇒ Gas_monad.of_result (Pervasives.Error tt)
        | _ ⇒ unreachable_gadt_branch
        end) in
  let '{|
    Script_typed_ir.entrypoints.root := root_value;
      Script_typed_ir.entrypoints.original_type_expr := original_type_expr
      |} := entrypoints in
  Gas_monad.bind_recover (find_entrypoint full_value root_value entrypoint)
    (fun (function_parameter : Pervasives.result (ex_ty_cstr full) unit) ⇒
      match function_parameter with
      | Pervasives.Ok f_t ⇒ Gas_monad.Syntax._return f_t
      | Pervasives.Error _ ⇒
        if Alpha_context.Entrypoint.is_default entrypoint then
          Gas_monad.Syntax._return
            (Ex_ty_cstr
              {| ex_ty_cstr.Ex_ty_cstr.ty := full_value;
                ex_ty_cstr.Ex_ty_cstr.construct :=
                  fun (e_value : full) ⇒ e_value;
                ex_ty_cstr.Ex_ty_cstr.original_type_expr := original_type_expr;
                |})
        else
          Gas_monad.of_result
            (Pervasives.Error
              match error_details with
              | Script_tc_errors.Fast ⇒
                cast error_trace Script_tc_errors.Inconsistent_types_fast
              | Script_tc_errors.Informative _ ⇒
                cast error_trace
                (Error_monad.trace_of_error
                  (Build_extensible "No_such_entrypoint"
                    Alpha_context.Entrypoint.t entrypoint))
              end)
      end).

Definition find_entrypoint_for_type {full : Set} {error_trace : Set}
  (error_details : Script_tc_errors.error_details Alpha_context.Script.location)
  (full_value : Script_typed_ir.ty) (expected : Script_typed_ir.ty)
  (entrypoints : Script_typed_ir.entrypoints)
  (entrypoint : Alpha_context.Entrypoint.t)
  : Gas_monad.t (Alpha_context.Entrypoint.t × Script_typed_ir.ty) error_trace :=
  Gas_monad.Syntax.op_letstar
    ((find_entrypoint error_details full_value entrypoints entrypoint) :
      Gas_monad.t (ex_ty_cstr full) error_trace)
    (fun res ⇒
      let 'Ex_ty_cstr {| ex_ty_cstr.Ex_ty_cstr.ty := ty_value |} := res in
      match
        (entrypoints.(Script_typed_ir.entrypoints.root).(Script_typed_ir.entrypoints_node.at_node),
          match
            entrypoints.(Script_typed_ir.entrypoints.root).(Script_typed_ir.entrypoints_node.at_node)
            with
          |
            Some {|
              Script_typed_ir.entrypoint_info.name := name;
                Script_typed_ir.entrypoint_info.original_type_expr := _
                |} ⇒
            (Alpha_context.Entrypoint.is_root name) &&
            (Alpha_context.Entrypoint.is_default entrypoint )
          | _ ⇒ false
          end) with
      |
        (Some {|
          Script_typed_ir.entrypoint_info.name := name;
            Script_typed_ir.entrypoint_info.original_type_expr := _
            |}, true) ⇒
        Gas_monad.bind_recover (ty_eq Script_tc_errors.Fast ty_value expected)
          (fun (function_parameter :
            Pervasives.result eq Script_tc_errors.inconsistent_types_fast_error)
            ⇒
            match function_parameter with
            | Pervasives.Ok Eq ⇒
              Gas_monad.Syntax._return
                (Alpha_context.Entrypoint.default, ty_value)
            | Pervasives.Error Script_tc_errors.Inconsistent_types_fast ⇒
              Gas_monad.Syntax.op_letplus
                (ty_eq error_details full_value expected)
                (fun function_parameter ⇒
                  let 'Eq := function_parameter in
                  (Alpha_context.Entrypoint.root_value, full_value))
            end)
      | (_, _) ⇒
        Gas_monad.Syntax.op_letplus (ty_eq error_details ty_value expected)
          (fun function_parameter ⇒
            let 'Eq := function_parameter in
            (entrypoint, ty_value))
      end).

Definition well_formed_entrypoints
  (full_value : Script_typed_ir.ty)
  (entrypoints : Script_typed_ir.entrypoints_node) : M ? unit :=
  let merge {A : Set}
    (path : list A) (ty_value : Script_typed_ir.ty)
    (entrypoints : Script_typed_ir.entrypoints_node) (reachable : bool)
    (function_parameter : option (list A) × Entrypoint_repr._Set.(_Set.S.t))
    : M ? ((option (list A) × Entrypoint_repr._Set.(_Set.S.t)) × bool) :=
    let '(first_unreachable, all) as acc_value := function_parameter in
    match entrypoints.(Script_typed_ir.entrypoints_node.at_node) with
    | None ⇒
      return ?
        ((if reachable then
          acc_value
        else
          match ty_value with
          | Script_typed_ir.Union_t _ _ _ _ ⇒ acc_value
          | _ ⇒
            match first_unreachable with
            | None ⇒ ((Some (List.rev path)), all)
            | Some _ ⇒ acc_value
            end
          end), reachable)
    |
      Some {|
        Script_typed_ir.entrypoint_info.name := name;
          Script_typed_ir.entrypoint_info.original_type_expr := _
          |} ⇒
      if Alpha_context.Entrypoint._Set.(_Set.S.mem) name all then
        Error_monad.error_value
          (Build_extensible "Duplicate_entrypoint" Alpha_context.Entrypoint.t
            name)
      else
        return ?
          ((first_unreachable,
            (Alpha_context.Entrypoint._Set.(_Set.S.add) name all)), true)
    end in
  let fix check
    (t_value : Script_typed_ir.ty)
    (entrypoints : Script_typed_ir.entrypoints_node)
    (path : list Alpha_context.Script.prim) (reachable : bool)
    (acc_value :
      option (list Alpha_context.Script.prim) × Entrypoint_repr._Set.(_Set.S.t))
    : M ?
      (option (list Alpha_context.Script.prim) × Entrypoint_repr._Set.(_Set.S.t)) :=
    match (t_value, entrypoints) with
    |
      (Script_typed_ir.Union_t tl tr _ _, {|
        Script_typed_ir.entrypoints_node.nested :=
          Script_typed_ir.Entrypoints_Union {|
            Script_typed_ir.nested_entrypoints.Entrypoints_Union._left := _left;
              Script_typed_ir.nested_entrypoints.Entrypoints_Union._right
                := _right
              |}
          |}) ⇒
      let ? '(acc_value , l_reachable ) :=
        merge (cons Michelson_v1_primitives.D_Left path) tl _left reachable
          acc_value in
      let ? '(acc_value , r_reachable ) :=
        merge (cons Michelson_v1_primitives.D_Right path) tr _right reachable
          acc_value in
      let ? acc_value :=
        check tl _left (cons Michelson_v1_primitives.D_Left path) l_reachable
          acc_value in
      check tr _right (cons Michelson_v1_primitives.D_Right path) r_reachable
        acc_value
    | _ ⇒ return ? acc_value
    end in
  let '(init_value, reachable) :=
    match entrypoints.(Script_typed_ir.entrypoints_node.at_node) with
    | None ⇒ (Alpha_context.Entrypoint._Set.(_Set.S.empty), false)
    |
      Some {|
        Script_typed_ir.entrypoint_info.name := name;
          Script_typed_ir.entrypoint_info.original_type_expr := _
          |} ⇒ ((Alpha_context.Entrypoint._Set.(_Set.S.singleton) name), true)
    end in
  let ? '(first_unreachable , all ) :=
    check full_value entrypoints nil reachable (None, init_value) in
  if
    Pervasives.not
      (Alpha_context.Entrypoint._Set.(_Set.S.mem)
        Alpha_context.Entrypoint.default all)
  then
    Result.return_unit
  else
    match first_unreachable with
    | None ⇒ Result.return_unit
    | Some path ⇒
      Error_monad.error_value
        (Build_extensible "Unreachable_entrypoint"
          (list Alpha_context.Script.prim) path)
    end.

Records for the constructor parameters

Module ConstructorRecords_ex_parameter_ty_and_entrypoints.
  Module ex_parameter_ty_and_entrypoints.
    Module Ex_parameter_ty_and_entrypoints.
      Record record {arg_type entrypoints : Set} : Set := Build {
        arg_type : arg_type;
        entrypoints : entrypoints;
      }.
      Arguments record : clear implicits.
      Definition with_arg_type {t_arg_type t_entrypoints} arg_type
        (r : record t_arg_type t_entrypoints) :=
        Build t_arg_type t_entrypoints arg_type r.(entrypoints).
      Definition with_entrypoints {t_arg_type t_entrypoints} entrypoints
        (r : record t_arg_type t_entrypoints) :=
        Build t_arg_type t_entrypoints r.(arg_type) entrypoints.
    End Ex_parameter_ty_and_entrypoints.
    Definition Ex_parameter_ty_and_entrypoints_skeleton :=
      Ex_parameter_ty_and_entrypoints.record.
  End ex_parameter_ty_and_entrypoints.
End ConstructorRecords_ex_parameter_ty_and_entrypoints.
Import ConstructorRecords_ex_parameter_ty_and_entrypoints.

Reserved Notation
  "'ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints".

Inductive ex_parameter_ty_and_entrypoints : Set :=
| Ex_parameter_ty_and_entrypoints :
  'ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints →
  ex_parameter_ty_and_entrypoints

where "'ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints" :=
  (ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints_skeleton
    Script_typed_ir.ty Script_typed_ir.entrypoints).

Module ex_parameter_ty_and_entrypoints.
  Include ConstructorRecords_ex_parameter_ty_and_entrypoints.ex_parameter_ty_and_entrypoints.
  Definition Ex_parameter_ty_and_entrypoints :=
    'ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.
End ex_parameter_ty_and_entrypoints.

Definition parse_parameter_ty_and_entrypoints_aux
  (ctxt : Alpha_context.context) (stack_depth : int) (legacy : bool)
  (node_value : Alpha_context.Script.node)
  : M ? (ex_parameter_ty_and_entrypoints × Alpha_context.context ) :=
  let ?
    '(Ex_parameter_ty_and_entrypoints_node {|
      ex_parameter_ty_and_entrypoints_node.Ex_parameter_ty_and_entrypoints_node.arg_type
        := arg_type ;
        ex_parameter_ty_and_entrypoints_node.Ex_parameter_ty_and_entrypoints_node.entrypoints
          := entrypoints
        |}, ctxt ) :=
    parse_passable_ty_aux_with_ret ctxt (stack_depth +i 1) legacy
      Parse_entrypoints node_value in
  let ? '_ :=
    if legacy then
      Result.return_unit
    else
      well_formed_entrypoints arg_type entrypoints in
  let entrypoints :=
    {| Script_typed_ir.entrypoints.root := entrypoints;
      Script_typed_ir.entrypoints.original_type_expr := node_value; |} in
  return ?
    ((Ex_parameter_ty_and_entrypoints
      {|
        ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.arg_type
          := arg_type;
        ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.entrypoints
          := entrypoints; |}), ctxt).

Definition parse_passable_ty_aux
  : Alpha_context.context → int → bool → Alpha_context.Script.node →
  M ? (Script_typed_ir.ex_ty × Alpha_context.context ) :=
  fun x_1 x_2 x_3 ⇒
    parse_passable_ty_aux_with_ret x_1 x_2 x_3 Don't_parse_entrypoints.

Definition parse_uint (nb_bits : int)
  : Micheline.node Alpha_context.Script.location Alpha_context.Script.prim →
  M ? int :=
  if (nb_bits ≥i 0) && (nb_bits ≤i 30) then
    let max_int := (Pervasives.lsl 1 nb_bits ) -i 1 in
    let max_z := Z.of_int max_int in
    fun (function_parameter :
      Micheline.node Alpha_context.Script.location Alpha_context.Script.prim) ⇒
      match
        (function_parameter,
          match function_parameter with
          | Micheline.Int _ n_value ⇒
            (Z.zero ≤Z n_value) && (n_value ≤Z max_z )
          | _ ⇒ false
          end) with
      | (Micheline.Int _ n_value, true) ⇒ return ? (Z.to_int n_value)
      | (node_value, _) ⇒
        Error_monad.error_value
          (Build_extensible "Invalid_syntactic_constant"
            (Alpha_context.Script.location ×
              Micheline.canonical Alpha_context.Script.prim × string)
            ((location node_value), (Micheline.strip_locations node_value),
              (Pervasives.op_caret "a positive "
                (Pervasives.op_caret (Pervasives.string_of_int nb_bits)
                  (Pervasives.op_caret "-bit integer (between 0 and "
                    (Pervasives.op_caret (Pervasives.string_of_int max_int) ")"))))))
      end
  else
    fun (function_parameter :
      Micheline.node Alpha_context.Script.location Alpha_context.Script.prim) ⇒
      let '_ := function_parameter in
      Error_monad.error_value (Build_extensible "Asserted" unit tt).

Definition parse_uint10
  : Micheline.node Alpha_context.Script.location Alpha_context.Script.prim →
  M ? int := parse_uint 10.

Definition parse_uint11
  : Micheline.node Alpha_context.Script.location Alpha_context.Script.prim →
  M ? int := parse_uint 11.

Definition opened_ticket_type
  (loc_value : Alpha_context.Script.location)
  (ty_value : Script_typed_ir.comparable_ty)
  : M ? Script_typed_ir.comparable_ty :=
  Script_typed_ir.comparable_pair_3_t loc_value Script_typed_ir.address_t
    ty_value Script_typed_ir.nat_t.

Definition parse_unit
  (ctxt : Alpha_context.context) (legacy : bool)
  (function_parameter :
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim)
  : M ? (unit × Alpha_context.context ) :=
  match function_parameter with
  | Micheline.Prim loc_value Michelson_v1_primitives.D_Unit [] annot ⇒
    let ? '_ :=
      if legacy then
        Result.return_unit
      else
        Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.unit_value in
    return ? (tt, ctxt)
  | Micheline.Prim loc_value Michelson_v1_primitives.D_Unit l_value _ ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.D_Unit, 0, (List.length l_value)))
  | expr ⇒
    Error_monad.error_value
      (unexpected expr nil Michelson_v1_primitives.Constant_namespace
        [ Michelson_v1_primitives.D_Unit ])
  end.

Definition parse_bool
  (ctxt : Alpha_context.context) (legacy : bool)
  (function_parameter :
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim)
  : M ? (bool × Alpha_context.context ) :=
  match function_parameter with
  | Micheline.Prim loc_value Michelson_v1_primitives.D_True [] annot ⇒
    let ? '_ :=
      if legacy then
        Result.return_unit
      else
        Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.bool_value in
    return ? (true, ctxt)
  | Micheline.Prim loc_value Michelson_v1_primitives.D_False [] annot ⇒
    let ? '_ :=
      if legacy then
        Result.return_unit
      else
        Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.bool_value in
    return ? (false, ctxt)
  |
    Micheline.Prim loc_value
      ((Michelson_v1_primitives.D_True | Michelson_v1_primitives.D_False) as
        c_value) l_value _ ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, c_value, 0, (List.length l_value)))
  | expr ⇒
    Error_monad.error_value
      (unexpected expr nil Michelson_v1_primitives.Constant_namespace
        [ Michelson_v1_primitives.D_True; Michelson_v1_primitives.D_False ])
  end.

Definition parse_string
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Script_string.t × Alpha_context.context ) :=
  match function_parameter with
  | (Micheline.String loc_value v_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.check_printable v_value)
      in
    Error_monad.record_trace
      (Build_extensible "Invalid_syntactic_constant"
        (Alpha_context.Script.location ×
          Micheline.canonical Alpha_context.Script.prim × string)
        (loc_value, (Micheline.strip_locations expr), "a printable ascii string"))
      (let ? s_value := Script_string.of_string v_value in
      return ? (s_value, ctxt))
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.String_kind ], (kind_value expr)))
  end.

Definition parse_bytes {A B : Set}
  (ctxt : A)
  (function_parameter : Micheline.node Alpha_context.Script.location B)
  : M ? (bytes × A ) :=
  match function_parameter with
  | Micheline.Bytes _ v_value ⇒ return ? (v_value, ctxt)
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Bytes_kind ], (kind_value expr)))
  end.

Definition parse_int {A B : Set}
  (ctxt : A)
  (function_parameter : Micheline.node Alpha_context.Script.location B)
  : M ? (Script_int.num × A ) :=
  match function_parameter with
  | Micheline.Int _ v_value ⇒ return ? ((Script_int.of_zint v_value), ctxt)
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Int_kind ], (kind_value expr)))
  end.

Definition parse_nat
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Script_int.num × Alpha_context.context ) :=
  match function_parameter with
  | (Micheline.Int loc_value v_value) as expr ⇒
    let v_value := Script_int.of_zint v_value in
    match Script_int.is_nat v_value with
    | Some nat ⇒ return ? (nat, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a non-negative integer"))
    end
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Int_kind ], (kind_value expr)))
  end.

Definition parse_mutez
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Alpha_context.Tez.t × Alpha_context.context ) :=
  match function_parameter with
  | (Micheline.Int loc_value v_value) as expr ⇒
    match
      Option.bind
        (Option.catch None
          (fun (function_parameter : unit) ⇒
            let '_ := function_parameter in
            Z.to_int64 v_value)) Alpha_context.Tez.of_mutez with
    | Some tez ⇒ Pervasives.Ok (tez, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid mutez amount"))
    end
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Int_kind ], (kind_value expr)))
  end.

Definition parse_timestamp
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Script_timestamp.t × Alpha_context.context ) :=
  match function_parameter with
  | Micheline.Int _ v_value ⇒
    return ? ((Script_timestamp.of_zint v_value), ctxt)
  | (Micheline.String loc_value s_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt
        (Typecheck_costs.timestamp_readable s_value) in
    match Script_timestamp.of_string s_value with
    | Some v_value ⇒ return ? (v_value, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid timestamp"))
    end
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr),
          [ Script_tc_errors.String_kind; Script_tc_errors.Int_kind ],
          (kind_value expr)))
  end.

Definition parse_key
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Alpha_context.public_key × Alpha_context.context ) :=
  match function_parameter with
  | (Micheline.Bytes loc_value bytes_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.public_key_optimized in
    match
      Data_encoding.Binary.of_bytes_opt
        Signature.Public_key.(S.SIGNATURE_PUBLIC_KEY.encoding) bytes_value with
    | Some k_value ⇒ return ? (k_value, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid public key"))
    end
  | (Micheline.String loc_value s_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.public_key_readable in
    match Signature.Public_key.(S.SIGNATURE_PUBLIC_KEY.of_b58check_opt) s_value
      with
    | Some k_value ⇒ return ? (k_value, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid public key"))
    end
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr),
          [ Script_tc_errors.String_kind; Script_tc_errors.Bytes_kind ],
          (kind_value expr)))
  end.

Definition parse_key_hash
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Alpha_context.public_key_hash × Alpha_context.context ) :=
  match function_parameter with
  | (Micheline.Bytes loc_value bytes_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.key_hash_optimized in
    match
      Data_encoding.Binary.of_bytes_opt
        Signature.Public_key_hash.(S.SIGNATURE_PUBLIC_KEY_HASH.encoding)
        bytes_value with
    | Some k_value ⇒ return ? (k_value, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid key hash"))
    end
  | (Micheline.String loc_value s_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.key_hash_readable in
    match
      Signature.Public_key_hash.(S.SIGNATURE_PUBLIC_KEY_HASH.of_b58check_opt)
        s_value with
    | Some k_value ⇒ return ? (k_value, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid key hash"))
    end
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr),
          [ Script_tc_errors.String_kind; Script_tc_errors.Bytes_kind ],
          (kind_value expr)))
  end.

Definition parse_signature
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Script_typed_ir.signature × Alpha_context.context ) :=
  match function_parameter with
  | (Micheline.Bytes loc_value bytes_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.signature_optimized in
    match
      Data_encoding.Binary.of_bytes_opt
        Script_typed_ir.Script_signature.encoding bytes_value with
    | Some k_value ⇒ return ? (k_value, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid signature"))
    end
  | (Micheline.String loc_value s_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.signature_readable in
    match Script_typed_ir.Script_signature.of_b58check_opt s_value with
    | Some s_value ⇒ return ? (s_value, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid signature"))
    end
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr),
          [ Script_tc_errors.String_kind; Script_tc_errors.Bytes_kind ],
          (kind_value expr)))
  end.

Definition parse_chain_id
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Script_typed_ir.Script_chain_id.t × Alpha_context.context ) :=
  match function_parameter with
  | (Micheline.Bytes loc_value bytes_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.chain_id_optimized in
    match
      Data_encoding.Binary.of_bytes_opt Script_typed_ir.Script_chain_id.encoding
        bytes_value with
    | Some k_value ⇒ return ? (k_value, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid chain id"))
    end
  | (Micheline.String loc_value s_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.chain_id_readable in
    match Script_typed_ir.Script_chain_id.of_b58check_opt s_value with
    | Some s_value ⇒ return ? (s_value, ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr), "a valid chain id"))
    end
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr),
          [ Script_tc_errors.String_kind; Script_tc_errors.Bytes_kind ],
          (kind_value expr)))
  end.

Definition parse_address (ctxt : Alpha_context.context)
  : Alpha_context.Script.node →
  M ? (Script_typed_ir.address × Alpha_context.context ) :=
  let destination_allowed
    (loc_value : Alpha_context.Script.location)
    (function_parameter : Script_typed_ir.address)
    : Alpha_context.context →
    M ? (Script_typed_ir.address × Alpha_context.context ) :=
    let '{|
      Script_typed_ir.address.destination := destination;
        Script_typed_ir.address.entrypoint := entrypoint
        |} := function_parameter in
    fun (ctxt : Alpha_context.context) ⇒
      match
        (destination,
          match destination with
          | Alpha_context.Destination.Tx_rollup _ ⇒
            Pervasives.not (Alpha_context.Constants.tx_rollup_enable ctxt)
          | _ ⇒ false
          end,
          match destination with
          | Alpha_context.Destination.Sc_rollup _ ⇒
            Pervasives.not (Alpha_context.Constants.sc_rollup_enable ctxt)
          | _ ⇒ false
          end,
          match destination with
          | Alpha_context.Destination.Zk_rollup _ ⇒
            Pervasives.not (Alpha_context.Constants.zk_rollup_enable ctxt)
          | _ ⇒ false
          end) with
      | (Alpha_context.Destination.Tx_rollup _, true, _, _) ⇒
        Error_monad.error_value
          (Build_extensible "Tx_rollup_addresses_disabled"
            Alpha_context.Script.location loc_value)
      | (Alpha_context.Destination.Sc_rollup _, _, true, _) ⇒
        Error_monad.error_value
          (Build_extensible "Sc_rollup_disabled" Alpha_context.Script.location
            loc_value)
      | (Alpha_context.Destination.Zk_rollup _, _, _, true) ⇒
        Error_monad.error_value
          (Build_extensible "Zk_rollup_disabled" Alpha_context.Script.location
            loc_value)
      | (_, _, _, _) ⇒
        Pervasives.Ok
          ({| Script_typed_ir.address.destination := destination;
            Script_typed_ir.address.entrypoint := entrypoint; |}, ctxt)
      end in
  fun (function_parameter : Alpha_context.Script.node) ⇒
    match function_parameter with
    | (Micheline.Bytes loc_value bytes_value) as expr ⇒
      let ? ctxt :=
        Alpha_context.Gas.consume ctxt Typecheck_costs.contract_optimized in
      match
        Data_encoding.Binary.of_bytes_opt
          (Data_encoding.tup2 Alpha_context.Destination.encoding
            Alpha_context.Entrypoint.value_encoding) bytes_value with
      | Some (destination, entrypoint) ⇒
        destination_allowed loc_value
          {| Script_typed_ir.address.destination := destination;
            Script_typed_ir.address.entrypoint := entrypoint; |} ctxt
      | None ⇒
        Error_monad.error_value
          (Build_extensible "Invalid_syntactic_constant"
            (Alpha_context.Script.location ×
              Micheline.canonical Alpha_context.Script.prim × string)
            (loc_value, (Micheline.strip_locations expr), "a valid address"))
      end
    | Micheline.String loc_value s_value ⇒
      let ? ctxt :=
        Alpha_context.Gas.consume ctxt Typecheck_costs.contract_readable in
      let ? '(addr , entrypoint ) :=
        match String.index_opt s_value "%" % char with
        | None ⇒ return ? (s_value, Alpha_context.Entrypoint.default)
        | Some pos ⇒
          let len := ((String.length s_value) -i pos) -i 1 in
          let name := String.sub s_value (pos +i 1) len in
          let ? entrypoint :=
            Alpha_context.Entrypoint.of_string_strict loc_value name in
          return ? ((String.sub s_value 0 pos), entrypoint)
        end in
      let ? destination := Alpha_context.Destination.of_b58check addr in
      destination_allowed loc_value
        {| Script_typed_ir.address.destination := destination;
          Script_typed_ir.address.entrypoint := entrypoint; |} ctxt
    | expr ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_kind"
          (Alpha_context.Script.location × list Script_tc_errors.kind ×
            Script_tc_errors.kind)
          ((location expr),
            [ Script_tc_errors.String_kind; Script_tc_errors.Bytes_kind ],
            (kind_value expr)))
    end.

Definition parse_tx_rollup_l2_address
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Script_typed_ir.tx_rollup_l2_address × Alpha_context.context ) :=
  match function_parameter with
  | (Micheline.Bytes loc_value bytes_value) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.tx_rollup_l2_address in
    match Tx_rollup_l2_address.of_bytes_opt bytes_value with
    | Some txa ⇒
      return ? ((Tx_rollup_l2_address.Indexable.value_value txa), ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr),
            "a valid transaction rollup L2 address"))
    end
  | (Micheline.String loc_value str) as expr ⇒
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.tx_rollup_l2_address in
    match Tx_rollup_l2_address.of_b58check_opt str with
    | Some txa ⇒
      return ? ((Tx_rollup_l2_address.Indexable.value_value txa), ctxt)
    | None ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr),
            "a valid transaction rollup L2 address"))
    end
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr),
          [ Script_tc_errors.String_kind; Script_tc_errors.Bytes_kind ],
          (kind_value expr)))
  end.

Definition parse_never {A : Set}
  (expr : Micheline.node Alpha_context.Script.location A)
  : M ? (Script_typed_ir.never × Alpha_context.context ) :=
  Error_monad.error_value
    (Build_extensible "Invalid_never_expr" Alpha_context.Script.location
      (location expr)).

Definition parse_pair {A B C D E : Set}
  (parse_l :
    A →
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim →
    M ? (B × C ))
  (parse_r :
    C →
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim →
    M ? (D × E )) (ctxt : A) (legacy : bool)
  (r_comb_witness : Script_ir_unparser.comb_witness)
  (expr : Micheline.node Alpha_context.Script.location Alpha_context.Script.prim)
  : M ? ((B × D) × E ) :=
  let parse_comb
    (loc_value : Alpha_context.Script.location)
    (l_value :
      Micheline.node Alpha_context.Script.location Alpha_context.Script.prim)
    (rs :
      list
        (Micheline.node Alpha_context.Script.location Alpha_context.Script.prim))
    : M ? ((B × D) × E ) :=
    let ? '(l_value , ctxt ) := parse_l ctxt l_value in
    let ? r_value :=
      match (rs, r_comb_witness) with
      | (cons r_value [], _) ⇒ return ? r_value
      | ([], _) ⇒
        Error_monad.error_value
          (Build_extensible "Invalid_arity"
            (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
              int) (loc_value, Michelson_v1_primitives.D_Pair, 2, 1))
      | (cons _ _, Script_ir_unparser.Comb_Pair _) ⇒
        return ? (Micheline.Prim loc_value Michelson_v1_primitives.D_Pair rs nil )
      | _ ⇒
        Error_monad.error_value
          (Build_extensible "Invalid_arity"
            (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
              int)
            (loc_value, Michelson_v1_primitives.D_Pair, 2,
              (1 +i (List.length rs ))))
      end in
    let ? '(r_value , ctxt ) := parse_r ctxt r_value in
    return ? ((l_value, r_value), ctxt) in
  match expr with
  |
    Micheline.Prim loc_value Michelson_v1_primitives.D_Pair (cons l_value rs)
      annot ⇒
    let ? '_ :=
      if legacy then
        Result.return_unit
      else
        Script_ir_annot.error_unexpected_annot loc_value annot in
    parse_comb loc_value l_value rs
  | Micheline.Prim loc_value Michelson_v1_primitives.D_Pair l_value _ ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.D_Pair, 2, (List.length l_value)))
  | Micheline.Seq loc_value (cons l_value ((cons _ _) as rs)) ⇒
    parse_comb loc_value l_value rs
  | Micheline.Seq loc_value l_value ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_seq_arity"
        (Alpha_context.Script.location × int × int)
        (loc_value, 2, (List.length l_value)))
  | expr ⇒
    Error_monad.tzfail
      (unexpected expr nil Michelson_v1_primitives.Constant_namespace
        [ Michelson_v1_primitives.D_Pair ])
  end.

Definition parse_union {A B C D : Set}
  (parse_l :
    A →
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim →
    M ? (B × C ))
  (parse_r :
    A →
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim →
    M ? (D × C )) (ctxt : A) (legacy : bool)
  (function_parameter :
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim)
  : M ? (Script_typed_ir.union B D × C ) :=
  match function_parameter with
  |
    Micheline.Prim loc_value Michelson_v1_primitives.D_Left (cons v_value [])
      annot ⇒
    let ? '_ :=
      if legacy then
        Result.return_unit
      else
        Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(v_value , ctxt ) := parse_l ctxt v_value in
    return ? ((Script_typed_ir.L v_value), ctxt)
  | Micheline.Prim loc_value Michelson_v1_primitives.D_Left l_value _ ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.D_Left, 1, (List.length l_value)))
  |
    Micheline.Prim loc_value Michelson_v1_primitives.D_Right (cons v_value [])
      annot ⇒
    let ? '_ :=
      if legacy then
        Result.return_unit
      else
        Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(v_value , ctxt ) := parse_r ctxt v_value in
    return ? ((Script_typed_ir.R v_value), ctxt)
  | Micheline.Prim loc_value Michelson_v1_primitives.D_Right l_value _ ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.D_Right, 1, (List.length l_value)))
  | expr ⇒
    Error_monad.tzfail
      (unexpected expr nil Michelson_v1_primitives.Constant_namespace
        [ Michelson_v1_primitives.D_Left; Michelson_v1_primitives.D_Right ])
  end.

Definition parse_option {A B : Set}
  (parse_v :
    A →
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim →
    M ? (B × A )) (ctxt : A) (legacy : bool)
  (function_parameter :
    Micheline.node Alpha_context.Script.location Alpha_context.Script.prim)
  : M ? (option B × A ) :=
  match function_parameter with
  |
    Micheline.Prim loc_value Michelson_v1_primitives.D_Some (cons v_value [])
      annot ⇒
    let ? '_ :=
      if legacy then
        Result.return_unit
      else
        Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(v_value , ctxt ) := parse_v ctxt v_value in
    return ? ((Some v_value), ctxt)
  | Micheline.Prim loc_value Michelson_v1_primitives.D_Some l_value _ ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.D_Some, 1, (List.length l_value)))
  | Micheline.Prim loc_value Michelson_v1_primitives.D_None [] annot ⇒
    let ? '_ :=
      if legacy then
        Result.return_unit
      else
        Script_ir_annot.error_unexpected_annot loc_value annot in
    return ? (None, ctxt)
  | Micheline.Prim loc_value Michelson_v1_primitives.D_None l_value _ ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.D_None, 0, (List.length l_value)))
  | expr ⇒
    Error_monad.tzfail
      (unexpected expr nil Michelson_v1_primitives.Constant_namespace
        [ Michelson_v1_primitives.D_Some; Michelson_v1_primitives.D_None ])
  end.

Definition comb_witness1 (function_parameter : Script_typed_ir.ty)
  : Script_ir_unparser.comb_witness :=
  match function_parameter with
  | Script_typed_ir.Pair_t _ _ _ _ ⇒
    Script_ir_unparser.Comb_Pair Script_ir_unparser.Comb_Any
  | _ ⇒ Script_ir_unparser.Comb_Any
  end.

#[bypass_check(guard)]
Definition parse_view_name
  (ctxt : Alpha_context.context)
  (function_parameter : Alpha_context.Script.node)
  : M ? (Script_string.t × Alpha_context.context ) :=
  match function_parameter with
  | (Micheline.String loc_value v_value) as expr ⇒
    if (String.length v_value) >i 31 then
      Error_monad.error_value
        (Build_extensible "View_name_too_long" string v_value)
    else
      let fix check_char (i_value : int) {struct i_value} : M ? string :=
        if i_value <i 0 then
          return ? v_value
        else
          if Script_ir_annot.is_allowed_char (String.get v_value i_value) then
            check_char (i_value -i 1)
          else
            Error_monad.error_value
              (Build_extensible "Bad_view_name" Alpha_context.Script.location
                loc_value) in
      let ? ctxt :=
        Alpha_context.Gas.consume ctxt (Typecheck_costs.check_printable v_value)
        in
      Error_monad.record_trace
        (Build_extensible "Invalid_syntactic_constant"
          (Alpha_context.Script.location ×
            Micheline.canonical Alpha_context.Script.prim × string)
          (loc_value, (Micheline.strip_locations expr),
            "string [a-zA-Z0-9_.%@] and the maximum string length of 31 characters"))
        (let ? v_value := check_char ((String.length v_value) -i 1) in
        let ? s_value := Script_string.of_string v_value in
        return ? (s_value, ctxt))
  | expr ⇒
    Error_monad.error_value
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.String_kind ], (kind_value expr)))
  end.

Definition parse_toplevel_aux
  (ctxt : Alpha_context.context) (legacy : bool)
  (toplevel_value : Alpha_context.Script.expr)
  : M ? (toplevel × Alpha_context.context ) :=
  Error_monad.record_trace
    (Build_extensible "Ill_typed_contract"
      (Alpha_context.Script.expr × Script_tc_errors.type_map)
      (toplevel_value, nil))
    match Micheline.root_value toplevel_value with
    | Micheline.Int loc_value _ ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_kind"
          (Micheline.canonical_location × list Script_tc_errors.kind ×
            Script_tc_errors.kind)
          (loc_value, [ Script_tc_errors.Seq_kind ], Script_tc_errors.Int_kind))
    | Micheline.String loc_value _ ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_kind"
          (Micheline.canonical_location × list Script_tc_errors.kind ×
            Script_tc_errors.kind)
          (loc_value, [ Script_tc_errors.Seq_kind ],
            Script_tc_errors.String_kind))
    | Micheline.Bytes loc_value _ ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_kind"
          (Micheline.canonical_location × list Script_tc_errors.kind ×
            Script_tc_errors.kind)
          (loc_value, [ Script_tc_errors.Seq_kind ], Script_tc_errors.Bytes_kind))
    | Micheline.Prim loc_value _ _ _ ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_kind"
          (Micheline.canonical_location × list Script_tc_errors.kind ×
            Script_tc_errors.kind)
          (loc_value, [ Script_tc_errors.Seq_kind ], Script_tc_errors.Prim_kind))
    | Micheline.Seq _ fields ⇒
      let fix find_fields
        (ctxt : Alpha_context.context)
        (p_value :
          option
            (Micheline.node Alpha_context.Script.location
              Alpha_context.Script.prim × Alpha_context.Script.location ×
              Micheline.annot))
        (s_value :
          option
            (Micheline.node Alpha_context.Script.location
              Alpha_context.Script.prim × Alpha_context.Script.location ×
              Micheline.annot))
        (c_value :
          option
            (Micheline.node Alpha_context.Script.location
              Alpha_context.Script.prim × Alpha_context.Script.location ×
              Micheline.annot)) (views : Script_typed_ir.view_map)
        (fields :
          list
            (Micheline.node Alpha_context.Script.location
              Alpha_context.Script.prim))
        : M ?
          (Alpha_context.context ×
            (option
              (Micheline.node Alpha_context.Script.location
                Alpha_context.Script.prim × Alpha_context.Script.location ×
                Micheline.annot) ×
              option
                (Micheline.node Alpha_context.Script.location
                  Alpha_context.Script.prim × Alpha_context.Script.location ×
                  Micheline.annot) ×
              option
                (Micheline.node Alpha_context.Script.location
                  Alpha_context.Script.prim × Alpha_context.Script.location ×
                  Micheline.annot) × Script_typed_ir.view_map)) :=
        match fields with
        | [] ⇒ return ? (ctxt, (p_value, s_value, c_value, views))
        | cons (Micheline.Int loc_value _) _ ⇒
          Error_monad.error_value
            (Build_extensible "Invalid_kind"
              (Alpha_context.Script.location × list Script_tc_errors.kind ×
                Script_tc_errors.kind)
              (loc_value, [ Script_tc_errors.Prim_kind ],
                Script_tc_errors.Int_kind))
        | cons (Micheline.String loc_value _) _ ⇒
          Error_monad.error_value
            (Build_extensible "Invalid_kind"
              (Alpha_context.Script.location × list Script_tc_errors.kind ×
                Script_tc_errors.kind)
              (loc_value, [ Script_tc_errors.Prim_kind ],
                Script_tc_errors.String_kind))
        | cons (Micheline.Bytes loc_value _) _ ⇒
          Error_monad.error_value
            (Build_extensible "Invalid_kind"
              (Alpha_context.Script.location × list Script_tc_errors.kind ×
                Script_tc_errors.kind)
              (loc_value, [ Script_tc_errors.Prim_kind ],
                Script_tc_errors.Bytes_kind))
        | cons (Micheline.Seq loc_value _) _ ⇒
          Error_monad.error_value
            (Build_extensible "Invalid_kind"
              (Alpha_context.Script.location × list Script_tc_errors.kind ×
                Script_tc_errors.kind)
              (loc_value, [ Script_tc_errors.Prim_kind ],
                Script_tc_errors.Seq_kind))
        |
          cons
            (Micheline.Prim loc_value Michelson_v1_primitives.K_parameter
              (cons arg []) annot) rest ⇒
          match p_value with
          | None ⇒
            find_fields ctxt (Some (arg, loc_value, annot)) s_value c_value
              views rest
          | Some _ ⇒
            Error_monad.error_value
              (Build_extensible "Duplicate_field"
                (Alpha_context.Script.location × Alpha_context.Script.prim)
                (loc_value, Michelson_v1_primitives.K_parameter))
          end
        |
          cons
            (Micheline.Prim loc_value Michelson_v1_primitives.K_storage
              (cons arg []) annot) rest ⇒
          match s_value with
          | None ⇒
            find_fields ctxt p_value (Some (arg, loc_value, annot)) c_value
              views rest
          | Some _ ⇒
            Error_monad.error_value
              (Build_extensible "Duplicate_field"
                (Alpha_context.Script.location × Alpha_context.Script.prim)
                (loc_value, Michelson_v1_primitives.K_storage))
          end
        |
          cons
            (Micheline.Prim loc_value Michelson_v1_primitives.K_code
              (cons arg []) annot) rest ⇒
          match c_value with
          | None ⇒
            find_fields ctxt p_value s_value (Some (arg, loc_value, annot))
              views rest
          | Some _ ⇒
            Error_monad.error_value
              (Build_extensible "Duplicate_field"
                (Alpha_context.Script.location × Alpha_context.Script.prim)
                (loc_value, Michelson_v1_primitives.K_code))
          end
        |
          cons
            (Micheline.Prim loc_value
              ((Michelson_v1_primitives.K_parameter |
              Michelson_v1_primitives.K_storage | Michelson_v1_primitives.K_code)
                as name) args _) _ ⇒
          Error_monad.error_value
            (Build_extensible "Invalid_arity"
              (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
                int) (loc_value, name, 1, (List.length args)))
        |
          cons
            (Micheline.Prim loc_value Michelson_v1_primitives.K_view
              (cons name (cons input_ty (cons output_ty (cons view_code [])))) _)
            rest ⇒
          let ? '(str , ctxt ) := parse_view_name ctxt name in
          let ? ctxt :=
            Alpha_context.Gas.consume ctxt
              (Michelson_v1_gas.Cost_of.Interpreter.view_update str views) in
          if Script_map.mem str views then
            Error_monad.error_value
              (Build_extensible "Duplicated_view_name"
                Alpha_context.Script.location loc_value)
          else
            let views' :=
              Script_map.update str
                (Some
                  {| Script_typed_ir.view.input_ty := input_ty;
                    Script_typed_ir.view.output_ty := output_ty;
                    Script_typed_ir.view.view_code := view_code; |}) views in
            find_fields ctxt p_value s_value c_value views' rest
        |
          cons (Micheline.Prim loc_value Michelson_v1_primitives.K_view args _)
            _ ⇒
          Error_monad.error_value
            (Build_extensible "Invalid_arity"
              (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
                int)
              (loc_value, Michelson_v1_primitives.K_view, 4, (List.length args)))
        | cons (Micheline.Prim loc_value name _ _) _ ⇒
          let allowed :=
            [
              Michelson_v1_primitives.K_parameter;
              Michelson_v1_primitives.K_storage;
              Michelson_v1_primitives.K_code;
              Michelson_v1_primitives.K_view
            ] in
          Error_monad.error_value
            (Build_extensible "Invalid_primitive"
              (Alpha_context.Script.location × list Alpha_context.Script.prim ×
                Alpha_context.Script.prim) (loc_value, allowed, name))
        end in
      let ? '(ctxt , toplevel_value ) :=
        find_fields ctxt None None None
          (Script_map.empty Script_typed_ir.string_t) fields in
      match toplevel_value with
      | (None, _, _, _) ⇒
        Error_monad.error_value
          (Build_extensible "Missing_field" Alpha_context.Script.prim
            Michelson_v1_primitives.K_parameter)
      | (Some _, None, _, _) ⇒
        Error_monad.error_value
          (Build_extensible "Missing_field" Alpha_context.Script.prim
            Michelson_v1_primitives.K_storage)
      | (Some _, Some _, None, _) ⇒
        Error_monad.error_value
          (Build_extensible "Missing_field" Alpha_context.Script.prim
            Michelson_v1_primitives.K_code)
      |
        (Some (p_value, ploc, pannot), Some (s_value, sloc, sannot),
          Some (c_value, cloc, cannot), views) ⇒
        let p_pannot :=
          let ? function_parameter := Script_ir_annot.has_field_annot p_value in
          match function_parameter with
          | true ⇒ return ? (p_value, pannot)
          | false ⇒
            match
              (pannot,
                match pannot with
                | cons single [] ⇒ legacy
                | _ ⇒ false
                end) with
            | (cons single [], true) ⇒
              let ? is_field_annot := Script_ir_annot.is_field_annot ploc single
                in
              match (is_field_annot, p_value) with
              | (true, Micheline.Prim loc_value prim args annots) ⇒
                return ?
                  ((Micheline.Prim loc_value prim args (cons single annots)),
                    nil)
              | _ ⇒ return ? (p_value, nil)
              end
            | (_, _) ⇒ return ? (p_value, pannot)
            end
          end in
        let ? '(arg_type , pannot ) := p_pannot in
        let ? '_ := Script_ir_annot.error_unexpected_annot ploc pannot in
        let ? '_ := Script_ir_annot.error_unexpected_annot cloc cannot in
        let ? '_ := Script_ir_annot.error_unexpected_annot sloc sannot in
        return ?
          ({| toplevel.code_field := c_value; toplevel.arg_type := arg_type;
            toplevel.storage_type := s_value; toplevel.views := views; |}, ctxt)
      end
    end.

Reserved Notation "'parse_views".
Reserved Notation "'parse_kdescr".
Reserved Notation "'parse_lam_rec".
Reserved Notation "'parse_contract".
Reserved Notation "'parse_contract_data_aux".

#[bypass_check(guard)]
Fixpoint parse_data_aux {a : Set}
  (elab_conf : elab_conf) (stack_depth : int) (ctxt : Alpha_context.context)
  (allow_forged : bool) (ty_value : Script_typed_ir.ty)
  (script_data : Alpha_context.Script.node) {struct ctxt}
  : M ? (a × Alpha_context.context ) :=
  let parse_kdescr := 'parse_kdescr in
  let parse_lam_rec := 'parse_lam_rec in
  let parse_contract_data_aux := 'parse_contract_data_aux in
  let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.parse_data_cycle
    in
  let non_terminal_recursion {B : Set}
    (ctxt : Alpha_context.context) (ty_value : Script_typed_ir.ty)
    (script_data : Alpha_context.Script.node)
    : M ? (B × Alpha_context.context ) :=
    if stack_depth >i 10000 then
      Error_monad.tzfail
        (Build_extensible "Typechecking_too_many_recursive_calls" unit tt)
    else
      parse_data_aux elab_conf (stack_depth +i 1) ctxt allow_forged ty_value
        script_data in
  let parse_data_error (function_parameter : unit) : Error_monad._error :=
    let '_ := function_parameter in
    let ty_value := Script_ir_unparser.serialize_ty_for_error ty_value in
    Build_extensible "Invalid_constant"
      (Alpha_context.Script.location ×
        Micheline.canonical Alpha_context.Script.prim ×
        Alpha_context.Script.expr)
      ((location script_data), (Micheline.strip_locations script_data), ty_value)
    in
  let fail_parse_data {B : Set} (function_parameter : unit) : M ? B :=
    let '_ := function_parameter in
    Error_monad.tzfail (parse_data_error tt) in
  let traced_no_lwt {B : Set} (body : M ? B) : M ? B :=
    Error_monad.record_trace_eval parse_data_error body in
  let traced {B : Set} (body : M ? B) : M ? B :=
    Error_monad.trace_eval parse_data_error body in
  let traced_fail {B : Set} (err : Error_monad._error) : M ? B :=
    traced_no_lwt (Error_monad.error_value err) in
  let parse_items {B C D E : Set}
    (ctxt : Alpha_context.context)
    (expr : Micheline.node B Alpha_context.Script.prim)
    (key_type : Script_typed_ir.ty) (value_type : Script_typed_ir.ty)
    (items :
      list
        (Micheline.node Alpha_context.Script.location Alpha_context.Script.prim))
    (item_wrapper : C → D)
    : M ? (Script_typed_ir.map E D × Alpha_context.context ) :=
    let ? '(_, items , ctxt ) :=
      traced
        (List.fold_left_es
          (fun (function_parameter :
            option E × Script_typed_ir.map E D × Alpha_context.context) ⇒
            let '(last_value, map, ctxt) := function_parameter in
            fun (item :
              Micheline.node Alpha_context.Script.location
                Alpha_context.Script.prim) ⇒
              match item with
              |
                Micheline.Prim loc_value Michelson_v1_primitives.D_Elt
                  (cons k_value (cons v_value [])) annot ⇒
                let ? '_ :=
                  if
                    elab_conf.(Script_ir_translator_config.elab_config.legacy)
                  then
                    Result.return_unit
                  else
                    Script_ir_annot.error_unexpected_annot loc_value annot in
                let ? '(k_value , ctxt ) :=
                  non_terminal_recursion ctxt key_type k_value in
                let ? '(v_value , ctxt ) :=
                  non_terminal_recursion ctxt value_type v_value in
                let ? ctxt :=
                  match last_value with
                  | Some value_value ⇒
                    let ? ctxt :=
                      Alpha_context.Gas.consume ctxt
                        (Michelson_v1_gas.Cost_of.Interpreter.compare key_type
                          value_value k_value) in
                    let c_value :=
                      Script_comparable.compare_comparable key_type value_value
                        k_value in
                    if 0 ≤i c_value then
                      if 0 =i c_value then
                        Error_monad.error_value
                          (Build_extensible "Duplicate_map_keys"
                            (Alpha_context.Script.location ×
                              Micheline.canonical Alpha_context.Script.prim)
                            (loc_value, (Micheline.strip_locations expr)))
                      else
                        Error_monad.error_value
                          (Build_extensible "Unordered_map_keys"
                            (Alpha_context.Script.location ×
                              Micheline.canonical Alpha_context.Script.prim)
                            (loc_value, (Micheline.strip_locations expr)))
                    else
                      return ? ctxt
                  | None ⇒ return ? ctxt
                  end in
                let ? ctxt :=
                  Alpha_context.Gas.consume ctxt
                    (Michelson_v1_gas.Cost_of.Interpreter.map_update k_value map)
                  in
                return ?
                  ((Some k_value),
                    (Script_map.update k_value (Some (item_wrapper v_value)) map),
                    ctxt)
              | Micheline.Prim loc_value Michelson_v1_primitives.D_Elt l_value _
                ⇒
                Error_monad.tzfail
                  (Build_extensible "Invalid_arity"
                    (Alpha_context.Script.location × Alpha_context.Script.prim ×
                      int × int)
                    (loc_value, Michelson_v1_primitives.D_Elt, 2,
                      (List.length l_value)))
              | Micheline.Prim loc_value name _ _ ⇒
                Error_monad.tzfail
                  (Build_extensible "Invalid_primitive"
                    (Alpha_context.Script.location ×
                      list Alpha_context.Script.prim × Alpha_context.Script.prim)
                    (loc_value, [ Michelson_v1_primitives.D_Elt ], name))
              |
                (Micheline.Int _ _ | Micheline.String _ _ | Micheline.Bytes _ _
                | Micheline.Seq _ _) ⇒ fail_parse_data tt
              end) (None, (Script_map.empty key_type), ctxt) items) in
    return ? (items, ctxt) in
  let parse_big_map_items {B C D t : Set}
    (ctxt : Alpha_context.context)
    (expr : Micheline.node B Alpha_context.Script.prim)
    (key_type : Script_typed_ir.comparable_ty) (value_type : Script_typed_ir.ty)
    (items :
      list
        (Micheline.node Alpha_context.Script.location Alpha_context.Script.prim))
    (item_wrapper : C → option D)
    : M ? (Script_typed_ir.big_map_overlay t D × Alpha_context.context ) :=
    let ? '(_, map , ctxt ) :=
      traced
        (List.fold_left_es
          (fun (function_parameter :
            option t × Script_typed_ir.big_map_overlay t D ×
              Alpha_context.context) ⇒
            let
              '(last_key, {|
                Script_typed_ir.big_map_overlay.map := map;
                  Script_typed_ir.big_map_overlay.size := size_value
                  |}, ctxt) := function_parameter in
            fun (item :
              Micheline.node Alpha_context.Script.location
                Alpha_context.Script.prim) ⇒
              match item with
              |
                Micheline.Prim loc_value Michelson_v1_primitives.D_Elt
                  (cons k_value (cons v_value [])) annot ⇒
                let ? '_ :=
                  if
                    elab_conf.(Script_ir_translator_config.elab_config.legacy)
                  then
                    Result.return_unit
                  else
                    Script_ir_annot.error_unexpected_annot loc_value annot in
                let ? '(k_value , ctxt ) :=
                  non_terminal_recursion ctxt key_type k_value in
                let ? '(key_hash , ctxt ) :=
                  hash_comparable_data ctxt key_type k_value in
                let ? '(v_value , ctxt ) :=
                  non_terminal_recursion ctxt value_type v_value in
                let ? ctxt :=
                  match last_key with
                  | Some last_key ⇒
                    let ? ctxt :=
                      Alpha_context.Gas.consume ctxt
                        (Michelson_v1_gas.Cost_of.Interpreter.compare key_type
                          last_key k_value) in
                    let c_value :=
                      Script_comparable.compare_comparable key_type last_key
                        k_value in
                    if 0 ≤i c_value then
                      if 0 =i c_value then
                        Error_monad.error_value
                          (Build_extensible "Duplicate_map_keys"
                            (Alpha_context.Script.location ×
                              Micheline.canonical Alpha_context.Script.prim)
                            (loc_value, (Micheline.strip_locations expr)))
                      else
                        Error_monad.error_value
                          (Build_extensible "Unordered_map_keys"
                            (Alpha_context.Script.location ×
                              Micheline.canonical Alpha_context.Script.prim)
                            (loc_value, (Micheline.strip_locations expr)))
                    else
                      return ? ctxt
                  | None ⇒ return ? ctxt
                  end in
                let ? ctxt :=
                  Alpha_context.Gas.consume ctxt
                    (Michelson_v1_gas.Cost_of.Interpreter.big_map_update
                      {| Script_typed_ir.big_map_overlay.map := map;
                        Script_typed_ir.big_map_overlay.size := size_value; |})
                  in
                if
                  Script_typed_ir.Big_map_overlay.(Map.S.mem) key_hash map
                then
                  Error_monad.error_value
                    (Build_extensible "Duplicate_map_keys"
                      (Alpha_context.Script.location ×
                        Micheline.canonical Alpha_context.Script.prim)
                      (loc_value, (Micheline.strip_locations expr)))
                else
                  return ?
                    ((Some k_value),
                      {|
                        Script_typed_ir.big_map_overlay.map :=
                          Script_typed_ir.Big_map_overlay.(Map.S.add) key_hash
                            (k_value, (item_wrapper v_value)) map;
                        Script_typed_ir.big_map_overlay.size := size_value +i 1;
                        |}, ctxt)
              | Micheline.Prim loc_value Michelson_v1_primitives.D_Elt l_value _
                ⇒
                Error_monad.tzfail
                  (Build_extensible "Invalid_arity"
                    (Alpha_context.Script.location × Alpha_context.Script.prim ×
                      int × int)
                    (loc_value, Michelson_v1_primitives.D_Elt, 2,
                      (List.length l_value)))
              | Micheline.Prim loc_value name _ _ ⇒
                Error_monad.tzfail
                  (Build_extensible "Invalid_primitive"
                    (Alpha_context.Script.location ×
                      list Alpha_context.Script.prim × Alpha_context.Script.prim)
                    (loc_value, [ Michelson_v1_primitives.D_Elt ], name))
              |
                (Micheline.Int _ _ | Micheline.String _ _ | Micheline.Bytes _ _
                | Micheline.Seq _ _) ⇒ fail_parse_data tt
              end)
          (None,
            {|
              Script_typed_ir.big_map_overlay.map :=
                Script_typed_ir.Big_map_overlay.(Map.S.empty);
              Script_typed_ir.big_map_overlay.size := 0; |}, ctxt) items) in
    return ? (map, ctxt) in
  let legacy := elab_conf.(Script_ir_translator_config.elab_config.legacy) in
  match (ty_value, script_data) with
  | (Script_typed_ir.Unit_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_unit ctxt legacy expr))
  | (Script_typed_ir.Bool_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_bool ctxt legacy expr))
  | (Script_typed_ir.String_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_string ctxt expr))
  | (Script_typed_ir.Bytes_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_bytes ctxt expr))
  | (Script_typed_ir.Int_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context )) (traced_no_lwt (parse_int ctxt expr))
  | (Script_typed_ir.Nat_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context )) (traced_no_lwt (parse_nat ctxt expr))
  | (Script_typed_ir.Mutez_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_mutez ctxt expr))
  | (Script_typed_ir.Timestamp_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_timestamp ctxt expr))
  | (Script_typed_ir.Key_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context )) (traced_no_lwt (parse_key ctxt expr))
  | (Script_typed_ir.Key_hash_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_key_hash ctxt expr))
  | (Script_typed_ir.Signature_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_signature ctxt expr))
  | (Script_typed_ir.Operation_t, _) ⇒
    cast (M ? (a × Alpha_context.context ))
    ((Error_monad.error_value (a := (unit × Alpha_context.context)))
      (Build_extensible "Asserted" unit tt))
  | (Script_typed_ir.Chain_id_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_chain_id ctxt expr))
  | (Script_typed_ir.Address_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_address ctxt expr))
  | (Script_typed_ir.Tx_rollup_l2_address_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    (traced_no_lwt (parse_tx_rollup_l2_address ctxt expr))
  | (Script_typed_ir.Contract_t arg_ty _, expr) ⇒
    let '[expr, arg_ty] :=
      cast [Alpha_context.Script.node ** Script_typed_ir.ty] [expr, arg_ty] in
    cast (M ? (a × Alpha_context.context ))
    (traced
      (let ? '(address , ctxt ) := parse_address ctxt expr in
      let loc_value := location expr in
      let ? '(ctxt , typed_contract ) :=
        parse_contract_data_aux (stack_depth +i 1) ctxt loc_value arg_ty
          address.(Script_typed_ir.address.destination)
          address.(Script_typed_ir.address.entrypoint) in
      return ? (typed_contract, ctxt)))
  | (Script_typed_ir.Pair_t tl tr _ _, expr) ⇒
    let 'existT _ [__2, __1] [expr, tr, tl] :=
      cast_exists (Es := [Set ** Set])
        (fun '[__2 , __1 ] ⇒
          [Alpha_context.Script.node ** Script_typed_ir.ty **
            Script_typed_ir.ty]) [expr, tr, tl] in
    cast (M ? (a × Alpha_context.context ))
    (let r_witness := comb_witness1 tr in
    let parse_l
      (ctxt : Alpha_context.context) (v_value : Alpha_context.Script.node)
      : M ? (__1 × Alpha_context.context ) :=
      non_terminal_recursion ctxt tl v_value in
    let parse_r
      (ctxt : Alpha_context.context) (v_value : Alpha_context.Script.node)
      : M ? (__2 × Alpha_context.context ) :=
      non_terminal_recursion ctxt tr v_value in
    traced (parse_pair parse_l parse_r ctxt legacy r_witness expr))
  | (Script_typed_ir.Union_t tl tr _ _, expr) ⇒
    let 'existT _ [__4, __3] [expr, tr, tl] :=
      cast_exists (Es := [Set ** Set])
        (fun '[__4 , __3 ] ⇒
          [Alpha_context.Script.node ** Script_typed_ir.ty **
            Script_typed_ir.ty]) [expr, tr, tl] in
    cast (M ? (a × Alpha_context.context ))
    (let parse_l
      (ctxt : Alpha_context.context) (v_value : Alpha_context.Script.node)
      : M ? (__3 × Alpha_context.context ) :=
      non_terminal_recursion ctxt tl v_value in
    let parse_r
      (ctxt : Alpha_context.context) (v_value : Alpha_context.Script.node)
      : M ? (__4 × Alpha_context.context ) :=
      non_terminal_recursion ctxt tr v_value in
    traced (parse_union parse_l parse_r ctxt legacy expr))
  |
    (Script_typed_ir.Lambda_t ta tr _ty_name,
      (Micheline.Seq _loc _) as script_instr) ⇒
    let '[script_instr, _loc, _ty_name, tr, ta] :=
      cast
        [Micheline.node Alpha_context.Script.location Alpha_context.Script.prim
          ** Alpha_context.Script.location ** Script_typed_ir.ty_metadata **
          Script_typed_ir.ty ** Script_typed_ir.ty]
        [script_instr, _loc, _ty_name, tr, ta] in
    cast (M ? (a × Alpha_context.context ))
    (let ? '(kdescr , ctxt ) :=
      traced
        (parse_kdescr elab_conf (stack_depth +i 1) Tc_context.data ctxt ta tr
          script_instr) in
    return ? ((Script_typed_ir.Lam kdescr script_instr), ctxt))
  |
    (Script_typed_ir.Lambda_t ta tr _ty_name,
      Micheline.Prim loc_value Michelson_v1_primitives.D_Lambda_rec
        (cons ((Micheline.Seq _loc _) as script_instr) []) []) ⇒
    let '[script_instr, _loc, loc_value, _ty_name, tr, ta] :=
      cast
        [Micheline.node Alpha_context.Script.location Alpha_context.Script.prim
          ** Alpha_context.Script.location ** Alpha_context.Script.location **
          Script_typed_ir.ty_metadata ** Script_typed_ir.ty **
          Script_typed_ir.ty] [script_instr, _loc, loc_value, _ty_name, tr, ta]
      in
    cast (M ? (a × Alpha_context.context ))
    (traced
      (let ? lambda_rec_ty := Script_typed_ir.lambda_t loc_value ta tr in
      parse_lam_rec elab_conf (stack_depth +i 1)
        (Tc_context.add_lambda Tc_context.data) ctxt ta tr lambda_rec_ty
        script_instr))
  | (Script_typed_ir.Lambda_t _ _ _, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Seq_kind ], (kind_value expr))))
  | (Script_typed_ir.Option_t t_value _ _, expr) ⇒
    let 'existT _ __11 [expr, t_value] :=
      cast_exists (Es := Set)
        (fun __11 ⇒ [Alpha_context.Script.node ** Script_typed_ir.ty])
        [expr, t_value] in
    cast (M ? (a × Alpha_context.context ))
    (let parse_v
      (ctxt : Alpha_context.context) (v_value : Alpha_context.Script.node)
      : M ? (__11 × Alpha_context.context ) :=
      non_terminal_recursion ctxt t_value v_value in
    traced (parse_option parse_v ctxt legacy expr))
  | (Script_typed_ir.List_t t_value _ty_name, Micheline.Seq _loc items) ⇒
    let 'existT _ __12 [items, _loc, _ty_name, t_value] :=
      cast_exists (Es := Set)
        (fun __12 ⇒
          [list
            (Micheline.node Alpha_context.Script.location
              Alpha_context.Script.prim) ** Alpha_context.Script.location **
            Script_typed_ir.ty_metadata ** Script_typed_ir.ty])
        [items, _loc, _ty_name, t_value] in
    cast (M ? (a × Alpha_context.context ))
    (traced
      (List.fold_right_es
        (fun (v_value : Alpha_context.Script.node) ⇒
          fun (function_parameter : Script_list.t __12 × Alpha_context.context)
            ⇒
            let '(rest, ctxt) := function_parameter in
            let ? '(v_value , ctxt ) := non_terminal_recursion ctxt t_value v_value
              in
            return ? ((Script_list.cons_value v_value rest), ctxt)) items
        (Script_list.empty, ctxt)))
  | (Script_typed_ir.List_t _ _, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Seq_kind ], (kind_value expr))))
  | (Script_typed_ir.Ticket_t t_value _ty_name, expr) ⇒
    let 'existT _ __14 [expr, _ty_name, t_value] :=
      cast_exists (Es := Set)
        (fun __14 ⇒
          [Alpha_context.Script.node ** Script_typed_ir.ty_metadata **
            Script_typed_ir.comparable_ty]) [expr, _ty_name, t_value] in
    cast (M ? (a × Alpha_context.context ))
    (if allow_forged then
      let ? ty_value := opened_ticket_type (location expr) t_value in
      let ?
        '(({|
          Script_typed_ir.address.destination := destination ;
            Script_typed_ir.address.entrypoint := _
            |}, (contents , amount )), ctxt ) :=
        non_terminal_recursion ctxt ty_value expr in
      match Ticket_amount.of_n amount with
      | Some amount ⇒
        match destination with
        | Alpha_context.Destination.Contract ticketer ⇒
          return ?
            ({| Script_typed_ir.ticket.ticketer := ticketer;
              Script_typed_ir.ticket.contents := (contents : __14);
              Script_typed_ir.ticket.amount := amount; |}, ctxt)
        |
          (Alpha_context.Destination.Tx_rollup _ |
          Alpha_context.Destination.Sc_rollup _ |
          Alpha_context.Destination.Zk_rollup _) ⇒
          Error_monad.tzfail
            (Build_extensible "Unexpected_ticket_owner"
              Alpha_context.Destination.t destination)
        end
      | None ⇒
        traced_fail (Build_extensible "Forbidden_zero_ticket_quantity" unit tt)
      end
    else
      traced_fail
        (Build_extensible "Unexpected_forged_value"
          Alpha_context.Script.location (location expr)))
  |
    (Script_typed_ir.Set_t t_value _ty_name,
      (Micheline.Seq loc_value vs) as expr) ⇒
    let 'existT _ __15 [expr, vs, loc_value, _ty_name, t_value] :=
      cast_exists (Es := Set)
        (fun __15 ⇒
          [Micheline.node Alpha_context.Script.location
            Alpha_context.Script.prim **
            list
              (Micheline.node Alpha_context.Script.location
                Alpha_context.Script.prim) ** Alpha_context.Script.location **
            Script_typed_ir.ty_metadata ** Script_typed_ir.comparable_ty])
        [expr, vs, loc_value, _ty_name, t_value] in
    cast (M ? (a × Alpha_context.context ))
    (let ? '(_, set , ctxt ) :=
      traced
        (List.fold_left_es
          (fun (function_parameter :
            option __15 × Script_typed_ir.set __15 × Alpha_context.context) ⇒
            let '(last_value, set, ctxt) := function_parameter in
            fun (v_value : Alpha_context.Script.node) ⇒
              let ? '(v_value , ctxt ) :=
                non_terminal_recursion ctxt t_value v_value in
              let ? ctxt :=
                match last_value with
                | Some value_value ⇒
                  let ? ctxt :=
                    Alpha_context.Gas.consume ctxt
                      (Michelson_v1_gas.Cost_of.Interpreter.compare t_value
                        value_value v_value) in
                  let c_value :=
                    Script_comparable.compare_comparable t_value value_value
                      v_value in
                  if 0 ≤i c_value then
                    if 0 =i c_value then
                      Error_monad.error_value
                        (Build_extensible "Duplicate_set_values"
                          (Alpha_context.Script.location ×
                            Micheline.canonical Alpha_context.Script.prim)
                          (loc_value, (Micheline.strip_locations expr)))
                    else
                      Error_monad.error_value
                        (Build_extensible "Unordered_set_values"
                          (Alpha_context.Script.location ×
                            Micheline.canonical Alpha_context.Script.prim)
                          (loc_value, (Micheline.strip_locations expr)))
                  else
                    return ? ctxt
                | None ⇒ return ? ctxt
                end in
              let ? ctxt :=
                Alpha_context.Gas.consume ctxt
                  (Michelson_v1_gas.Cost_of.Interpreter.set_update v_value set)
                in
              return ?
                ((Some v_value), (Script_set.update v_value true set), ctxt))
          (None, (Script_set.empty t_value), ctxt) vs) in
    return ? (set, ctxt))
  | (Script_typed_ir.Set_t _ _, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Seq_kind ], (kind_value expr))))
  | (Script_typed_ir.Map_t tk tv _ty_name, (Micheline.Seq _ vs) as expr) ⇒
    let 'existT _ [__17, __18] [expr, vs, _ty_name, tv, tk] :=
      cast_exists (Es := [Set ** Set])
        (fun '[__17 , __18 ] ⇒
          [Micheline.node Alpha_context.Script.location
            Alpha_context.Script.prim **
            list
              (Micheline.node Alpha_context.Script.location
                Alpha_context.Script.prim) ** Script_typed_ir.ty_metadata **
            Script_typed_ir.ty ** Script_typed_ir.comparable_ty])
        [expr, vs, _ty_name, tv, tk] in
    cast (M ? (a × Alpha_context.context ))
    ((parse_items :
      Alpha_context.context →
      Micheline.node Alpha_context.Script.location Alpha_context.Script.prim →
      Script_typed_ir.ty → Script_typed_ir.ty →
      list
        (Micheline.node Alpha_context.Script.location Alpha_context.Script.prim)
      → (__18 → __18) →
      M ? (Script_typed_ir.map __17 __18 × Alpha_context.context )) ctxt expr tk
      tv vs (fun (x_value : __18) ⇒ x_value))
  | (Script_typed_ir.Map_t _ _ _, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Seq_kind ], (kind_value expr))))
  | (Script_typed_ir.Big_map_t tk tv _ty_name, expr) ⇒
    let 'existT _ [__21, __22] [expr, _ty_name, tv, tk] :=
      cast_exists (Es := [Set ** Set])
        (fun '[__21 , __22 ] ⇒
          [Alpha_context.Script.node ** Script_typed_ir.ty_metadata **
            Script_typed_ir.ty ** Script_typed_ir.comparable_ty])
        [expr, _ty_name, tv, tk] in
    cast (M ? (a × Alpha_context.context ))
    (let ? '(id_opt , diff_value , ctxt ) :=
      match expr with
      | Micheline.Int loc_value id ⇒
        ((return ?
          ((Some (id, loc_value)),
            {|
              Script_typed_ir.big_map_overlay.map :=
                Script_typed_ir.Big_map_overlay.(Map.S.empty);
              Script_typed_ir.big_map_overlay.size := 0; |}, ctxt)) :
          M ?
            (option (Z.t × Alpha_context.Script.location) ×
              Script_typed_ir.big_map_overlay __21 __22 × Alpha_context.context ))
      | Micheline.Seq _ vs ⇒
        let ? '(diff_value , ctxt ) :=
          parse_big_map_items ctxt expr tk tv vs
            (fun (x_value : __22) ⇒ Some x_value) in
        return ? (None, diff_value, ctxt)
      |
        Micheline.Prim loc_value Michelson_v1_primitives.D_Pair
          (cons (Micheline.Int loc_id id) (cons (Micheline.Seq _ vs) [])) annot
        ⇒
        let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
        let ? tv_opt := Script_typed_ir.option_t loc_value tv in
        let ? '(diff_value , ctxt ) :=
          parse_big_map_items ctxt expr tk tv_opt vs
            (fun (x_value : option __22) ⇒ x_value) in
        return ? ((Some (id, loc_id)), diff_value, ctxt)
      |
        Micheline.Prim _ Michelson_v1_primitives.D_Pair
          (cons (Micheline.Int _ _) (cons expr [])) _ ⇒
        traced_fail
          (Build_extensible "Invalid_kind"
            (Alpha_context.Script.location × list Script_tc_errors.kind ×
              Script_tc_errors.kind)
            ((location expr), [ Script_tc_errors.Seq_kind ], (kind_value expr)))
      |
        Micheline.Prim _ Michelson_v1_primitives.D_Pair (cons expr (cons _ []))
          _ ⇒
        traced_fail
          (Build_extensible "Invalid_kind"
            (Alpha_context.Script.location × list Script_tc_errors.kind ×
              Script_tc_errors.kind)
            ((location expr), [ Script_tc_errors.Int_kind ], (kind_value expr)))
      | Micheline.Prim loc_value Michelson_v1_primitives.D_Pair l_value _ ⇒
        traced_fail
          (Build_extensible "Invalid_arity"
            (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
              int)
            (loc_value, Michelson_v1_primitives.D_Pair, 2, (List.length l_value)))
      | _ ⇒
        traced_fail
          (unexpected expr
            [ Script_tc_errors.Seq_kind; Script_tc_errors.Int_kind ]
            Michelson_v1_primitives.Constant_namespace
            [ Michelson_v1_primitives.D_Pair ])
      end in
    let ? '(id , ctxt ) :=
      match id_opt with
      | None ⇒ return ? (None, ctxt)
      | Some (id, loc_value) ⇒
        if allow_forged then
          let id := Alpha_context.Big_map.Id.parse_z id in
          let ? function_parameter := Alpha_context.Big_map._exists ctxt id in
          match function_parameter with
          | (_, None) ⇒
            traced_fail
              (Build_extensible "Invalid_big_map"
                (Alpha_context.Script.location × Alpha_context.Big_map.Id.t)
                (loc_value, id))
          | (ctxt, Some (btk, btv)) ⇒
            let ? '(Ex_comparable_ty btk , ctxt ) :=
              parse_comparable_ty_aux ctxt (stack_depth +i 1)
                (Micheline.root_value btk) in
            let ? '(Script_typed_ir.Ex_ty btv , ctxt ) :=
              parse_big_map_value_ty_aux ctxt (stack_depth +i 1) legacy
                (Micheline.root_value btv) in
            let ? '(eq_value , ctxt ) :=
              Gas_monad.run ctxt
                (let error_details := Script_tc_errors.Informative loc_value in
                Gas_monad.Syntax.op_letstar (ty_eq error_details tk btk)
                  (fun function_parameter ⇒
                    let 'Eq := function_parameter in
                    ty_eq error_details tv btv)) in
            let ? 'Eq := eq_value in
            return ? ((Some id), ctxt)
          end
        else
          traced_fail
            (Build_extensible "Unexpected_forged_value"
              Alpha_context.Script.location loc_value)
      end in
    return ?
      ((Script_typed_ir.Big_map
        {| Script_typed_ir.big_map.Big_map.id := id;
          Script_typed_ir.big_map.Big_map.diff := diff_value;
          Script_typed_ir.big_map.Big_map.key_type := tk;
          Script_typed_ir.big_map.Big_map.value_type := tv; |}), ctxt))
  | (Script_typed_ir.Never_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context )) (traced_no_lwt (parse_never expr))
  | (Script_typed_ir.Bls12_381_g1_t, Micheline.Bytes _ bs) ⇒
    let bs := cast bytes bs in
    cast (M ? (a × Alpha_context.context ))
    (let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.bls12_381_g1 in
    match
      Script_typed_ir.Script_bls.G1.(Script_typed_ir.Script_bls.S.of_bytes_opt)
        bs with
    | Some pt ⇒ return ? (pt, ctxt)
    | None ⇒ fail_parse_data tt
    end)
  | (Script_typed_ir.Bls12_381_g1_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Bytes_kind ], (kind_value expr))))
  | (Script_typed_ir.Bls12_381_g2_t, Micheline.Bytes _ bs) ⇒
    let bs := cast bytes bs in
    cast (M ? (a × Alpha_context.context ))
    (let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.bls12_381_g2 in
    match
      Script_typed_ir.Script_bls.G2.(Script_typed_ir.Script_bls.S.of_bytes_opt)
        bs with
    | Some pt ⇒ return ? (pt, ctxt)
    | None ⇒ fail_parse_data tt
    end)
  | (Script_typed_ir.Bls12_381_g2_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Bytes_kind ], (kind_value expr))))
  | (Script_typed_ir.Bls12_381_fr_t, Micheline.Bytes _ bs) ⇒
    let bs := cast bytes bs in
    cast (M ? (a × Alpha_context.context ))
    (let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.bls12_381_fr in
    match Script_typed_ir.Script_bls.Fr.of_bytes_opt bs with
    | Some pt ⇒ return ? (pt, ctxt)
    | None ⇒ fail_parse_data tt
    end)
  | (Script_typed_ir.Bls12_381_fr_t, Micheline.Int _ v_value) ⇒
    let v_value := cast Z.t v_value in
    cast (M ? (a × Alpha_context.context ))
    (let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.bls12_381_fr in
    return ? ((Script_typed_ir.Script_bls.Fr.of_z v_value), ctxt))
  | (Script_typed_ir.Bls12_381_fr_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Bytes_kind ], (kind_value expr))))
  |
    (Script_typed_ir.Sapling_transaction_t memo_size,
      Micheline.Bytes _ bytes_value) ⇒
    let '[bytes_value, memo_size] :=
      cast [bytes ** Alpha_context.Sapling.Memo_size.t] [bytes_value, memo_size]
      in
    cast (M ? (a × Alpha_context.context ))
    match
      Data_encoding.Binary.of_bytes_opt
        Alpha_context.Sapling.transaction_encoding bytes_value with
    | Some transaction ⇒
      match Alpha_context.Sapling.transaction_get_memo_size transaction with
      | None ⇒ return ? (transaction, ctxt)
      | Some transac_memo_size ⇒
        let ? '_ :=
          memo_size_eq (Script_tc_errors.Informative tt) memo_size
            transac_memo_size in
        return ? (transaction, ctxt)
      end
    | None ⇒ fail_parse_data tt
    end
  | (Script_typed_ir.Sapling_transaction_t _, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Bytes_kind ], (kind_value expr))))
  |
    (Script_typed_ir.Sapling_transaction_deprecated_t memo_size,
      Micheline.Bytes _ bytes_value) ⇒
    let '[bytes_value, memo_size] :=
      cast [bytes ** Alpha_context.Sapling.Memo_size.t] [bytes_value, memo_size]
      in
    cast (M ? (a × Alpha_context.context ))
    match
      Data_encoding.Binary.of_bytes_opt
        Alpha_context.Sapling.Legacy.transaction_encoding bytes_value with
    | Some transaction ⇒
      match Alpha_context.Sapling.Legacy.transaction_get_memo_size transaction
        with
      | None ⇒ return ? (transaction, ctxt)
      | Some transac_memo_size ⇒
        let ? '_ :=
          memo_size_eq (Script_tc_errors.Informative tt) memo_size
            transac_memo_size in
        return ? (transaction, ctxt)
      end
    | None ⇒ fail_parse_data tt
    end
  | (Script_typed_ir.Sapling_transaction_deprecated_t _, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Bytes_kind ], (kind_value expr))))
  | (Script_typed_ir.Sapling_state_t memo_size, Micheline.Int loc_value id) ⇒
    let '[id, loc_value, memo_size] :=
      cast
        [Z.t ** Alpha_context.Script.location **
          Alpha_context.Sapling.Memo_size.t] [id, loc_value, memo_size] in
    cast (M ? (a × Alpha_context.context ))
    (if allow_forged then
      let id := Alpha_context.Sapling.Id.parse_z id in
      let ? '(state_value , ctxt ) := Alpha_context.Sapling.state_from_id ctxt id
        in
      let ? '_ :=
        traced_no_lwt
          (memo_size_eq (Script_tc_errors.Informative tt) memo_size
            state_value.(Alpha_context.Sapling.state.memo_size)) in
      return ? (state_value, ctxt)
    else
      traced_fail
        (Build_extensible "Unexpected_forged_value"
          Alpha_context.Script.location loc_value))
  | (Script_typed_ir.Sapling_state_t memo_size, Micheline.Seq _ []) ⇒
    let memo_size := cast Alpha_context.Sapling.Memo_size.t memo_size in
    cast (M ? (a × Alpha_context.context ))
    ((Error_monad._return :
      Alpha_context.Sapling.state × Alpha_context.context →
      M ? (Alpha_context.Sapling.state × Alpha_context.context ))
      ((Alpha_context.Sapling.empty_state None memo_size tt), ctxt))
  | (Script_typed_ir.Sapling_state_t _, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr),
          [ Script_tc_errors.Int_kind; Script_tc_errors.Seq_kind ],
          (kind_value expr))))
  | (Script_typed_ir.Chest_key_t, Micheline.Bytes _ bytes_value) ⇒
    let bytes_value := cast bytes bytes_value in
    cast (M ? (a × Alpha_context.context ))
    (let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.chest_key_value
      in
    match
      Data_encoding.Binary.of_bytes_opt
        Script_typed_ir.Script_timelock.chest_key_encoding bytes_value with
    | Some chest_key_value ⇒ return ? (chest_key_value, ctxt)
    | None ⇒ fail_parse_data tt
    end)
  | (Script_typed_ir.Chest_key_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Bytes_kind ], (kind_value expr))))
  | (Script_typed_ir.Chest_t, Micheline.Bytes _ bytes_value) ⇒
    let bytes_value := cast bytes bytes_value in
    cast (M ? (a × Alpha_context.context ))
    (let ? ctxt :=
      Alpha_context.Gas.consume ctxt
        (Typecheck_costs.chest_value (Bytes.length bytes_value)) in
    match
      Data_encoding.Binary.of_bytes_opt
        Script_typed_ir.Script_timelock.chest_encoding bytes_value with
    | Some chest_value ⇒ return ? (chest_value, ctxt)
    | None ⇒ fail_parse_data tt
    end)
  | (Script_typed_ir.Chest_t, expr) ⇒
    let expr := cast Alpha_context.Script.node expr in
    cast (M ? (a × Alpha_context.context ))
    ((traced_fail (B := a × Raw_context.t))
      (Build_extensible "Invalid_kind"
        (Alpha_context.Script.location × list Script_tc_errors.kind ×
          Script_tc_errors.kind)
        ((location expr), [ Script_tc_errors.Bytes_kind ], (kind_value expr))))
  end

with parse_view
  (elab_conf : elab_conf) (ctxt : Alpha_context.context)
  (storage_type : Script_typed_ir.ty)
  (function_parameter : Script_typed_ir.view) {struct ctxt}
  : M ? (typed_view × Alpha_context.context ) :=
  let '{|
    Script_typed_ir.view.input_ty := input_ty;
      Script_typed_ir.view.output_ty := output_ty;
      Script_typed_ir.view.view_code := view_code
      |} := function_parameter in
  let legacy := elab_conf.(Script_ir_translator_config.elab_config.legacy) in
  let input_ty_loc := location input_ty in
  let ? '(Script_typed_ir.Ex_ty input_ty , ctxt ) :=
    Error_monad.record_trace_eval
      (fun (function_parameter : unit) ⇒
        let '_ := function_parameter in
        Build_extensible "Ill_formed_type"
          (option string × Micheline.canonical Alpha_context.Script.prim ×
            Alpha_context.Script.location)
          ((Some "arg of view"), (Micheline.strip_locations input_ty),
            input_ty_loc)) (parse_view_input_ty ctxt 0 legacy input_ty) in
  let output_ty_loc := location output_ty in
  let ? '(Script_typed_ir.Ex_ty output_ty , ctxt ) :=
    Error_monad.record_trace_eval
      (fun (function_parameter : unit) ⇒
        let '_ := function_parameter in
        Build_extensible "Ill_formed_type"
          (option string × Micheline.canonical Alpha_context.Script.prim ×
            Alpha_context.Script.location)
          ((Some "return of view"), (Micheline.strip_locations output_ty),
            output_ty_loc)) (parse_view_output_ty ctxt 0 legacy output_ty) in
  let ? 'Script_typed_ir.Ty_ex_c pair_ty :=
    Script_typed_ir.pair_t input_ty_loc input_ty storage_type in
  let ? '(judgement_value , ctxt ) :=
    parse_instr_aux elab_conf 0 Tc_context.view ctxt view_code
      (Script_typed_ir.Item_t pair_ty Script_typed_ir.Bot_t) in
  match judgement_value with
  | Failed {| judgement.Failed.descr := descr_value |} ⇒
    let '{| Script_typed_ir.kdescr.kinstr := kinstr |} :=
      close_descr
        (descr_value (Script_typed_ir.Item_t output_ty Script_typed_ir.Bot_t))
      in
    return ?
      ((Typed_view
        {| typed_view.Typed_view.input_ty := input_ty;
          typed_view.Typed_view.output_ty := output_ty;
          typed_view.Typed_view.kinstr := kinstr;
          typed_view.Typed_view.original_code_expr := view_code; |}), ctxt)
  | Typed ({| descr.loc := loc_value; descr.aft := aft |} as descr_value) ⇒
    let ill_type_view
      (stack_ty : Script_typed_ir.stack_ty)
      (loc_value : Alpha_context.Script.location) : Error_monad._error :=
      let actual := Script_ir_unparser.serialize_stack_for_error ctxt stack_ty
        in
      let expected_stack :=
        Script_typed_ir.Item_t output_ty Script_typed_ir.Bot_t in
      let expected :=
        Script_ir_unparser.serialize_stack_for_error ctxt expected_stack in
      Build_extensible "Ill_typed_view" Script_tc_errors.Ill_typed_view
        {| Script_tc_errors.Ill_typed_view.loc := loc_value;
          Script_tc_errors.Ill_typed_view.actual := actual;
          Script_tc_errors.Ill_typed_view.expected := expected; |} in
    match aft with
    | Script_typed_ir.Item_t ty_value Script_typed_ir.Bot_t ⇒
      let error_details := Script_tc_errors.Informative loc_value in
      let ? '(eq_value , ctxt ) :=
        Gas_monad.run ctxt
          (Gas_monad.record_trace_eval error_details
            (fun (loc_value : Alpha_context.Script.location) ⇒
              ill_type_view aft loc_value)
            (ty_eq error_details ty_value output_ty)) in
      let ? 'Eq := eq_value in
      let '{| Script_typed_ir.kdescr.kinstr := kinstr |} :=
        close_descr descr_value in
      return ?
        ((Typed_view
          {| typed_view.Typed_view.input_ty := input_ty;
            typed_view.Typed_view.output_ty := output_ty;
            typed_view.Typed_view.kinstr := kinstr;
            typed_view.Typed_view.original_code_expr := view_code; |}), ctxt)
    | _ ⇒ Error_monad.error_value (ill_type_view aft loc_value)
    end
  end

with parse_instr_aux
  (elab_conf : elab_conf) (stack_depth : int) (tc_context_value : tc_context)
  (ctxt : Alpha_context.context) (script_instr : Alpha_context.Script.node)
  (stack_ty : Script_typed_ir.stack_ty) {struct ctxt}
  : M ? (judgement × Alpha_context.context ) :=
  let parse_views := 'parse_views in
  let parse_kdescr := 'parse_kdescr in
  let parse_lam_rec := 'parse_lam_rec in
  let for_logging_only {A : Set} (x_value : A) : option A :=
    if
      elab_conf.(Script_ir_translator_config.elab_config.keep_extra_types_for_interpreter_logging)
    then
      Some x_value
    else
      None in
  let check_item_ty
    (ctxt : Alpha_context.context) (exp : Script_typed_ir.ty)
    (got : Script_typed_ir.ty) (loc_value : Alpha_context.Script.location)
    (name : Alpha_context.Script.prim) (n_value : int) (m_value : int)
    : M ? (eq × Alpha_context.context ) :=
    Error_monad.record_trace_eval
      (fun (function_parameter : unit) ⇒
        let '_ := function_parameter in
        let stack_ty :=
          Script_ir_unparser.serialize_stack_for_error ctxt stack_ty in
        Build_extensible "Bad_stack"
          (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
            Script_tc_errors.unparsed_stack_ty)
          (loc_value, name, m_value, stack_ty))
      (Error_monad.record_trace (Build_extensible "Bad_stack_item" int n_value)
        (let ? '(eq_value , ctxt ) :=
          Gas_monad.run ctxt
            (ty_eq (Script_tc_errors.Informative loc_value) exp got) in
        let ? 'Eq := eq_value in
        return ? (Eq, ctxt))) in
  let log_stack
    (loc_value : Alpha_context.Script.location)
    (stack_ty : Script_typed_ir.stack_ty) (aft : Script_typed_ir.stack_ty)
    : unit :=
    match
      (elab_conf.(Script_ir_translator_config.elab_config.type_logger),
        script_instr) with
    |
      ((None, _) |
      (Some _, (Micheline.Int _ _ | Micheline.String _ _ | Micheline.Bytes _ _)))
      ⇒ tt
    | (Some log, (Micheline.Prim _ _ _ _ | Micheline.Seq _ _)) ⇒
      let stack_ty_before :=
        Script_ir_unparser.unparse_stack_uncarbonated stack_ty in
      let stack_ty_after := Script_ir_unparser.unparse_stack_uncarbonated aft in
      log loc_value stack_ty_before stack_ty_after
    end in
  let typed_no_lwt {A B : Set}
    (ctxt : A) (loc_value : Alpha_context.Script.location) (instr : cinstr)
    (aft : Script_typed_ir.stack_ty) : Pervasives.result (judgement × A) B :=
    let '_ := log_stack loc_value stack_ty aft in
    let j_value :=
      Typed
        {| descr.loc := loc_value; descr.bef := stack_ty; descr.aft := aft;
          descr.instr := instr; |} in
    Pervasives.Ok (j_value, ctxt) in
  let typed {A B : Set}
    (ctxt : A) (loc_value : Alpha_context.Script.location) (instr : cinstr)
    (aft : Script_typed_ir.stack_ty) : Pervasives.result (judgement × A) B :=
    typed_no_lwt ctxt loc_value instr aft in
  let ? ctxt := Alpha_context.Gas.consume ctxt Typecheck_costs.parse_instr_cycle
    in
  let non_terminal_recursion
    (tc_context_value : tc_context) (ctxt : Alpha_context.context)
    (script_instr : Alpha_context.Script.node)
    (stack_ty : Script_typed_ir.stack_ty)
    : M ? (judgement × Alpha_context.context ) :=
    if stack_depth >i 10000 then
      Error_monad.tzfail
        (Build_extensible "Typechecking_too_many_recursive_calls" unit tt)
    else
      parse_instr_aux elab_conf (stack_depth +i 1) tc_context_value ctxt
        script_instr stack_ty in
  let bad_stack_error {A : Set}
    (ctxt : Alpha_context.context) (loc_value : Alpha_context.Script.location)
    (prim : Alpha_context.Script.prim) (relevant_stack_portion : int) : M ? A :=
    let whole_stack :=
      Script_ir_unparser.serialize_stack_for_error ctxt stack_ty in
    Error_monad.error_value
      (Build_extensible "Bad_stack"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
          Script_tc_errors.unparsed_stack_ty)
        (loc_value, prim, relevant_stack_portion, whole_stack)) in
  let legacy := elab_conf.(Script_ir_translator_config.elab_config.legacy) in
  match (script_instr, stack_ty) with
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DROP [] annot,
      Script_typed_ir.Item_t _ rest) ⇒
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    typed ctxt loc_value
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IDrop loc_value k_value; |} rest
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DROP (cons n_value [])
      result_annot, whole_stack) ⇒
    let ? whole_n := parse_uint10 n_value in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.proof_argument whole_n) in
    let fix make_proof_argument (n_value : int) (stk : Script_typed_ir.stack_ty)
      : M ? dropn_proof_argument :=
      match ((n_value =i 0), stk) with
      | (true, rest) ⇒
        return ? (Dropn_proof_argument Script_typed_ir.KRest rest)
      | (false, Script_typed_ir.Item_t a_value rest) ⇒
        let ? 'Dropn_proof_argument n' stack_after_drops :=
          make_proof_argument (n_value -i 1) rest in
        return ?
          (Dropn_proof_argument (Script_typed_ir.KPrefix loc_value a_value n')
            stack_after_drops )
      | (_, _) ⇒
        let whole_stack :=
          Script_ir_unparser.serialize_stack_for_error ctxt whole_stack in
        Error_monad.error_value
          (Build_extensible "Bad_stack"
            (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
              Script_tc_errors.unparsed_stack_ty)
            (loc_value, Michelson_v1_primitives.I_DROP, whole_n, whole_stack))
      end in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value result_annot in
    let ? 'Dropn_proof_argument n' stack_after_drops :=
      make_proof_argument whole_n whole_stack in
    let kdropn (k_value : Script_typed_ir.kinstr) : Script_typed_ir.kinstr :=
      Script_typed_ir.IDropn loc_value whole_n n' k_value in
    typed ctxt loc_value {| cinstr.apply := kdropn; |} stack_after_drops
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DROP
      ((cons _ (cons _ _)) as l_value) _, _) ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.I_DROP, 1, (List.length l_value)))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DUP [] annot,
      (Script_typed_ir.Item_t v_value _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? ctxt :=
      Error_monad.record_trace_eval
        (fun (function_parameter : unit) ⇒
          let '_ := function_parameter in
          let t_value := Script_ir_unparser.serialize_ty_for_error v_value in
          Build_extensible "Non_dupable_type"
            (Alpha_context.Script.location × Alpha_context.Script.expr)
            (loc_value, t_value)) (check_dupable_ty ctxt loc_value v_value) in
    let dup :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IDup loc_value k_value; |} in
    typed ctxt loc_value dup (Script_typed_ir.Item_t v_value stack_value)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DUP (cons n_value [])
      v_annot, (Script_typed_ir.Item_t _ _) as stack_ty) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value v_annot in
    let fix make_proof_argument
      (n_value : int) (stack_ty : Script_typed_ir.stack_ty)
      : M ? dup_n_proof_argument :=
      match (n_value, stack_ty) with
      | (1, Script_typed_ir.Item_t hd_ty _) ⇒
        return ? (Dup_n_proof_argument Script_typed_ir.Dup_n_zero hd_ty)
      |
        (n_value,
          Script_typed_ir.Item_t _ ((Script_typed_ir.Item_t _ _) as tl_ty)) ⇒
        let ? 'Dup_n_proof_argument dup_n_witness b_ty :=
          make_proof_argument (n_value -i 1) tl_ty in
        return ?
          (Dup_n_proof_argument (Script_typed_ir.Dup_n_succ dup_n_witness) b_ty )
      | _ ⇒ bad_stack_error ctxt loc_value Michelson_v1_primitives.I_DUP 1
      end in
    let ? n_value := parse_uint10 n_value in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.proof_argument n_value) in
    let ? '_ :=
      Error_monad.error_unless (n_value >i 0)
        (Build_extensible "Dup_n_bad_argument" Alpha_context.Script.location
          loc_value) in
    let ? 'Dup_n_proof_argument witness after_ty :=
      Error_monad.record_trace
        (Build_extensible "Dup_n_bad_stack" Alpha_context.Script.location
          loc_value) (make_proof_argument n_value stack_ty) in
    let ? ctxt :=
      Error_monad.record_trace_eval
        (fun (function_parameter : unit) ⇒
          let '_ := function_parameter in
          let t_value := Script_ir_unparser.serialize_ty_for_error after_ty in
          Build_extensible "Non_dupable_type"
            (Alpha_context.Script.location × Alpha_context.Script.expr)
            (loc_value, t_value)) (check_dupable_ty ctxt loc_value after_ty) in
    let dupn :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IDup_n loc_value n_value witness k_value; |} in
    typed ctxt loc_value dupn (Script_typed_ir.Item_t after_ty stack_ty)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DIG (cons n_value [])
      result_annot, stack_value) ⇒
    let fix make_proof_argument (n_value : int) (stk : Script_typed_ir.stack_ty)
      : M ? dig_proof_argument :=
      match ((n_value =i 0), stk) with
      | (true, Script_typed_ir.Item_t v_value rest) ⇒
        return ? (Dig_proof_argument Script_typed_ir.KRest v_value rest)
      | (false, Script_typed_ir.Item_t v_value rest) ⇒
        let ? 'Dig_proof_argument n' x_value aft' :=
          make_proof_argument (n_value -i 1) rest in
        return ?
          (Dig_proof_argument (Script_typed_ir.KPrefix loc_value v_value n')
            x_value (Script_typed_ir.Item_t v_value aft'))
      | (_, _) ⇒
        let whole_stack :=
          Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
        Error_monad.error_value
          (Build_extensible "Bad_stack"
            (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
              Script_tc_errors.unparsed_stack_ty)
            (loc_value, Michelson_v1_primitives.I_DIG, 3, whole_stack))
      end in
    let ? n_value := parse_uint10 n_value in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.proof_argument n_value) in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value result_annot in
    let ? 'Dig_proof_argument n' x_value aft :=
      make_proof_argument n_value stack_value in
    let dig :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IDig loc_value n_value n' k_value; |} in
    typed ctxt loc_value dig (Script_typed_ir.Item_t x_value aft)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DIG
      (([] | cons _ (cons _ _)) as l_value) _, _) ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.I_DIG, 1, (List.length l_value)))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DUG (cons n_value [])
      result_annot, Script_typed_ir.Item_t x_value whole_stack) ⇒
    let ? whole_n := parse_uint10 n_value in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.proof_argument whole_n) in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value result_annot in
    match make_dug_proof_argument loc_value whole_n x_value whole_stack with
    | None ⇒
      let whole_stack :=
        Script_ir_unparser.serialize_stack_for_error ctxt whole_stack in
      Error_monad.tzfail
        (Build_extensible "Bad_stack"
          (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
            Script_tc_errors.unparsed_stack_ty)
          (loc_value, Michelson_v1_primitives.I_DUG, whole_n, whole_stack))
    | Some (Dug_proof_argument (n', aft)) ⇒
      let dug :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              Script_typed_ir.IDug loc_value whole_n n' k_value; |} in
      typed ctxt loc_value dug aft
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DUG (cons _ [])
      result_annot, stack_value) ⇒
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value result_annot in
    let stack_value :=
      Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
    Error_monad.error_value
      (Build_extensible "Bad_stack"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
          Script_tc_errors.unparsed_stack_ty)
        (loc_value, Michelson_v1_primitives.I_DUG, 1, stack_value))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DUG
      (([] | cons _ (cons _ _)) as l_value) _, _) ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.I_DUG, 1, (List.length l_value)))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SWAP [] annot,
      Script_typed_ir.Item_t v_value (Script_typed_ir.Item_t w_value rest)) ⇒
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let swap :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISwap loc_value k_value; |} in
    let stack_ty :=
      Script_typed_ir.Item_t w_value (Script_typed_ir.Item_t v_value rest) in
    typed ctxt loc_value swap stack_ty
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_PUSH
      (cons t_value (cons d_value [])) annot, stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? '(Script_typed_ir.Ex_ty t_value , ctxt ) :=
      parse_packable_ty_aux ctxt (stack_depth +i 1) legacy t_value in
    let 'existT _ __Ex_ty_'a3 [ctxt, t_value] :=
      cast_exists (Es := Set)
        (fun __Ex_ty_'a3 ⇒ [Alpha_context.context ** Script_typed_ir.ty])
        [ctxt, t_value] in
    let ? '(v_value , ctxt ) :=
      parse_data_aux elab_conf (stack_depth +i 1) ctxt false t_value d_value in
    let const :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IConst loc_value t_value (v_value : __Ex_ty_'a3)
              k_value; |} in
    typed ctxt loc_value const (Script_typed_ir.Item_t t_value stack_value)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_UNIT [] annot,
      stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let const :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IConst loc_value Script_typed_ir.unit_t tt k_value;
        |} in
    typed ctxt loc_value const
      (Script_typed_ir.Item_t Script_typed_ir.unit_t stack_value)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SOME [] annot,
      Script_typed_ir.Item_t t_value rest) ⇒
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let cons_some :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICons_some loc_value k_value; |} in
    let ? ty_value := Script_typed_ir.option_t loc_value t_value in
    typed ctxt loc_value cons_some (Script_typed_ir.Item_t ty_value rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NONE (cons t_value [])
      annot, stack_value) ⇒
    let ? '(Script_typed_ir.Ex_ty t_value , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy t_value in
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let cons_none :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICons_none loc_value t_value k_value; |} in
    let ? ty_value := Script_typed_ir.option_t loc_value t_value in
    let stack_ty := Script_typed_ir.Item_t ty_value stack_value in
    typed ctxt loc_value cons_none stack_ty
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MAP (cons body []) annot,
      Script_typed_ir.Item_t (Script_typed_ir.Option_t t_value _ _) rest) ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] body in
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt body
        (Script_typed_ir.Item_t t_value rest) in
    match judgement_value with
    |
      Typed
        ({|
          descr.loc := loc_value;
            descr.aft := Script_typed_ir.Item_t ret_value aft_rest
            |} as kibody) ⇒
      let invalid_map_body (function_parameter : unit) : Error_monad._error :=
        let '_ := function_parameter in
        let aft :=
          Script_ir_unparser.serialize_stack_for_error ctxt kibody.(descr.aft)
          in
        Build_extensible "Invalid_map_body"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty)
          (loc_value, aft) in
      Error_monad.record_trace_eval invalid_map_body
        (let ? '(Eq , ctxt ) := stack_eq loc_value ctxt 1 aft_rest rest in
        let ? opt_ty := Script_typed_ir.option_t loc_value ret_value in
        let final_stack := Script_typed_ir.Item_t opt_ty rest in
        let body :=
          kibody.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt loc_value)
          in
        let apply (k_value : Script_typed_ir.kinstr) : Script_typed_ir.kinstr :=
          Script_typed_ir.IOpt_map
            {| Script_typed_ir.kinstr.IOpt_map.loc := loc_value;
              Script_typed_ir.kinstr.IOpt_map.body := body;
              Script_typed_ir.kinstr.IOpt_map.k := k_value; |} in
        typed_no_lwt ctxt loc_value {| cinstr.apply := apply; |} final_stack)
    | Typed {| descr.aft := Script_typed_ir.Bot_t |} ⇒
      let aft :=
        Script_ir_unparser.serialize_stack_for_error ctxt Script_typed_ir.Bot_t
        in
      Error_monad.error_value
        (Build_extensible "Invalid_map_body"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty)
          (loc_value, aft))
    | Failed _ ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_map_block_fail" Alpha_context.Script.location
          loc_value)
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_IF_NONE
      (cons bt (cons bf [])) annot,
      (Script_typed_ir.Item_t (Script_typed_ir.Option_t t_value _ _) rest) as
        bef) ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] bt in
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] bf in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(btr , ctxt ) := non_terminal_recursion tc_context_value ctxt bt rest in
    let stack_ty := Script_typed_ir.Item_t t_value rest in
    let ? '(bfr , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt bf stack_ty in
    let branch (ibt : descr) (ibf : descr) : descr :=
      let ifnone :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              let hloc := Script_typed_ir.kinstr_location k_value in
              let branch_if_none : Script_typed_ir.kinstr :=
                ibt.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hloc)
              in let branch_if_some : Script_typed_ir.kinstr :=
                ibf.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hloc) in
              Script_typed_ir.IIf_none
                {| Script_typed_ir.kinstr.IIf_none.loc := loc_value;
                  Script_typed_ir.kinstr.IIf_none.branch_if_none :=
                    branch_if_none;
                  Script_typed_ir.kinstr.IIf_none.branch_if_some :=
                    branch_if_some;
                  Script_typed_ir.kinstr.IIf_none.k := k_value; |}; |} in
      {| descr.loc := loc_value; descr.bef := bef; descr.aft := ibt.(descr.aft);
        descr.instr := ifnone; |} in
    merge_branches ctxt loc_value btr bfr {| branch.branch := branch; |}
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_PAIR [] annot,
      Script_typed_ir.Item_t a_value (Script_typed_ir.Item_t b_value rest)) ⇒
    let ? '_ := Script_ir_annot.check_constr_annot loc_value annot in
    let ? 'Script_typed_ir.Ty_ex_c ty_value :=
      Script_typed_ir.pair_t loc_value a_value b_value in
    let stack_ty := Script_typed_ir.Item_t ty_value rest in
    let cons_pair :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICons_pair loc_value k_value; |} in
    typed ctxt loc_value cons_pair stack_ty
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_PAIR (cons n_value [])
      annot, (Script_typed_ir.Item_t _ _) as stack_ty) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let fix make_proof_argument
      (n_value : int) (stack_ty : Script_typed_ir.stack_ty)
      : M ? comb_proof_argument :=
      match (n_value, stack_ty) with
      | (1, Script_typed_ir.Item_t _ _) ⇒
        return ? (Comb_proof_argument Script_typed_ir.Comb_one stack_ty )
      |
        (n_value,
          Script_typed_ir.Item_t a_ty ((Script_typed_ir.Item_t _ _) as tl_ty))
        ⇒
        let ? function_parameter := make_proof_argument (n_value -i 1) tl_ty in
        match function_parameter with
        | Comb_proof_argument comb_witness (Script_typed_ir.Item_t b_ty tl_ty')
          ⇒
          let ? 'Script_typed_ir.Ty_ex_c pair_t :=
            Script_typed_ir.pair_t loc_value a_ty b_ty in
          return ?
            (Comb_proof_argument (Script_typed_ir.Comb_succ comb_witness)
              (Script_typed_ir.Item_t pair_t tl_ty'))
        | _ ⇒ unreachable_gadt_branch
        end
      | _ ⇒ bad_stack_error ctxt loc_value Michelson_v1_primitives.I_PAIR 1
      end in
    let ? n_value := parse_uint10 n_value in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.proof_argument n_value) in
    let ? '_ :=
      Error_monad.error_unless (n_value >i 1)
        (Build_extensible "Pair_bad_argument" Alpha_context.Script.location
          loc_value) in
    let ? 'Comb_proof_argument witness after_ty :=
      make_proof_argument n_value stack_ty in
    let comb :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IComb loc_value n_value witness k_value; |} in
    typed ctxt loc_value comb after_ty
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_UNPAIR (cons n_value [])
      annot, (Script_typed_ir.Item_t _ _) as stack_ty) ⇒
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let fix make_proof_argument
      (n_value : int) (stack_ty : Script_typed_ir.stack_ty) {struct n_value}
      : M ? uncomb_proof_argument :=
      match (n_value, stack_ty) with
      | (1, (Script_typed_ir.Item_t _ _) as stack_value) ⇒
        return ? (Uncomb_proof_argument Script_typed_ir.Uncomb_one stack_value)
      |
        (n_value,
          Script_typed_ir.Item_t (Script_typed_ir.Pair_t a_ty b_ty _ _) tl_ty)
        ⇒
        let ? 'Uncomb_proof_argument uncomb_witness after_ty :=
          make_proof_argument (n_value -i 1) (Script_typed_ir.Item_t b_ty tl_ty)
          in
        return ?
          (Uncomb_proof_argument (Script_typed_ir.Uncomb_succ uncomb_witness)
            (Script_typed_ir.Item_t a_ty after_ty))
      | _ ⇒ bad_stack_error ctxt loc_value Michelson_v1_primitives.I_UNPAIR 1
      end in
    let ? n_value := parse_uint10 n_value in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.proof_argument n_value) in
    let ? '_ :=
      Error_monad.error_unless (n_value >i 1)
        (Build_extensible "Unpair_bad_argument" Alpha_context.Script.location
          loc_value) in
    let ? 'Uncomb_proof_argument witness after_ty :=
      make_proof_argument n_value stack_ty in
    let uncomb :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IUncomb loc_value n_value witness k_value; |} in
    typed ctxt loc_value uncomb after_ty
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_GET (cons n_value [])
      annot, Script_typed_ir.Item_t comb_ty rest_ty) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? n_value := parse_uint11 n_value in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.proof_argument n_value) in
    match make_comb_get_proof_argument n_value comb_ty with
    | None ⇒
      let whole_stack :=
        Script_ir_unparser.serialize_stack_for_error ctxt stack_ty in
      Error_monad.tzfail
        (Build_extensible "Bad_stack"
          (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
            Script_tc_errors.unparsed_stack_ty)
          (loc_value, Michelson_v1_primitives.I_GET, 1, whole_stack))
    | Some (Comb_get_proof_argument witness ty') ⇒
      let after_stack_ty := Script_typed_ir.Item_t ty' rest_ty in
      let comb_get :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              Script_typed_ir.IComb_get loc_value n_value witness k_value; |} in
      typed ctxt loc_value comb_get after_stack_ty
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_UPDATE (cons n_value [])
      annot,
      Script_typed_ir.Item_t value_ty (Script_typed_ir.Item_t comb_ty rest_ty))
    ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? n_value := parse_uint11 n_value in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.proof_argument n_value) in
    let ? 'Comb_set_proof_argument witness after_ty :=
      make_comb_set_proof_argument ctxt stack_ty loc_value n_value value_ty
        comb_ty in
    let after_stack_ty := Script_typed_ir.Item_t after_ty rest_ty in
    let comb_set :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IComb_set loc_value n_value witness k_value; |} in
    typed ctxt loc_value comb_set after_stack_ty
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_UNPAIR [] annot,
      Script_typed_ir.Item_t (Script_typed_ir.Pair_t a_value b_value _ _) rest)
    ⇒
    let ? '_ := Script_ir_annot.check_unpair_annot loc_value annot in
    let unpair :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IUnpair loc_value k_value; |} in
    typed ctxt loc_value unpair
      (Script_typed_ir.Item_t a_value (Script_typed_ir.Item_t b_value rest))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CAR [] annot,
      Script_typed_ir.Item_t (Script_typed_ir.Pair_t a_value _ _ _) rest) ⇒
    let ? '_ := Script_ir_annot.check_destr_annot loc_value annot in
    let car :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICar loc_value k_value; |} in
    typed ctxt loc_value car (Script_typed_ir.Item_t a_value rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CDR [] annot,
      Script_typed_ir.Item_t (Script_typed_ir.Pair_t _ b_value _ _) rest) ⇒
    let ? '_ := Script_ir_annot.check_destr_annot loc_value annot in
    let cdr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICdr loc_value k_value; |} in
    typed ctxt loc_value cdr (Script_typed_ir.Item_t b_value rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LEFT (cons tr []) annot,
      Script_typed_ir.Item_t tl rest) ⇒
    let ? '(Script_typed_ir.Ex_ty tr , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy tr in
    let ? '_ := Script_ir_annot.check_constr_annot loc_value annot in
    let cons_left :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICons_left loc_value tr k_value; |} in
    let ? 'Script_typed_ir.Ty_ex_c ty_value :=
      Script_typed_ir.union_t loc_value tl tr in
    let stack_ty := Script_typed_ir.Item_t ty_value rest in
    typed ctxt loc_value cons_left stack_ty
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_RIGHT (cons tl []) annot,
      Script_typed_ir.Item_t tr rest) ⇒
    let ? '(Script_typed_ir.Ex_ty tl , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy tl in
    let ? '_ := Script_ir_annot.check_constr_annot loc_value annot in
    let cons_right :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICons_right loc_value tl k_value; |} in
    let ? 'Script_typed_ir.Ty_ex_c ty_value :=
      Script_typed_ir.union_t loc_value tl tr in
    let stack_ty := Script_typed_ir.Item_t ty_value rest in
    typed ctxt loc_value cons_right stack_ty
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_IF_LEFT
      (cons bt (cons bf [])) annot,
      (Script_typed_ir.Item_t (Script_typed_ir.Union_t tl tr _ _) rest) as bef)
    ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] bt in
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] bf in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(btr , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt bt
        (Script_typed_ir.Item_t tl rest) in
    let ? '(bfr , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt bf
        (Script_typed_ir.Item_t tr rest) in
    let branch (ibt : descr) (ibf : descr) : descr :=
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              let hloc := Script_typed_ir.kinstr_location k_value in
              let branch_if_left : Script_typed_ir.kinstr :=
                ibt.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hloc)
              in let branch_if_right : Script_typed_ir.kinstr :=
                ibf.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hloc) in
              Script_typed_ir.IIf_left
                {| Script_typed_ir.kinstr.IIf_left.loc := loc_value;
                  Script_typed_ir.kinstr.IIf_left.branch_if_left :=
                    branch_if_left;
                  Script_typed_ir.kinstr.IIf_left.branch_if_right :=
                    branch_if_right;
                  Script_typed_ir.kinstr.IIf_left.k := k_value; |}; |} in
      {| descr.loc := loc_value; descr.bef := bef; descr.aft := ibt.(descr.aft);
        descr.instr := instr; |} in
    merge_branches ctxt loc_value btr bfr {| branch.branch := branch; |}
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NIL (cons t_value [])
      annot, stack_value) ⇒
    let ? '(Script_typed_ir.Ex_ty t_value , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy t_value in
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let nil :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INil loc_value t_value k_value; |} in
    let ? ty_value := Script_typed_ir.list_t loc_value t_value in
    typed ctxt loc_value nil (Script_typed_ir.Item_t ty_value stack_value)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CONS [] annot,
      Script_typed_ir.Item_t tv
        ((Script_typed_ir.Item_t (Script_typed_ir.List_t t_value _) _) as
          stack_value)) ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt tv t_value loc_value Michelson_v1_primitives.I_CONS 1 2
      in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let cons_list :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICons_list loc_value k_value; |} in
    typed ctxt loc_value cons_list stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_IF_CONS
      (cons bt (cons bf [])) annot,
      (Script_typed_ir.Item_t (Script_typed_ir.List_t t_value _) rest) as bef)
    ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] bt in
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] bf in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(btr , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt bt
        (Script_typed_ir.Item_t t_value bef) in
    let ? '(bfr , ctxt ) := non_terminal_recursion tc_context_value ctxt bf rest in
    let branch (ibt : descr) (ibf : descr) : descr :=
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              let hloc := Script_typed_ir.kinstr_location k_value in
              let branch_if_cons : Script_typed_ir.kinstr :=
                ibt.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hloc)
              in let branch_if_nil : Script_typed_ir.kinstr :=
                ibf.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hloc) in
              Script_typed_ir.IIf_cons
                {| Script_typed_ir.kinstr.IIf_cons.loc := loc_value;
                  Script_typed_ir.kinstr.IIf_cons.branch_if_cons :=
                    branch_if_cons;
                  Script_typed_ir.kinstr.IIf_cons.branch_if_nil :=
                    branch_if_nil; Script_typed_ir.kinstr.IIf_cons.k := k_value;
                  |}; |} in
      {| descr.loc := loc_value; descr.bef := bef; descr.aft := ibt.(descr.aft);
        descr.instr := instr; |} in
    merge_branches ctxt loc_value btr bfr {| branch.branch := branch; |}
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SIZE [] annot,
      Script_typed_ir.Item_t (Script_typed_ir.List_t _ _) rest) ⇒
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let list_size :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IList_size loc_value k_value; |} in
    typed ctxt loc_value list_size
      (Script_typed_ir.Item_t Script_typed_ir.nat_t rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MAP (cons body []) annot,
      Script_typed_ir.Item_t (Script_typed_ir.List_t elt_value _) starting_rest)
    ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] body in
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt body
        (Script_typed_ir.Item_t elt_value starting_rest) in
    match judgement_value with
    |
      Typed
        ({| descr.aft := (Script_typed_ir.Item_t ret_value rest) as aft |} as
          kibody) ⇒
      let invalid_map_body (function_parameter : unit) : Error_monad._error :=
        let '_ := function_parameter in
        let aft := Script_ir_unparser.serialize_stack_for_error ctxt aft in
        Build_extensible "Invalid_map_body"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty)
          (loc_value, aft) in
      Error_monad.record_trace_eval invalid_map_body
        (let ? '(Eq , ctxt ) := stack_eq loc_value ctxt 1 rest starting_rest in
        let hloc := loc_value in
        let ibody :=
          kibody.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hloc) in
        let ? ty_value := Script_typed_ir.list_t loc_value ret_value in
        let list_map :=
          {|
            cinstr.apply :=
              fun (k_value : Script_typed_ir.kinstr) ⇒
                Script_typed_ir.IList_map loc_value ibody
                  (for_logging_only ty_value) k_value; |} in
        let stack_value := Script_typed_ir.Item_t ty_value rest in
        typed_no_lwt ctxt loc_value list_map stack_value)
    | Typed {| descr.aft := aft |} ⇒
      let aft := Script_ir_unparser.serialize_stack_for_error ctxt aft in
      Error_monad.error_value
        (Build_extensible "Invalid_map_body"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty)
          (loc_value, aft))
    | Failed _ ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_map_block_fail" Alpha_context.Script.location
          loc_value)
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ITER (cons body [])
      annot, Script_typed_ir.Item_t (Script_typed_ir.List_t elt_value _) rest)
    ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] body in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt body
        (Script_typed_ir.Item_t elt_value rest) in
    let mk_list_iter (ibody : descr) : cinstr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            let hinfo := loc_value in
            let ibody :=
              ibody.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hinfo)
              in
            Script_typed_ir.IList_iter loc_value (for_logging_only elt_value)
              ibody k_value; |} in
    match judgement_value with
    | Typed ({| descr.aft := aft |} as ibody) ⇒
      let invalid_iter_body (function_parameter : unit) : Error_monad._error :=
        let '_ := function_parameter in
        let aft :=
          Script_ir_unparser.serialize_stack_for_error ctxt ibody.(descr.aft) in
        let rest := Script_ir_unparser.serialize_stack_for_error ctxt rest in
        Build_extensible "Invalid_iter_body"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty ×
            Script_tc_errors.unparsed_stack_ty) (loc_value, rest, aft) in
      Error_monad.record_trace_eval invalid_iter_body
        (let ? '(Eq , ctxt ) := stack_eq loc_value ctxt 1 aft rest in
        typed_no_lwt ctxt loc_value (mk_list_iter ibody) rest)
    | Failed {| judgement.Failed.descr := descr_value |} ⇒
      typed_no_lwt ctxt loc_value (mk_list_iter (descr_value rest)) rest
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EMPTY_SET
      (cons t_value []) annot, rest) ⇒
    let ? '(Ex_comparable_ty t_value , ctxt ) :=
      parse_comparable_ty_aux ctxt (stack_depth +i 1) t_value in
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEmpty_set loc_value t_value k_value; |} in
    let ? ty_value := Script_typed_ir.set_t loc_value t_value in
    typed ctxt loc_value instr (Script_typed_ir.Item_t ty_value rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ITER (cons body [])
      annot, Script_typed_ir.Item_t (Script_typed_ir.Set_t elt_value _) rest) ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] body in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt body
        (Script_typed_ir.Item_t elt_value rest) in
    let mk_iset_iter (ibody : descr) : cinstr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            let hinfo := loc_value in
            let ibody :=
              ibody.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hinfo)
              in
            Script_typed_ir.ISet_iter loc_value (for_logging_only elt_value)
              ibody k_value; |} in
    match judgement_value with
    | Typed ({| descr.aft := aft |} as ibody) ⇒
      let invalid_iter_body (function_parameter : unit) : Error_monad._error :=
        let '_ := function_parameter in
        let aft :=
          Script_ir_unparser.serialize_stack_for_error ctxt ibody.(descr.aft) in
        let rest := Script_ir_unparser.serialize_stack_for_error ctxt rest in
        Build_extensible "Invalid_iter_body"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty ×
            Script_tc_errors.unparsed_stack_ty) (loc_value, rest, aft) in
      Error_monad.record_trace_eval invalid_iter_body
        (let ? '(Eq , ctxt ) := stack_eq loc_value ctxt 1 aft rest in
        typed_no_lwt ctxt loc_value (mk_iset_iter ibody) rest)
    | Failed {| judgement.Failed.descr := descr_value |} ⇒
      typed_no_lwt ctxt loc_value (mk_iset_iter (descr_value rest)) rest
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MEM [] annot,
      Script_typed_ir.Item_t v_value
        (Script_typed_ir.Item_t (Script_typed_ir.Set_t elt_value _) rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt elt_value v_value loc_value
        Michelson_v1_primitives.I_MEM 1 2 in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISet_mem loc_value k_value; |} in
    typed ctxt loc_value instr
      (Script_typed_ir.Item_t Script_typed_ir.bool_t rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_UPDATE [] annot,
      Script_typed_ir.Item_t v_value
        (Script_typed_ir.Item_t Script_typed_ir.Bool_t
          ((Script_typed_ir.Item_t (Script_typed_ir.Set_t elt_value _) _) as
            stack_value))) ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt elt_value v_value loc_value
        Michelson_v1_primitives.I_UPDATE 1 3 in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISet_update loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SIZE [] annot,
      Script_typed_ir.Item_t (Script_typed_ir.Set_t _ _) rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISet_size loc_value k_value; |} in
    typed ctxt loc_value instr
      (Script_typed_ir.Item_t Script_typed_ir.nat_t rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EMPTY_MAP
      (cons tk (cons tv [])) annot, stack_value) ⇒
    let ? '(Ex_comparable_ty tk , ctxt ) :=
      parse_comparable_ty_aux ctxt (stack_depth +i 1) tk in
    let ? '(Script_typed_ir.Ex_ty tv , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy tv in
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEmpty_map loc_value tk (for_logging_only tv)
              k_value; |} in
    let ? ty_value := Script_typed_ir.map_t loc_value tk tv in
    typed ctxt loc_value instr (Script_typed_ir.Item_t ty_value stack_value)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MAP (cons body []) annot,
      Script_typed_ir.Item_t (Script_typed_ir.Map_t kt elt_value _)
        starting_rest) ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] body in
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let ? 'Script_typed_ir.Ty_ex_c ty_value :=
      Script_typed_ir.pair_t loc_value kt elt_value in
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt body
        (Script_typed_ir.Item_t ty_value starting_rest) in
    match judgement_value with
    |
      Typed
        ({| descr.aft := (Script_typed_ir.Item_t ret_value rest) as aft |} as
          ibody) ⇒
      let invalid_map_body (function_parameter : unit) : Error_monad._error :=
        let '_ := function_parameter in
        let aft := Script_ir_unparser.serialize_stack_for_error ctxt aft in
        Build_extensible "Invalid_map_body"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty)
          (loc_value, aft) in
      Error_monad.record_trace_eval invalid_map_body
        (let ? '(Eq , ctxt ) := stack_eq loc_value ctxt 1 rest starting_rest in
        let ? ty_value := Script_typed_ir.map_t loc_value kt ret_value in
        let instr :=
          {|
            cinstr.apply :=
              fun (k_value : Script_typed_ir.kinstr) ⇒
                let hinfo := loc_value in
                let ibody :=
                  ibody.(descr.instr).(cinstr.apply)
                    (Script_typed_ir.IHalt hinfo) in
                Script_typed_ir.IMap_map loc_value (for_logging_only ty_value)
                  ibody k_value; |} in
        let stack_value := Script_typed_ir.Item_t ty_value rest in
        typed_no_lwt ctxt loc_value instr stack_value)
    | Typed {| descr.aft := aft |} ⇒
      let aft := Script_ir_unparser.serialize_stack_for_error ctxt aft in
      Error_monad.error_value
        (Build_extensible "Invalid_map_body"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty)
          (loc_value, aft))
    | Failed _ ⇒
      Error_monad.error_value
        (Build_extensible "Invalid_map_block_fail" Alpha_context.Script.location
          loc_value)
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ITER (cons body [])
      annot,
      Script_typed_ir.Item_t (Script_typed_ir.Map_t key_value element_ty _) rest)
    ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] body in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? 'Script_typed_ir.Ty_ex_c ty_value :=
      Script_typed_ir.pair_t loc_value key_value element_ty in
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt body
        (Script_typed_ir.Item_t ty_value rest) in
    let make_instr (ibody : descr) : cinstr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            let hinfo := loc_value in
            let ibody :=
              ibody.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hinfo)
              in
            Script_typed_ir.IMap_iter loc_value (for_logging_only ty_value)
              ibody k_value; |} in
    match judgement_value with
    | Typed ({| descr.aft := aft |} as ibody) ⇒
      let invalid_iter_body (function_parameter : unit) : Error_monad._error :=
        let '_ := function_parameter in
        let aft :=
          Script_ir_unparser.serialize_stack_for_error ctxt ibody.(descr.aft) in
        let rest := Script_ir_unparser.serialize_stack_for_error ctxt rest in
        Build_extensible "Invalid_iter_body"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty ×
            Script_tc_errors.unparsed_stack_ty) (loc_value, rest, aft) in
      Error_monad.record_trace_eval invalid_iter_body
        (let ? '(Eq , ctxt ) := stack_eq loc_value ctxt 1 aft rest in
        typed_no_lwt ctxt loc_value (make_instr ibody) rest)
    | Failed {| judgement.Failed.descr := descr_value |} ⇒
      typed_no_lwt ctxt loc_value (make_instr (descr_value rest)) rest
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MEM [] annot,
      Script_typed_ir.Item_t vk
        (Script_typed_ir.Item_t (Script_typed_ir.Map_t k_value _ _) rest)) ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt vk k_value loc_value Michelson_v1_primitives.I_MEM 1 2
      in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMap_mem loc_value k_value; |} in
    typed ctxt loc_value instr
      (Script_typed_ir.Item_t Script_typed_ir.bool_t rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_GET [] annot,
      Script_typed_ir.Item_t vk
        (Script_typed_ir.Item_t (Script_typed_ir.Map_t k_value elt_value _) rest))
    ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt vk k_value loc_value Michelson_v1_primitives.I_GET 1 2
      in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMap_get loc_value k_value; |} in
    let ? ty_value := Script_typed_ir.option_t loc_value elt_value in
    typed ctxt loc_value instr (Script_typed_ir.Item_t ty_value rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_UPDATE [] annot,
      Script_typed_ir.Item_t vk
        (Script_typed_ir.Item_t (Script_typed_ir.Option_t vv _ _)
          ((Script_typed_ir.Item_t (Script_typed_ir.Map_t k_value v_value _) _)
            as stack_value))) ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt vk k_value loc_value Michelson_v1_primitives.I_UPDATE 1
        3 in
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt vv v_value loc_value Michelson_v1_primitives.I_UPDATE 2
        3 in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMap_update loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_GET_AND_UPDATE [] annot,
      Script_typed_ir.Item_t vk
        ((Script_typed_ir.Item_t (Script_typed_ir.Option_t vv _ _)
          (Script_typed_ir.Item_t (Script_typed_ir.Map_t k_value v_value _) _))
          as stack_value)) ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt vk k_value loc_value
        Michelson_v1_primitives.I_GET_AND_UPDATE 1 3 in
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt vv v_value loc_value
        Michelson_v1_primitives.I_GET_AND_UPDATE 2 3 in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMap_get_and_update loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SIZE [] annot,
      Script_typed_ir.Item_t (Script_typed_ir.Map_t _ _ _) rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMap_size loc_value k_value; |} in
    typed ctxt loc_value instr
      (Script_typed_ir.Item_t Script_typed_ir.nat_t rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EMPTY_BIG_MAP
      (cons tk (cons tv [])) annot, stack_value) ⇒
    let ? '(Ex_comparable_ty tk , ctxt ) :=
      parse_comparable_ty_aux ctxt (stack_depth +i 1) tk in
    let ? '(Script_typed_ir.Ex_ty tv , ctxt ) :=
      parse_big_map_value_ty_aux ctxt (stack_depth +i 1) legacy tv in
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEmpty_big_map loc_value tk tv k_value; |} in
    let ? ty_value := Script_typed_ir.big_map_t loc_value tk tv in
    let stack_value := Script_typed_ir.Item_t ty_value stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MEM [] annot,
      Script_typed_ir.Item_t set_key
        (Script_typed_ir.Item_t (Script_typed_ir.Big_map_t k_value _ _) rest))
    ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt set_key k_value loc_value Michelson_v1_primitives.I_MEM
        1 2 in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IBig_map_mem loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bool_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_GET [] annot,
      Script_typed_ir.Item_t vk
        (Script_typed_ir.Item_t (Script_typed_ir.Big_map_t k_value elt_value _)
          rest)) ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt vk k_value loc_value Michelson_v1_primitives.I_GET 1 2
      in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IBig_map_get loc_value k_value; |} in
    let ? ty_value := Script_typed_ir.option_t loc_value elt_value in
    let stack_value := Script_typed_ir.Item_t ty_value rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_UPDATE [] annot,
      Script_typed_ir.Item_t set_key
        (Script_typed_ir.Item_t (Script_typed_ir.Option_t set_value _ _)
          ((Script_typed_ir.Item_t
            (Script_typed_ir.Big_map_t map_key map_value _) _) as stack_value)))
    ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt set_key map_key loc_value
        Michelson_v1_primitives.I_UPDATE 1 3 in
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt set_value map_value loc_value
        Michelson_v1_primitives.I_UPDATE 2 3 in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IBig_map_update loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_GET_AND_UPDATE [] annot,
      Script_typed_ir.Item_t vk
        ((Script_typed_ir.Item_t (Script_typed_ir.Option_t vv _ _)
          (Script_typed_ir.Item_t (Script_typed_ir.Big_map_t k_value v_value _)
            _)) as stack_value)) ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt vk k_value loc_value
        Michelson_v1_primitives.I_GET_AND_UPDATE 1 3 in
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt vv v_value loc_value
        Michelson_v1_primitives.I_GET_AND_UPDATE 2 3 in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IBig_map_get_and_update loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SAPLING_EMPTY_STATE
      (cons memo_size []) annot, rest) ⇒
    let ? memo_size := parse_memo_size memo_size in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISapling_empty_state loc_value memo_size k_value; |}
      in
    let stack_value :=
      Script_typed_ir.Item_t (Script_typed_ir.sapling_state_t memo_size) rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SAPLING_VERIFY_UPDATE []
      _,
      Script_typed_ir.Item_t
        (Script_typed_ir.Sapling_transaction_deprecated_t transaction_memo_size)
        (Script_typed_ir.Item_t
          ((Script_typed_ir.Sapling_state_t state_memo_size) as state_ty) rest))
    ⇒
    if legacy then
      let ? '_ :=
        memo_size_eq (Script_tc_errors.Informative tt) state_memo_size
          transaction_memo_size in
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              Script_typed_ir.ISapling_verify_update_deprecated loc_value
                k_value; |} in
      let ? 'Script_typed_ir.Ty_ex_c pair_ty :=
        Script_typed_ir.pair_t loc_value Script_typed_ir.int_t state_ty in
      let ? ty_value := Script_typed_ir.option_t loc_value pair_ty in
      let stack_value := Script_typed_ir.Item_t ty_value rest in
      typed ctxt loc_value instr stack_value
    else
      Error_monad.tzfail
        (Build_extensible "Deprecated_instruction" Alpha_context.Script.prim
          Michelson_v1_primitives.T_sapling_transaction_deprecated)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SAPLING_VERIFY_UPDATE []
      _,
      Script_typed_ir.Item_t
        (Script_typed_ir.Sapling_transaction_t transaction_memo_size)
        (Script_typed_ir.Item_t
          ((Script_typed_ir.Sapling_state_t state_memo_size) as state_ty) rest))
    ⇒
    let ? '_ :=
      memo_size_eq (Script_tc_errors.Informative tt) state_memo_size
        transaction_memo_size in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISapling_verify_update loc_value k_value; |} in
    let ? 'Script_typed_ir.Ty_ex_c pair_ty :=
      Script_typed_ir.pair_t loc_value Script_typed_ir.int_t state_ty in
    let ? 'Script_typed_ir.Ty_ex_c pair_ty :=
      Script_typed_ir.pair_t loc_value Script_typed_ir.bytes_t pair_ty in
    let ? ty_value := Script_typed_ir.option_t loc_value pair_ty in
    let stack_value := Script_typed_ir.Item_t ty_value rest in
    typed ctxt loc_value instr stack_value
  | (Micheline.Seq loc_value [], stack_value) ⇒
    let instr :=
      {| cinstr.apply := fun (k_value : Script_typed_ir.kinstr) ⇒ k_value; |}
      in
    typed ctxt loc_value instr stack_value
  | (Micheline.Seq _ (cons single []), stack_value) ⇒
    non_terminal_recursion tc_context_value ctxt single stack_value
  | (Micheline.Seq loc_value (cons hd tl), stack_value) ⇒
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt hd stack_value in
    match judgement_value with
    | Failed _ ⇒
      Error_monad.tzfail
        (Build_extensible "Fail_not_in_tail_position"
          Alpha_context.Script.location (Micheline.location hd))
    | Typed ({| descr.aft := middle |} as ihd) ⇒
      let ? '(judgement_value , ctxt ) :=
        non_terminal_recursion tc_context_value ctxt
          (Micheline.Seq Micheline.dummy_location tl) middle in
      let judgement_value :=
        match judgement_value with
        | Failed {| judgement.Failed.descr := descr_value |} ⇒
          let descr_value (ret_value : Script_typed_ir.stack_ty) : descr :=
            compose_descr loc_value ihd (descr_value ret_value) in
          Failed {| judgement.Failed.descr := descr_value; |}
        | Typed itl ⇒ Typed (compose_descr loc_value ihd itl)
        end in
      return ? (judgement_value, ctxt)
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_IF
      (cons bt (cons bf [])) annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bool_t rest) as bef) ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] bt in
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] bf in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(btr , ctxt ) := non_terminal_recursion tc_context_value ctxt bt rest in
    let ? '(bfr , ctxt ) := non_terminal_recursion tc_context_value ctxt bf rest in
    let branch (ibt : descr) (ibf : descr) : descr :=
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              let hloc := Script_typed_ir.kinstr_location k_value in
              let branch_if_true : Script_typed_ir.kinstr :=
                ibt.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hloc)
              in let branch_if_false : Script_typed_ir.kinstr :=
                ibf.(descr.instr).(cinstr.apply) (Script_typed_ir.IHalt hloc) in
              Script_typed_ir.IIf
                {| Script_typed_ir.kinstr.IIf.loc := loc_value;
                  Script_typed_ir.kinstr.IIf.branch_if_true := branch_if_true;
                  Script_typed_ir.kinstr.IIf.branch_if_false := branch_if_false;
                  Script_typed_ir.kinstr.IIf.k := k_value; |}; |} in
      {| descr.loc := loc_value; descr.bef := bef; descr.aft := ibt.(descr.aft);
        descr.instr := instr; |} in
    merge_branches ctxt loc_value btr bfr {| branch.branch := branch; |}
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LOOP (cons body [])
      annot, (Script_typed_ir.Item_t Script_typed_ir.Bool_t rest) as stack_value)
    ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] body in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt body rest in
    match judgement_value with
    | Typed ibody ⇒
      let unmatched_branches (function_parameter : unit) : Error_monad._error :=
        let '_ := function_parameter in
        let aft :=
          Script_ir_unparser.serialize_stack_for_error ctxt ibody.(descr.aft) in
        let stack_value :=
          Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
        Build_extensible "Unmatched_branches"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty ×
            Script_tc_errors.unparsed_stack_ty) (loc_value, aft, stack_value) in
      Error_monad.record_trace_eval unmatched_branches
        (let ? '(Eq , ctxt ) :=
          stack_eq loc_value ctxt 1 ibody.(descr.aft) stack_value in
        let instr :=
          {|
            cinstr.apply :=
              fun (k_value : Script_typed_ir.kinstr) ⇒
                let loc_value := Script_typed_ir.kinstr_location k_value in
                let ibody :=
                  ibody.(descr.instr).(cinstr.apply)
                    (Script_typed_ir.IHalt loc_value) in
                Script_typed_ir.ILoop loc_value ibody k_value; |} in
        typed_no_lwt ctxt loc_value instr rest)
    | Failed {| judgement.Failed.descr := descr_value |} ⇒
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              let loc_value := Script_typed_ir.kinstr_location k_value in
              let ibody := descr_value stack_value in
              let ibody :=
                ibody.(descr.instr).(cinstr.apply)
                  (Script_typed_ir.IHalt loc_value) in
              Script_typed_ir.ILoop loc_value ibody k_value; |} in
      typed_no_lwt ctxt loc_value instr rest
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LOOP_LEFT (cons body [])
      annot,
      (Script_typed_ir.Item_t (Script_typed_ir.Union_t tl tr _ _) rest) as
        stack_value) ⇒
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] body in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt body
        (Script_typed_ir.Item_t tl rest) in
    match judgement_value with
    | Typed ibody ⇒
      let unmatched_branches (function_parameter : unit) : Error_monad._error :=
        let '_ := function_parameter in
        let aft :=
          Script_ir_unparser.serialize_stack_for_error ctxt ibody.(descr.aft) in
        let stack_value :=
          Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
        Build_extensible "Unmatched_branches"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty ×
            Script_tc_errors.unparsed_stack_ty) (loc_value, aft, stack_value) in
      Error_monad.record_trace_eval unmatched_branches
        (let ? '(Eq , ctxt ) :=
          stack_eq loc_value ctxt 1 ibody.(descr.aft) stack_value in
        let instr :=
          {|
            cinstr.apply :=
              fun (k_value : Script_typed_ir.kinstr) ⇒
                let loc_value := Script_typed_ir.kinstr_location k_value in
                let ibody :=
                  ibody.(descr.instr).(cinstr.apply)
                    (Script_typed_ir.IHalt loc_value) in
                Script_typed_ir.ILoop_left loc_value ibody k_value; |} in
        let stack_value := Script_typed_ir.Item_t tr rest in
        typed_no_lwt ctxt loc_value instr stack_value)
    | Failed {| judgement.Failed.descr := descr_value |} ⇒
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              let loc_value := Script_typed_ir.kinstr_location k_value in
              let ibody := descr_value stack_value in
              let ibody :=
                ibody.(descr.instr).(cinstr.apply)
                  (Script_typed_ir.IHalt loc_value) in
              Script_typed_ir.ILoop_left loc_value ibody k_value; |} in
      let stack_value := Script_typed_ir.Item_t tr rest in
      typed_no_lwt ctxt loc_value instr stack_value
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LAMBDA
      (cons arg (cons ret_value (cons code []))) annot, stack_value) ⇒
    let ? '(Script_typed_ir.Ex_ty arg , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy arg in
    let ? '(Script_typed_ir.Ex_ty ret_value , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy ret_value in
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] code in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? '(kdescr , ctxt ) :=
      parse_kdescr elab_conf (stack_depth +i 1)
        (Tc_context.add_lambda tc_context_value) ctxt arg ret_value code in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ILambda loc_value (Script_typed_ir.Lam kdescr code)
              k_value; |} in
    let ? ty_value := Script_typed_ir.lambda_t loc_value arg ret_value in
    let stack_value := Script_typed_ir.Item_t ty_value stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LAMBDA_REC
      (cons arg_ty_expr (cons ret_ty_expr (cons lambda_expr []))) annot,
      stack_value) ⇒
    let ? '(Script_typed_ir.Ex_ty arg , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy arg_ty_expr in
    let ? '(Script_typed_ir.Ex_ty ret_value , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy ret_ty_expr in
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] lambda_expr in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? lambda_rec_ty := Script_typed_ir.lambda_t loc_value arg ret_value in
    let ? '(code , ctxt ) :=
      parse_lam_rec elab_conf (stack_depth +i 1)
        (Tc_context.add_lambda tc_context_value) ctxt arg ret_value
        lambda_rec_ty lambda_expr in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ILambda loc_value code k_value; |} in
    let stack_value := Script_typed_ir.Item_t lambda_rec_ty stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EXEC [] annot,
      Script_typed_ir.Item_t arg
        (Script_typed_ir.Item_t (Script_typed_ir.Lambda_t param ret_value _)
          rest)) ⇒
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt arg param loc_value Michelson_v1_primitives.I_EXEC 1 2
      in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let stack_value := Script_typed_ir.Item_t ret_value rest in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IExec loc_value (for_logging_only stack_value)
              k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_APPLY [] annot,
      Script_typed_ir.Item_t capture
        (Script_typed_ir.Item_t
          (Script_typed_ir.Lambda_t
            (Script_typed_ir.Pair_t capture_ty arg_ty _ _) ret_value _) rest))
    ⇒
    let ? '_ := check_packable false loc_value capture_ty in
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt capture capture_ty loc_value
        Michelson_v1_primitives.I_APPLY 1 2 in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IApply loc_value capture_ty k_value; |} in
    let ? res_ty := Script_typed_ir.lambda_t loc_value arg_ty ret_value in
    let stack_value := Script_typed_ir.Item_t res_ty rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DIP (cons code []) annot,
      Script_typed_ir.Item_t v_value rest) ⇒
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '_ := check_kind [ Script_tc_errors.Seq_kind ] code in
    let ? '(judgement_value , ctxt ) :=
      non_terminal_recursion tc_context_value ctxt code rest in
    match judgement_value with
    | Typed descr_value ⇒
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              let b_value :=
                descr_value.(descr.instr).(cinstr.apply)
                  (Script_typed_ir.IHalt descr_value.(descr.loc)) in
              Script_typed_ir.IDip loc_value b_value (for_logging_only v_value)
                k_value; |} in
      let stack_value := Script_typed_ir.Item_t v_value descr_value.(descr.aft)
        in
      typed ctxt loc_value instr stack_value
    | Failed _ ⇒
      Error_monad.tzfail
        (Build_extensible "Fail_not_in_tail_position"
          Alpha_context.Script.location loc_value)
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DIP
      (cons n_value (cons code [])) result_annot, stack_value) ⇒
    let ? n_value := parse_uint10 n_value in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt (Typecheck_costs.proof_argument n_value) in
    let fix make_proof_argument (n_value : int) (stk : Script_typed_ir.stack_ty)
      : M ? dipn_proof_argument :=
      match ((n_value =i 0), stk) with
      | (true, rest) ⇒
        let ? '(judgement_value , ctxt ) :=
          non_terminal_recursion tc_context_value ctxt code rest in
        match judgement_value with
        | Typed descr_value ⇒
          return ?
            (Dipn_proof_argument Script_typed_ir.KRest ctxt descr_value
              descr_value.(descr.aft))
        | Failed _ ⇒
          Error_monad.error_value
            (Build_extensible "Fail_not_in_tail_position"
              Alpha_context.Script.location loc_value)
        end
      | (false, Script_typed_ir.Item_t v_value rest) ⇒
        let ? 'Dipn_proof_argument n' ctxt descr_value aft' :=
          make_proof_argument (n_value -i 1) rest in
        let w_value := Script_typed_ir.KPrefix loc_value v_value n' in
        return ?
          (Dipn_proof_argument w_value ctxt descr_value
            (Script_typed_ir.Item_t v_value aft'))
      | (_, _) ⇒
        let whole_stack :=
          Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
        Error_monad.error_value
          (Build_extensible "Bad_stack"
            (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
              Script_tc_errors.unparsed_stack_ty)
            (loc_value, Michelson_v1_primitives.I_DIP, 1, whole_stack))
      end in
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value result_annot in
    let ? 'Dipn_proof_argument n' ctxt descr_value aft :=
      make_proof_argument n_value stack_value in
    let b_value :=
      descr_value.(descr.instr).(cinstr.apply)
        (Script_typed_ir.IHalt descr_value.(descr.loc)) in
    let res :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IDipn loc_value n_value n' b_value k_value; |} in
    typed ctxt loc_value res aft
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_DIP
      (([] | cons _ (cons _ (cons _ _))) as l_value) _, _) ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.I_DIP, 2, (List.length l_value)))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_FAILWITH [] annot,
      Script_typed_ir.Item_t v_value _rest) ⇒
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let ? '_ :=
      if legacy then
        Result.return_unit
      else
        check_packable false loc_value v_value in
    let instr :=
      {|
        cinstr.apply :=
          fun (_k : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IFailwith loc_value v_value; |} in
    return ?
      (let descr_value (aft : Script_typed_ir.stack_ty) : descr :=
        {| descr.loc := loc_value; descr.bef := stack_ty; descr.aft := aft;
          descr.instr := instr; |} in
      let '_ := log_stack loc_value stack_ty Script_typed_ir.Bot_t in
      ((Failed {| judgement.Failed.descr := descr_value; |}), ctxt))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NEVER [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Never_t _rest) ⇒
    let ? '_ := Script_ir_annot.error_unexpected_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (_k : Script_typed_ir.kinstr) ⇒ Script_typed_ir.INever loc_value;
        |} in
    return ?
      (let descr_value (aft : Script_typed_ir.stack_ty) : descr :=
        {| descr.loc := loc_value; descr.bef := stack_ty; descr.aft := aft;
          descr.instr := instr; |} in
      let '_ := log_stack loc_value stack_ty Script_typed_ir.Bot_t in
      ((Failed {| judgement.Failed.descr := descr_value; |}), ctxt))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Timestamp_t
        (Script_typed_ir.Item_t Script_typed_ir.Int_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_timestamp_to_seconds loc_value k_value; |} in
    typed ctxt loc_value instr
      (Script_typed_ir.Item_t Script_typed_ir.Timestamp_t rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        ((Script_typed_ir.Item_t Script_typed_ir.Timestamp_t _) as stack_value))
    ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_seconds_to_timestamp loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SUB [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Timestamp_t
        (Script_typed_ir.Item_t Script_typed_ir.Int_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISub_timestamp_seconds loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.Timestamp_t rest
      in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SUB [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Timestamp_t
        (Script_typed_ir.Item_t Script_typed_ir.Timestamp_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IDiff_timestamps loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CONCAT [] annot,
      Script_typed_ir.Item_t Script_typed_ir.String_t
        ((Script_typed_ir.Item_t Script_typed_ir.String_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IConcat_string_pair loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CONCAT [] annot,
      Script_typed_ir.Item_t (Script_typed_ir.List_t Script_typed_ir.String_t _)
        rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IConcat_string loc_value k_value; |} in
    typed ctxt loc_value instr
      (Script_typed_ir.Item_t Script_typed_ir.String_t rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SLICE [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t
          (Script_typed_ir.Item_t Script_typed_ir.String_t rest))) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISlice_string loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.option_string_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SIZE [] annot,
      Script_typed_ir.Item_t Script_typed_ir.String_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IString_size loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.nat_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CONCAT [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bytes_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IConcat_bytes_pair loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CONCAT [] annot,
      Script_typed_ir.Item_t (Script_typed_ir.List_t Script_typed_ir.Bytes_t _)
        rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IConcat_bytes loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.Bytes_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SLICE [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t
          (Script_typed_ir.Item_t Script_typed_ir.Bytes_t rest))) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISlice_bytes loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.option_bytes_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SIZE [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bytes_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IBytes_size loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.nat_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Mutez_t
        ((Script_typed_ir.Item_t Script_typed_ir.Mutez_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_tez loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SUB [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Mutez_t
        ((Script_typed_ir.Item_t Script_typed_ir.Mutez_t _) as stack_value)) ⇒
    if legacy then
      let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              Script_typed_ir.ISub_tez_legacy loc_value k_value; |} in
      typed ctxt loc_value instr stack_value
    else
      Error_monad.tzfail
        (Build_extensible "Deprecated_instruction" Alpha_context.Script.prim
          Michelson_v1_primitives.I_SUB)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SUB_MUTEZ [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Mutez_t
        (Script_typed_ir.Item_t Script_typed_ir.Mutez_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISub_tez loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.option_mutez_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Mutez_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_teznat loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.Mutez_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Mutez_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_nattez loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_OR [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bool_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bool_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IOr loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_AND [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bool_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bool_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAnd loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_XOR [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bool_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bool_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IXor loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NOT [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bool_t _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INot loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ABS [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAbs_int loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.nat_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ISNAT [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IIs_nat loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.option_nat_t rest
      in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_INT [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IInt_nat loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NEG [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Int_t _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INeg loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NEG [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INeg loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        ((Script_typed_ir.Item_t Script_typed_ir.Int_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_int loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_int loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.Int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Int_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_int loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Nat_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_nat loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SUB [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        ((Script_typed_ir.Item_t Script_typed_ir.Int_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISub_int loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SUB [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISub_int loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.Int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SUB [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Int_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISub_int loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SUB [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISub_int loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        ((Script_typed_ir.Item_t Script_typed_ir.Int_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_int loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_int loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.Int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Int_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_nat loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Nat_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_nat loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EDIV [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Mutez_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEdiv_teznat loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.option_pair_mutez_mutez_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EDIV [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Mutez_t
        (Script_typed_ir.Item_t Script_typed_ir.Mutez_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEdiv_tez loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.option_pair_nat_mutez_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EDIV [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        (Script_typed_ir.Item_t Script_typed_ir.Int_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEdiv_int loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.option_pair_int_nat_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EDIV [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEdiv_int loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.option_pair_int_nat_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EDIV [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        (Script_typed_ir.Item_t Script_typed_ir.Int_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEdiv_nat loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.option_pair_int_nat_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EDIV [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEdiv_nat loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.option_pair_nat_nat_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LSL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Nat_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ILsl_nat loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LSL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bytes_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ILsl_bytes loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.Bytes_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LSR [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Nat_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ILsr_nat loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LSR [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bytes_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ILsr_bytes loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.Bytes_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_OR [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Nat_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IOr_nat loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_OR [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bytes_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IOr_bytes loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_AND [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Nat_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAnd_nat loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_AND [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        ((Script_typed_ir.Item_t Script_typed_ir.Nat_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAnd_int_nat loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_AND [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bytes_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAnd_bytes loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_XOR [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Nat_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IXor_nat loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_XOR [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bytes_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IXor_bytes loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NOT [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Int_t _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INot_int loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NOT [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INot_int loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NOT [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INot_bytes loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_COMPARE [] annot,
      Script_typed_ir.Item_t t1 (Script_typed_ir.Item_t t2 rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt t1 t2 loc_value Michelson_v1_primitives.I_COMPARE 1 2
      in
    let ? 'Eq := check_comparable loc_value t1 in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICompare loc_value t1 k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EQ [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEq loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bool_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NEQ [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INeq loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bool_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LT [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ILt loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bool_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_GT [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IGt loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bool_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LE [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ILe loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bool_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_GE [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IGe loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bool_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CAST (cons cast_t [])
      annot, (Script_typed_ir.Item_t t_value _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? '(Script_typed_ir.Ex_ty cast_t , ctxt ) :=
      parse_any_ty_aux ctxt (stack_depth +i 1) legacy cast_t in
    let ? '(eq_value , ctxt ) :=
      Gas_monad.run ctxt
        (ty_eq (Script_tc_errors.Informative loc_value) cast_t t_value) in
    let ? 'Eq := eq_value in
    let instr :=
      {| cinstr.apply := fun (k_value : Script_typed_ir.kinstr) ⇒ k_value; |}
      in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_RENAME [] annot,
      (Script_typed_ir.Item_t _ _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {| cinstr.apply := fun (k_value : Script_typed_ir.kinstr) ⇒ k_value; |}
      in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_PACK [] annot,
      Script_typed_ir.Item_t t_value rest) ⇒
    let ? '_ := check_packable true loc_value t_value in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IPack loc_value t_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bytes_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_UNPACK
      (cons ty_value []) annot,
      Script_typed_ir.Item_t Script_typed_ir.Bytes_t rest) ⇒
    let ? '(Script_typed_ir.Ex_ty t_value , ctxt ) :=
      parse_packable_ty_aux ctxt (stack_depth +i 1) legacy ty_value in
    let ? '_ := Script_ir_annot.check_var_type_annot loc_value annot in
    let ? res_ty := Script_typed_ir.option_t loc_value t_value in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IUnpack loc_value t_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t res_ty rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADDRESS [] annot,
      Script_typed_ir.Item_t (Script_typed_ir.Contract_t _ _) rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAddress loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.address_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CONTRACT
      (cons ty_value []) annot,
      Script_typed_ir.Item_t Script_typed_ir.Address_t rest) ⇒
    let ? '(Script_typed_ir.Ex_ty t_value , ctxt ) :=
      parse_passable_ty_aux ctxt (stack_depth +i 1) legacy ty_value in
    let ? contract_ty := Script_typed_ir.contract_t loc_value t_value in
    let ? res_ty := Script_typed_ir.option_t loc_value contract_ty in
    let ? entrypoint :=
      Script_ir_annot.parse_entrypoint_annot_strict loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IContract loc_value t_value entrypoint k_value; |}
      in
    let stack_value := Script_typed_ir.Item_t res_ty rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_VIEW
      (cons name (cons output_ty [])) annot,
      Script_typed_ir.Item_t input_ty
        (Script_typed_ir.Item_t Script_typed_ir.Address_t rest)) ⇒
    let output_ty_loc := location output_ty in
    let ? '(name , ctxt ) := parse_view_name ctxt name in
    let ? '(Script_typed_ir.Ex_ty output_ty , ctxt ) :=
      parse_view_output_ty ctxt 0 legacy output_ty in
    let ? res_ty := Script_typed_ir.option_t output_ty_loc output_ty in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IView loc_value
              (Script_typed_ir.View_signature
                {| Script_typed_ir.view_signature.View_signature.name := name;
                  Script_typed_ir.view_signature.View_signature.input_ty :=
                    input_ty;
                  Script_typed_ir.view_signature.View_signature.output_ty :=
                    output_ty; |}) (for_logging_only rest) k_value; |} in
    let stack_value := Script_typed_ir.Item_t res_ty rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value
      (Michelson_v1_primitives.I_TRANSFER_TOKENS as prim) [] annot,
      Script_typed_ir.Item_t p_value
        (Script_typed_ir.Item_t Script_typed_ir.Mutez_t
          (Script_typed_ir.Item_t (Script_typed_ir.Contract_t cp _) rest))) ⇒
    let ? '_ :=
      Tc_context.check_not_in_view loc_value legacy tc_context_value prim in
    let ? '(Eq , ctxt ) := check_item_ty ctxt p_value cp loc_value prim 1 4 in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ITransfer_tokens loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.operation_t rest
      in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value (Michelson_v1_primitives.I_SET_DELEGATE as prim)
      [] annot,
      Script_typed_ir.Item_t
        (Script_typed_ir.Option_t Script_typed_ir.Key_hash_t _ _) rest) ⇒
    let ? '_ :=
      Tc_context.check_not_in_view loc_value legacy tc_context_value prim in
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISet_delegate loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.operation_t rest
      in
    typed ctxt loc_value instr stack_value
  | (Micheline.Prim _ Michelson_v1_primitives.I_CREATE_ACCOUNT _ _, _) ⇒
    Error_monad.tzfail
      (Build_extensible "Deprecated_instruction" Alpha_context.Script.prim
        Michelson_v1_primitives.I_CREATE_ACCOUNT)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_IMPLICIT_ACCOUNT []
      annot, Script_typed_ir.Item_t Script_typed_ir.Key_hash_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IImplicit_account loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.contract_unit_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value
      (Michelson_v1_primitives.I_CREATE_CONTRACT as prim)
      (cons ((Micheline.Seq _ _) as code) []) annot,
      Script_typed_ir.Item_t
        (Script_typed_ir.Option_t Script_typed_ir.Key_hash_t _ _)
        (Script_typed_ir.Item_t Script_typed_ir.Mutez_t
          (Script_typed_ir.Item_t ginit rest))) ⇒
    let ? '_ :=
      Tc_context.check_not_in_view loc_value legacy tc_context_value prim in
    let ? '_ := Script_ir_annot.check_two_var_annot loc_value annot in
    let canonical_code := Micheline.strip_locations code in
    let ?
      '({|
        toplevel.code_field := code_field ;
          toplevel.arg_type := arg_type ;
          toplevel.storage_type := storage_type ;
          toplevel.views := views
          |}, ctxt ) := parse_toplevel_aux ctxt legacy canonical_code in
    let ?
      '(Ex_parameter_ty_and_entrypoints {|
        ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.arg_type :=
          arg_type ;
          ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.entrypoints
            := entrypoints
          |}, ctxt ) :=
      Error_monad.record_trace
        (Build_extensible "Ill_formed_type"
          (option string × Micheline.canonical Alpha_context.Script.prim ×
            Alpha_context.Script.location)
          ((Some "parameter"), canonical_code, (location arg_type)))
        (parse_parameter_ty_and_entrypoints_aux ctxt (stack_depth +i 1) legacy
          arg_type) in
    let ? '(Script_typed_ir.Ex_ty storage_type , ctxt ) :=
      Error_monad.record_trace
        (Build_extensible "Ill_formed_type"
          (option string × Micheline.canonical Alpha_context.Script.prim ×
            Alpha_context.Script.location)
          ((Some "storage"), canonical_code, (location storage_type)))
        (parse_storage_ty ctxt (stack_depth +i 1) legacy storage_type) in
    let ? 'Script_typed_ir.Ty_ex_c arg_type_full :=
      Script_typed_ir.pair_t loc_value arg_type storage_type in
    let ? 'Script_typed_ir.Ty_ex_c ret_type_full :=
      Script_typed_ir.pair_t loc_value Script_typed_ir.list_operation_t
        storage_type in
    let ? function_parameter :=
      Error_monad.trace_value
        (Build_extensible "Ill_typed_contract"
          (Micheline.canonical Alpha_context.Script.prim ×
            Script_tc_errors.type_map) (canonical_code, nil))
        (parse_kdescr elab_conf (stack_depth +i 1)
          (Tc_context.toplevel_value storage_type arg_type entrypoints) ctxt
          arg_type_full ret_type_full code_field) in
    match function_parameter with
    |
      ({|
        Script_typed_ir.kdescr.kbef :=
          Script_typed_ir.Item_t arg Script_typed_ir.Bot_t;
          Script_typed_ir.kdescr.kaft :=
            Script_typed_ir.Item_t ret_value Script_typed_ir.Bot_t
          |}, ctxt) ⇒
      let views_result := parse_views elab_conf ctxt storage_type views in
      let ? '(_typed_views , ctxt ) :=
        Error_monad.trace_value
          (Build_extensible "Ill_typed_contract"
            (Micheline.canonical Alpha_context.Script.prim ×
              Script_tc_errors.type_map) (canonical_code, nil)) views_result in
      let ? '(storage_eq , ctxt ) :=
        let error_details := Script_tc_errors.Informative loc_value in
        Gas_monad.run ctxt
          (Gas_monad.Syntax.op_letstar (ty_eq error_details arg arg_type_full)
            (fun function_parameter ⇒
              let 'Eq := function_parameter in
              Gas_monad.Syntax.op_letstar
                (ty_eq error_details ret_value ret_type_full)
                (fun function_parameter ⇒
                  let 'Eq := function_parameter in
                  ty_eq error_details storage_type ginit))) in
      let ? 'Eq := storage_eq in
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              Script_typed_ir.ICreate_contract
                {| Script_typed_ir.kinstr.ICreate_contract.loc := loc_value;
                  Script_typed_ir.kinstr.ICreate_contract.storage_type :=
                    storage_type;
                  Script_typed_ir.kinstr.ICreate_contract.code :=
                    canonical_code;
                  Script_typed_ir.kinstr.ICreate_contract.k := k_value; |}; |}
        in
      let stack_value :=
        Script_typed_ir.Item_t Script_typed_ir.operation_t
          (Script_typed_ir.Item_t Script_typed_ir.address_t rest) in
      typed ctxt loc_value instr stack_value
    | _ ⇒ unreachable_gadt_branch
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NOW [] annot,
      stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INow loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.timestamp_t stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MIN_BLOCK_TIME [] _,
      stack_value) ⇒
    typed ctxt loc_value
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMin_block_time loc_value k_value; |}
      (Script_typed_ir.Item_t Script_typed_ir.nat_t stack_value)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_AMOUNT [] annot,
      stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAmount loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.mutez_t stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CHAIN_ID [] annot,
      stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IChainId loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.chain_id_t stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_BALANCE [] annot,
      stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IBalance loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.mutez_t stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LEVEL [] annot,
      stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ILevel loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.nat_t stack_value
      in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_VOTING_POWER [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Key_hash_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IVoting_power loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.nat_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_TOTAL_VOTING_POWER []
      annot, stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ITotal_voting_power loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.nat_t stack_value
      in
    typed ctxt loc_value instr stack_value
  | (Micheline.Prim _ Michelson_v1_primitives.I_STEPS_TO_QUOTA _ _, _) ⇒
    Error_monad.tzfail
      (Build_extensible "Deprecated_instruction" Alpha_context.Script.prim
        Michelson_v1_primitives.I_STEPS_TO_QUOTA)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SOURCE [] annot,
      stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISource loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.address_t stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SENDER [] annot,
      stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISender loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.address_t stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value (Michelson_v1_primitives.I_SELF as prim) [] annot,
      stack_value) ⇒
    let ? entrypoint :=
      Script_ir_annot.parse_entrypoint_annot_lax loc_value annot in
    match
      (tc_context_value.(Script_tc_context.t.callsite),
        (let '_ := tc_context_value.(Script_tc_context.t.callsite) in
        Tc_context.is_in_lambda tc_context_value)) with
    | (_, true) ⇒
      Error_monad.error_value
        (Build_extensible "Forbidden_instr_in_context"
          (Alpha_context.Script.location × Script_tc_errors.context_desc ×
            Alpha_context.Script.prim)
          (loc_value, Script_tc_errors.Lambda, prim))
    | (Script_tc_context.Data, _) ⇒
      Error_monad.error_value
        (Build_extensible "Forbidden_instr_in_context"
          (Alpha_context.Script.location × Script_tc_errors.context_desc ×
            Alpha_context.Script.prim)
          (loc_value, Script_tc_errors.Lambda, prim))
    | (Script_tc_context.View, _) ⇒
      Error_monad.error_value
        (Build_extensible "Forbidden_instr_in_context"
          (Alpha_context.Script.location × Script_tc_errors.context_desc ×
            Alpha_context.Script.prim) (loc_value, Script_tc_errors.View, prim))
    |
      (Script_tc_context.Toplevel {|
        Tc_context.callsite.Toplevel.storage_type := _;
          Tc_context.callsite.Toplevel.param_type := param_type;
          Tc_context.callsite.Toplevel.entrypoints := entrypoints
          |}, _) ⇒
      let 'existT _ __Toplevel_'param [entrypoints, param_type] :=
        cast_exists (Es := Set)
          (fun __Toplevel_'param ⇒
            [Script_typed_ir.entrypoints ** Script_typed_ir.ty])
          [entrypoints, param_type] in
      let ? '(r_value , ctxt ) :=
        Gas_monad.run ctxt
          ((find_entrypoint (Script_tc_errors.Informative tt) param_type
            entrypoints entrypoint) :
            Gas_monad.t (ex_ty_cstr __Toplevel_'param)
              (Error_monad.trace Error_monad._error)) in
      let ? 'Ex_ty_cstr {| ex_ty_cstr.Ex_ty_cstr.ty := param_type |} := r_value
        in
      let ? res_ty := Script_typed_ir.contract_t loc_value param_type in
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              Script_typed_ir.ISelf loc_value param_type entrypoint k_value; |}
        in
      let stack_value := Script_typed_ir.Item_t res_ty stack_value in
      typed_no_lwt ctxt loc_value instr stack_value
    end
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SELF_ADDRESS [] annot,
      stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISelf_address loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.address_t stack_value in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_HASH_KEY [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Key_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IHash_key loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.key_hash_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CHECK_SIGNATURE [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Key_t
        (Script_typed_ir.Item_t Script_typed_ir.Signature_t
          (Script_typed_ir.Item_t Script_typed_ir.Bytes_t rest))) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ICheck_signature loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bool_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_BLAKE2B [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IBlake2b loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SHA256 [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISha256 loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SHA512 [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISha512 loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_KECCAK [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IKeccak loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SHA3 [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bytes_t _) as stack_value) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISha3 loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g1_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g1_t _) as
          stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_bls12_381_g1 loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g2_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g2_t _) as
          stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_bls12_381_g2 loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_ADD [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t _) as
          stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IAdd_bls12_381_fr loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g1_t
        (Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_bls12_381_g1 loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g1_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g2_t
        (Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_bls12_381_g2 loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g2_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t _) as
          stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_bls12_381_fr loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Nat_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t _) as
          stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_bls12_381_fr_z loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Int_t
        ((Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t _) as
          stack_value)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_bls12_381_fr_z loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t
        (Script_typed_ir.Item_t Script_typed_ir.Int_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_bls12_381_z_fr loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_MUL [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IMul_bls12_381_z_fr loc_value k_value; |} in
    let stack_value :=
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_INT [] annot,
      Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IInt_bls12_381_fr loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.int_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NEG [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g1_t _) as stack_value)
    ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INeg_bls12_381_g1 loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NEG [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bls12_381_g2_t _) as stack_value)
    ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INeg_bls12_381_g2 loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_NEG [] annot,
      (Script_typed_ir.Item_t Script_typed_ir.Bls12_381_fr_t _) as stack_value)
    ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.INeg_bls12_381_fr loc_value k_value; |} in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_PAIRING_CHECK [] annot,
      Script_typed_ir.Item_t
        (Script_typed_ir.List_t
          (Script_typed_ir.Pair_t Script_typed_ir.Bls12_381_g1_t
            Script_typed_ir.Bls12_381_g2_t _ _) _) rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IPairing_check_bls12_381 loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t Script_typed_ir.bool_t rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_TICKET [] annot,
      Script_typed_ir.Item_t t_value
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? 'Eq := check_comparable loc_value t_value in
    let ? res_ty := Script_typed_ir.ticket_t loc_value t_value in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ITicket loc_value (for_logging_only t_value) k_value;
        |} in
    let ? res_ty := Script_typed_ir.option_t loc_value res_ty in
    let stack_value := Script_typed_ir.Item_t res_ty rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_TICKET_DEPRECATED []
      annot,
      Script_typed_ir.Item_t t_value
        (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest)) ⇒
    if legacy then
      let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
      let ? 'Eq := check_comparable loc_value t_value in
      let ? res_ty := Script_typed_ir.ticket_t loc_value t_value in
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              Script_typed_ir.ITicket_deprecated loc_value
                (for_logging_only t_value) k_value; |} in
      let stack_value := Script_typed_ir.Item_t res_ty rest in
      typed ctxt loc_value instr stack_value
    else
      Error_monad.tzfail
        (Build_extensible "Deprecated_instruction" Alpha_context.Script.prim
          Michelson_v1_primitives.I_TICKET_DEPRECATED)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_READ_TICKET [] annot,
      (Script_typed_ir.Item_t (Script_typed_ir.Ticket_t t_value _) _) as
        full_stack) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let '_ := check_dupable_comparable_ty t_value in
    let ? result_value := opened_ticket_type loc_value t_value in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IRead_ticket loc_value (for_logging_only t_value)
              k_value; |} in
    let stack_value := Script_typed_ir.Item_t result_value full_stack in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_SPLIT_TICKET [] annot,
      Script_typed_ir.Item_t ((Script_typed_ir.Ticket_t t_value _) as ticket_t)
        (Script_typed_ir.Item_t
          (Script_typed_ir.Pair_t Script_typed_ir.Nat_t Script_typed_ir.Nat_t _
            _) rest)) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let '_ := check_dupable_comparable_ty t_value in
    let ? 'Script_typed_ir.Ty_ex_c pair_tickets_ty :=
      Script_typed_ir.pair_t loc_value ticket_t ticket_t in
    let ? res_ty := Script_typed_ir.option_t loc_value pair_tickets_ty in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.ISplit_ticket loc_value k_value; |} in
    let stack_value := Script_typed_ir.Item_t res_ty rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_JOIN_TICKETS [] annot,
      Script_typed_ir.Item_t
        (Script_typed_ir.Pair_t
          ((Script_typed_ir.Ticket_t contents_ty_a _) as ty_a)
          (Script_typed_ir.Ticket_t contents_ty_b _) _ _) rest) ⇒
    let ? '_ := Script_ir_annot.check_var_annot loc_value annot in
    let ? '(eq_value , ctxt ) :=
      Gas_monad.run ctxt
        (ty_eq (Script_tc_errors.Informative loc_value) contents_ty_a
          contents_ty_b) in
    let ? 'Eq := eq_value in
    let ? res_ty := Script_typed_ir.option_t loc_value ty_a in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IJoin_tickets loc_value contents_ty_a k_value; |} in
    let stack_value := Script_typed_ir.Item_t res_ty rest in
    typed ctxt loc_value instr stack_value
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_OPEN_CHEST [] _,
      Script_typed_ir.Item_t Script_typed_ir.Chest_key_t
        (Script_typed_ir.Item_t Script_typed_ir.Chest_t
          (Script_typed_ir.Item_t Script_typed_ir.Nat_t rest))) ⇒
    if legacy then
      let instr :=
        {|
          cinstr.apply :=
            fun (k_value : Script_typed_ir.kinstr) ⇒
              Script_typed_ir.IOpen_chest loc_value k_value; |} in
      typed ctxt loc_value instr
        (Script_typed_ir.Item_t Script_typed_ir.union_bytes_bool_t rest)
    else
      Error_monad.tzfail
        (Build_extensible "Deprecated_instruction" Alpha_context.Script.prim
          Michelson_v1_primitives.I_OPEN_CHEST)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EMIT [] annot,
      Script_typed_ir.Item_t data rest) ⇒
    let ? '_ := check_packable legacy loc_value data in
    let ? tag := Script_ir_annot.parse_entrypoint_annot_strict loc_value annot in
    let ? '(unparsed_ty , ctxt ) := Script_ir_unparser.unparse_ty tt ctxt data in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt
        (Alpha_context.Script.strip_locations_cost unparsed_ty) in
    let unparsed_ty := Micheline.strip_locations unparsed_ty in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEmit
              {| Script_typed_ir.kinstr.IEmit.loc := loc_value;
                Script_typed_ir.kinstr.IEmit.tag := tag;
                Script_typed_ir.kinstr.IEmit.ty := data;
                Script_typed_ir.kinstr.IEmit.unparsed_ty := unparsed_ty;
                Script_typed_ir.kinstr.IEmit.k := k_value; |}; |} in
    typed ctxt loc_value instr
      (Script_typed_ir.Item_t Script_typed_ir.Operation_t rest)
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_EMIT (cons ty_node [])
      annot, Script_typed_ir.Item_t data rest) ⇒
    let ? '(Script_typed_ir.Ex_ty ty_value , ctxt ) :=
      parse_packable_ty_aux ctxt (stack_depth +i 1) legacy ty_node in
    let ? '(Eq , ctxt ) :=
      check_item_ty ctxt ty_value data loc_value Michelson_v1_primitives.I_EMIT
        1 2 in
    let ? tag := Script_ir_annot.parse_entrypoint_annot_strict loc_value annot in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt
        (Alpha_context.Script.strip_locations_cost ty_node) in
    let unparsed_ty := Micheline.strip_locations ty_node in
    let instr :=
      {|
        cinstr.apply :=
          fun (k_value : Script_typed_ir.kinstr) ⇒
            Script_typed_ir.IEmit
              {| Script_typed_ir.kinstr.IEmit.loc := loc_value;
                Script_typed_ir.kinstr.IEmit.tag := tag;
                Script_typed_ir.kinstr.IEmit.ty := data;
                Script_typed_ir.kinstr.IEmit.unparsed_ty := unparsed_ty;
                Script_typed_ir.kinstr.IEmit.k := k_value; |}; |} in
    typed ctxt loc_value instr
      (Script_typed_ir.Item_t Script_typed_ir.Operation_t rest)
  |
    (Micheline.Prim loc_value
      ((Michelson_v1_primitives.I_DUP | Michelson_v1_primitives.I_SWAP |
      Michelson_v1_primitives.I_SOME | Michelson_v1_primitives.I_UNIT |
      Michelson_v1_primitives.I_PAIR | Michelson_v1_primitives.I_UNPAIR |
      Michelson_v1_primitives.I_CAR | Michelson_v1_primitives.I_CDR |
      Michelson_v1_primitives.I_CONS | Michelson_v1_primitives.I_CONCAT |
      Michelson_v1_primitives.I_SLICE | Michelson_v1_primitives.I_MEM |
      Michelson_v1_primitives.I_UPDATE | Michelson_v1_primitives.I_GET |
      Michelson_v1_primitives.I_EXEC | Michelson_v1_primitives.I_FAILWITH |
      Michelson_v1_primitives.I_SIZE | Michelson_v1_primitives.I_ADD |
      Michelson_v1_primitives.I_SUB | Michelson_v1_primitives.I_SUB_MUTEZ |
      Michelson_v1_primitives.I_MUL | Michelson_v1_primitives.I_EDIV |
      Michelson_v1_primitives.I_OR | Michelson_v1_primitives.I_AND |
      Michelson_v1_primitives.I_XOR | Michelson_v1_primitives.I_NOT |
      Michelson_v1_primitives.I_ABS | Michelson_v1_primitives.I_NEG |
      Michelson_v1_primitives.I_LSL | Michelson_v1_primitives.I_LSR |
      Michelson_v1_primitives.I_COMPARE | Michelson_v1_primitives.I_EQ |
      Michelson_v1_primitives.I_NEQ | Michelson_v1_primitives.I_LT |
      Michelson_v1_primitives.I_GT | Michelson_v1_primitives.I_LE |
      Michelson_v1_primitives.I_GE | Michelson_v1_primitives.I_TRANSFER_TOKENS |
      Michelson_v1_primitives.I_SET_DELEGATE | Michelson_v1_primitives.I_NOW |
      Michelson_v1_primitives.I_MIN_BLOCK_TIME |
      Michelson_v1_primitives.I_IMPLICIT_ACCOUNT |
      Michelson_v1_primitives.I_AMOUNT | Michelson_v1_primitives.I_BALANCE |
      Michelson_v1_primitives.I_LEVEL |
      Michelson_v1_primitives.I_CHECK_SIGNATURE |
      Michelson_v1_primitives.I_HASH_KEY | Michelson_v1_primitives.I_SOURCE |
      Michelson_v1_primitives.I_SENDER | Michelson_v1_primitives.I_BLAKE2B |
      Michelson_v1_primitives.I_SHA256 | Michelson_v1_primitives.I_SHA512 |
      Michelson_v1_primitives.I_ADDRESS | Michelson_v1_primitives.I_RENAME |
      Michelson_v1_primitives.I_PACK | Michelson_v1_primitives.I_ISNAT |
      Michelson_v1_primitives.I_INT | Michelson_v1_primitives.I_SELF |
      Michelson_v1_primitives.I_CHAIN_ID | Michelson_v1_primitives.I_NEVER |
      Michelson_v1_primitives.I_VOTING_POWER |
      Michelson_v1_primitives.I_TOTAL_VOTING_POWER |
      Michelson_v1_primitives.I_KECCAK | Michelson_v1_primitives.I_SHA3 |
      Michelson_v1_primitives.I_PAIRING_CHECK | Michelson_v1_primitives.I_TICKET
      | Michelson_v1_primitives.I_READ_TICKET |
      Michelson_v1_primitives.I_SPLIT_TICKET |
      Michelson_v1_primitives.I_JOIN_TICKETS |
      Michelson_v1_primitives.I_OPEN_CHEST) as name) ((cons _ _) as l_value) _,
      _) ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, name, 0, (List.length l_value)))
  |
    (Micheline.Prim loc_value
      ((Michelson_v1_primitives.I_NONE | Michelson_v1_primitives.I_LEFT |
      Michelson_v1_primitives.I_RIGHT | Michelson_v1_primitives.I_NIL |
      Michelson_v1_primitives.I_MAP | Michelson_v1_primitives.I_ITER |
      Michelson_v1_primitives.I_EMPTY_SET | Michelson_v1_primitives.I_LOOP |
      Michelson_v1_primitives.I_LOOP_LEFT | Michelson_v1_primitives.I_CONTRACT |
      Michelson_v1_primitives.I_CAST | Michelson_v1_primitives.I_UNPACK |
      Michelson_v1_primitives.I_CREATE_CONTRACT | Michelson_v1_primitives.I_EMIT)
        as name) (([] | cons _ (cons _ _)) as l_value) _, _) ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, name, 1, (List.length l_value)))
  |
    (Micheline.Prim loc_value
      ((Michelson_v1_primitives.I_PUSH | Michelson_v1_primitives.I_VIEW |
      Michelson_v1_primitives.I_IF_NONE | Michelson_v1_primitives.I_IF_LEFT |
      Michelson_v1_primitives.I_IF_CONS | Michelson_v1_primitives.I_EMPTY_MAP |
      Michelson_v1_primitives.I_EMPTY_BIG_MAP | Michelson_v1_primitives.I_IF) as
        name) (([] | cons _ [] | cons _ (cons _ (cons _ _))) as l_value) _, _)
    ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, name, 2, (List.length l_value)))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_LAMBDA
      (([] | cons _ [] | cons _ (cons _ []) |
      cons _ (cons _ (cons _ (cons _ _)))) as l_value) _, _) ⇒
    Error_monad.tzfail
      (Build_extensible "Invalid_arity"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int × int)
        (loc_value, Michelson_v1_primitives.I_LAMBDA, 3, (List.length l_value)))
  |
    (Micheline.Prim loc_value
      ((Michelson_v1_primitives.I_ADD | Michelson_v1_primitives.I_SUB |
      Michelson_v1_primitives.I_SUB_MUTEZ | Michelson_v1_primitives.I_MUL |
      Michelson_v1_primitives.I_EDIV | Michelson_v1_primitives.I_AND |
      Michelson_v1_primitives.I_OR | Michelson_v1_primitives.I_XOR |
      Michelson_v1_primitives.I_LSL | Michelson_v1_primitives.I_LSR |
      Michelson_v1_primitives.I_CONCAT | Michelson_v1_primitives.I_PAIRING_CHECK)
        as name) [] _, Script_typed_ir.Item_t ta (Script_typed_ir.Item_t tb _))
    ⇒
    let ta := Script_ir_unparser.serialize_ty_for_error ta in
    let tb := Script_ir_unparser.serialize_ty_for_error tb in
    Error_monad.tzfail
      (Build_extensible "Undefined_binop"
        (Alpha_context.Script.location × Alpha_context.Script.prim ×
          Alpha_context.Script.expr × Alpha_context.Script.expr)
        (loc_value, name, ta, tb))
  |
    (Micheline.Prim loc_value
      ((Michelson_v1_primitives.I_NEG | Michelson_v1_primitives.I_ABS |
      Michelson_v1_primitives.I_NOT | Michelson_v1_primitives.I_SIZE |
      Michelson_v1_primitives.I_EQ | Michelson_v1_primitives.I_NEQ |
      Michelson_v1_primitives.I_LT | Michelson_v1_primitives.I_GT |
      Michelson_v1_primitives.I_LE | Michelson_v1_primitives.I_GE |
      Michelson_v1_primitives.I_CONCAT) as name) [] _,
      Script_typed_ir.Item_t t_value _) ⇒
    let t_value := Script_ir_unparser.serialize_ty_for_error t_value in
    Error_monad.tzfail
      (Build_extensible "Undefined_unop"
        (Alpha_context.Script.location × Alpha_context.Script.prim ×
          Alpha_context.Script.expr) (loc_value, name, t_value))
  |
    (Micheline.Prim loc_value
      ((Michelson_v1_primitives.I_UPDATE | Michelson_v1_primitives.I_SLICE |
      Michelson_v1_primitives.I_OPEN_CHEST) as name) [] _, stack_value) ⇒
    let stack_value :=
      Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
    Error_monad.error_value
      (Build_extensible "Bad_stack"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
          Script_tc_errors.unparsed_stack_ty) (loc_value, name, 3, stack_value))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_CREATE_CONTRACT _ _,
      stack_value) ⇒
    let stack_value :=
      Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
    Error_monad.tzfail
      (Build_extensible "Bad_stack"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
          Script_tc_errors.unparsed_stack_ty)
        (loc_value, Michelson_v1_primitives.I_CREATE_CONTRACT, 7, stack_value))
  |
    (Micheline.Prim loc_value Michelson_v1_primitives.I_TRANSFER_TOKENS [] _,
      stack_value) ⇒
    let stack_value :=
      Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
    Error_monad.error_value
      (Build_extensible "Bad_stack"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
          Script_tc_errors.unparsed_stack_ty)
        (loc_value, Michelson_v1_primitives.I_TRANSFER_TOKENS, 4, stack_value))
  |
    (Micheline.Prim loc_value
      ((Michelson_v1_primitives.I_DROP | Michelson_v1_primitives.I_DUP |
      Michelson_v1_primitives.I_CAR | Michelson_v1_primitives.I_CDR |
      Michelson_v1_primitives.I_UNPAIR | Michelson_v1_primitives.I_SOME |
      Michelson_v1_primitives.I_BLAKE2B | Michelson_v1_primitives.I_SHA256 |
      Michelson_v1_primitives.I_SHA512 | Michelson_v1_primitives.I_DIP |
      Michelson_v1_primitives.I_IF_NONE | Michelson_v1_primitives.I_LEFT |
      Michelson_v1_primitives.I_RIGHT | Michelson_v1_primitives.I_IF_LEFT |
      Michelson_v1_primitives.I_IF | Michelson_v1_primitives.I_LOOP |
      Michelson_v1_primitives.I_IF_CONS |
      Michelson_v1_primitives.I_IMPLICIT_ACCOUNT | Michelson_v1_primitives.I_NEG
      | Michelson_v1_primitives.I_ABS | Michelson_v1_primitives.I_INT |
      Michelson_v1_primitives.I_NOT | Michelson_v1_primitives.I_HASH_KEY |
      Michelson_v1_primitives.I_EQ | Michelson_v1_primitives.I_NEQ |
      Michelson_v1_primitives.I_LT | Michelson_v1_primitives.I_GT |
      Michelson_v1_primitives.I_LE | Michelson_v1_primitives.I_GE |
      Michelson_v1_primitives.I_SIZE | Michelson_v1_primitives.I_FAILWITH |
      Michelson_v1_primitives.I_RENAME | Michelson_v1_primitives.I_PACK |
      Michelson_v1_primitives.I_ISNAT | Michelson_v1_primitives.I_ADDRESS |
      Michelson_v1_primitives.I_SET_DELEGATE | Michelson_v1_primitives.I_CAST |
      Michelson_v1_primitives.I_MAP | Michelson_v1_primitives.I_ITER |
      Michelson_v1_primitives.I_LOOP_LEFT | Michelson_v1_primitives.I_UNPACK |
      Michelson_v1_primitives.I_CONTRACT | Michelson_v1_primitives.I_NEVER |
      Michelson_v1_primitives.I_KECCAK | Michelson_v1_primitives.I_SHA3 |
      Michelson_v1_primitives.I_READ_TICKET |
      Michelson_v1_primitives.I_JOIN_TICKETS) as name) _ _, stack_value) ⇒
    let stack_value :=
      Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
    Error_monad.error_value
      (Build_extensible "Bad_stack"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
          Script_tc_errors.unparsed_stack_ty) (loc_value, name, 1, stack_value))
  |
    (Micheline.Prim loc_value
      ((Michelson_v1_primitives.I_SWAP | Michelson_v1_primitives.I_PAIR |
      Michelson_v1_primitives.I_CONS | Michelson_v1_primitives.I_GET |
      Michelson_v1_primitives.I_MEM | Michelson_v1_primitives.I_EXEC |
      Michelson_v1_primitives.I_CHECK_SIGNATURE | Michelson_v1_primitives.I_ADD
      | Michelson_v1_primitives.I_SUB | Michelson_v1_primitives.I_SUB_MUTEZ |
      Michelson_v1_primitives.I_MUL | Michelson_v1_primitives.I_EDIV |
      Michelson_v1_primitives.I_AND | Michelson_v1_primitives.I_OR |
      Michelson_v1_primitives.I_XOR | Michelson_v1_primitives.I_LSL |
      Michelson_v1_primitives.I_LSR | Michelson_v1_primitives.I_COMPARE |
      Michelson_v1_primitives.I_PAIRING_CHECK | Michelson_v1_primitives.I_TICKET
      | Michelson_v1_primitives.I_SPLIT_TICKET) as name) _ _, stack_value) ⇒
    let stack_value :=
      Script_ir_unparser.serialize_stack_for_error ctxt stack_value in
    Error_monad.error_value
      (Build_extensible "Bad_stack"
        (Alpha_context.Script.location × Alpha_context.Script.prim × int ×
          Script_tc_errors.unparsed_stack_ty) (loc_value, name, 2, stack_value))
  | (expr, _) ⇒
    Error_monad.tzfail
      (unexpected expr [ Script_tc_errors.Seq_kind ]
        Michelson_v1_primitives.Instr_namespace
        [
          Michelson_v1_primitives.I_ABS;
          Michelson_v1_primitives.I_ADD;
          Michelson_v1_primitives.I_AMOUNT;
          Michelson_v1_primitives.I_AND;
          Michelson_v1_primitives.I_BALANCE;
          Michelson_v1_primitives.I_BLAKE2B;
          Michelson_v1_primitives.I_CAR;
          Michelson_v1_primitives.I_CDR;
          Michelson_v1_primitives.I_CHECK_SIGNATURE;
          Michelson_v1_primitives.I_COMPARE;
          Michelson_v1_primitives.I_CONCAT;
          Michelson_v1_primitives.I_CONS;
          Michelson_v1_primitives.I_CREATE_CONTRACT;
          Michelson_v1_primitives.I_DIG;
          Michelson_v1_primitives.I_DIP;
          Michelson_v1_primitives.I_DROP;
          Michelson_v1_primitives.I_DUG;
          Michelson_v1_primitives.I_DUP;
          Michelson_v1_primitives.I_EDIV;
          Michelson_v1_primitives.I_EMPTY_BIG_MAP;
          Michelson_v1_primitives.I_EMPTY_MAP;
          Michelson_v1_primitives.I_EMPTY_SET;
          Michelson_v1_primitives.I_EQ;
          Michelson_v1_primitives.I_EXEC;
          Michelson_v1_primitives.I_FAILWITH;
          Michelson_v1_primitives.I_GE;
          Michelson_v1_primitives.I_GET;
          Michelson_v1_primitives.I_GET_AND_UPDATE;
          Michelson_v1_primitives.I_GT;
          Michelson_v1_primitives.I_HASH_KEY;
          Michelson_v1_primitives.I_IF;
          Michelson_v1_primitives.I_IF_CONS;
          Michelson_v1_primitives.I_IF_LEFT;
          Michelson_v1_primitives.I_IF_NONE;
          Michelson_v1_primitives.I_IMPLICIT_ACCOUNT;
          Michelson_v1_primitives.I_INT;
          Michelson_v1_primitives.I_ITER;
          Michelson_v1_primitives.I_JOIN_TICKETS;
          Michelson_v1_primitives.I_KECCAK;
          Michelson_v1_primitives.I_LAMBDA;
          Michelson_v1_primitives.I_LE;
          Michelson_v1_primitives.I_LEFT;
          Michelson_v1_primitives.I_LEVEL;
          Michelson_v1_primitives.I_LOOP;
          Michelson_v1_primitives.I_LSL;
          Michelson_v1_primitives.I_LSR;
          Michelson_v1_primitives.I_LT;
          Michelson_v1_primitives.I_MAP;
          Michelson_v1_primitives.I_MEM;
          Michelson_v1_primitives.I_MIN_BLOCK_TIME;
          Michelson_v1_primitives.I_MUL;
          Michelson_v1_primitives.I_NEG;
          Michelson_v1_primitives.I_NEQ;
          Michelson_v1_primitives.I_NEVER;
          Michelson_v1_primitives.I_NIL;
          Michelson_v1_primitives.I_NONE;
          Michelson_v1_primitives.I_NOT;
          Michelson_v1_primitives.I_NOW;
          Michelson_v1_primitives.I_OPEN_CHEST;
          Michelson_v1_primitives.I_OR;
          Michelson_v1_primitives.I_PAIR;
          Michelson_v1_primitives.I_PAIRING_CHECK;
          Michelson_v1_primitives.I_PUSH;
          Michelson_v1_primitives.I_READ_TICKET;
          Michelson_v1_primitives.I_RIGHT;
          Michelson_v1_primitives.I_SAPLING_EMPTY_STATE;
          Michelson_v1_primitives.I_SAPLING_VERIFY_UPDATE;
          Michelson_v1_primitives.I_SELF;
          Michelson_v1_primitives.I_SELF_ADDRESS;
          Michelson_v1_primitives.I_SENDER;
          Michelson_v1_primitives.I_SHA256;
          Michelson_v1_primitives.I_SHA3;
          Michelson_v1_primitives.I_SHA512;
          Michelson_v1_primitives.I_SIZE;
          Michelson_v1_primitives.I_SOME;
          Michelson_v1_primitives.I_SOURCE;
          Michelson_v1_primitives.I_SPLIT_TICKET;
          Michelson_v1_primitives.I_SUB;
          Michelson_v1_primitives.I_SUB_MUTEZ;
          Michelson_v1_primitives.I_SWAP;
          Michelson_v1_primitives.I_TICKET;
          Michelson_v1_primitives.I_TOTAL_VOTING_POWER;
          Michelson_v1_primitives.I_TRANSFER_TOKENS;
          Michelson_v1_primitives.I_UNIT;
          Michelson_v1_primitives.I_UNPAIR;
          Michelson_v1_primitives.I_UPDATE;
          Michelson_v1_primitives.I_VIEW;
          Michelson_v1_primitives.I_VOTING_POWER;
          Michelson_v1_primitives.I_XOR
        ])
  end

where "'parse_views" :=
  (fun
    (elab_conf : elab_conf) (ctxt : Alpha_context.context)
    (storage_type : Script_typed_ir.ty) (views : Script_typed_ir.view_map) ⇒
    let aux
      (ctxt : Alpha_context.context) (name : Script_string.t)
      (cur_view : Script_typed_ir.view)
      : M ? (typed_view × Alpha_context.context ) :=
      let ? ctxt :=
        Alpha_context.Gas.consume ctxt
          (Michelson_v1_gas.Cost_of.Interpreter.view_update name views) in
      parse_view elab_conf ctxt storage_type cur_view in
    Script_map.map_es_in_context aux ctxt views)

and "'parse_kdescr" :=
  (fun
    (elab_conf : elab_conf) (stack_depth : int) (tc_context_value : tc_context)
    (ctxt : Alpha_context.context) (arg : Script_typed_ir.ty)
    (ret_value : Script_typed_ir.ty) (script_instr : Alpha_context.Script.node)
    ⇒
    let ? function_parameter :=
      parse_instr_aux elab_conf (stack_depth +i 1) tc_context_value ctxt
        script_instr (Script_typed_ir.Item_t arg Script_typed_ir.Bot_t) in
    match function_parameter with
    |
      (Typed
        ({|
          descr.loc := loc_value;
            descr.aft :=
              (Script_typed_ir.Item_t ty_value Script_typed_ir.Bot_t) as
                stack_ty
            |} as descr_value), ctxt) ⇒
      let error_details := Script_tc_errors.Informative loc_value in
      let ? '(eq_value , ctxt ) :=
        Gas_monad.run ctxt
          (Gas_monad.record_trace_eval error_details
            (fun (loc_value : Alpha_context.Script.location) ⇒
              let ret_value :=
                Script_ir_unparser.serialize_ty_for_error ret_value in
              let stack_ty :=
                Script_ir_unparser.serialize_stack_for_error ctxt stack_ty in
              Build_extensible "Bad_return"
                (Alpha_context.Script.location ×
                  Script_tc_errors.unparsed_stack_ty × Alpha_context.Script.expr)
                (loc_value, stack_ty, ret_value))
            (ty_eq error_details ty_value ret_value)) in
      let ? 'Eq := eq_value in
      return ? ((close_descr descr_value), ctxt)
    | (Typed {| descr.loc := loc_value; descr.aft := stack_ty |}, ctxt) ⇒
      let ret_value := Script_ir_unparser.serialize_ty_for_error ret_value in
      let stack_ty := Script_ir_unparser.serialize_stack_for_error ctxt stack_ty
        in
      Error_monad.tzfail
        (Build_extensible "Bad_return"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty ×
            Alpha_context.Script.expr) (loc_value, stack_ty, ret_value))
    | (Failed {| judgement.Failed.descr := descr_value |}, ctxt) ⇒
      return ?
        ((close_descr
          (descr_value (Script_typed_ir.Item_t ret_value Script_typed_ir.Bot_t))),
          ctxt)
    end)

and "'parse_lam_rec" :=
  (fun
    (elab_conf : elab_conf) (stack_depth : int) (tc_context_value : tc_context)
    (ctxt : Alpha_context.context) (arg : Script_typed_ir.ty)
    (ret_value : Script_typed_ir.ty) (lambda_rec_ty : Script_typed_ir.ty)
    (script_instr : Alpha_context.Script.node) ⇒
    let ? function_parameter :=
      parse_instr_aux elab_conf (stack_depth +i 1) tc_context_value ctxt
        script_instr
        (Script_typed_ir.Item_t arg
          (Script_typed_ir.Item_t lambda_rec_ty Script_typed_ir.Bot_t)) in
    match function_parameter with
    |
      (Typed
        ({|
          descr.loc := loc_value;
            descr.aft :=
              (Script_typed_ir.Item_t ty_value Script_typed_ir.Bot_t) as
                stack_ty
            |} as descr_value), ctxt) ⇒
      let error_details := Script_tc_errors.Informative loc_value in
      let ? '(eq_value , ctxt ) :=
        Gas_monad.run ctxt
          (Gas_monad.record_trace_eval error_details
            (fun (loc_value : Alpha_context.Script.location) ⇒
              let ret_value :=
                Script_ir_unparser.serialize_ty_for_error ret_value in
              let stack_ty :=
                Script_ir_unparser.serialize_stack_for_error ctxt stack_ty in
              Build_extensible "Bad_return"
                (Alpha_context.Script.location ×
                  Script_tc_errors.unparsed_stack_ty × Alpha_context.Script.expr)
                (loc_value, stack_ty, ret_value))
            (ty_eq error_details ty_value ret_value)) in
      let ? 'Eq := eq_value in
      return ?
        ((Script_typed_ir.LamRec (close_descr descr_value) script_instr), ctxt)
    | (Typed {| descr.loc := loc_value; descr.aft := stack_ty |}, ctxt) ⇒
      let ret_value := Script_ir_unparser.serialize_ty_for_error ret_value in
      let stack_ty := Script_ir_unparser.serialize_stack_for_error ctxt stack_ty
        in
      Error_monad.tzfail
        (Build_extensible "Bad_return"
          (Alpha_context.Script.location × Script_tc_errors.unparsed_stack_ty ×
            Alpha_context.Script.expr) (loc_value, stack_ty, ret_value))
    | (Failed {| judgement.Failed.descr := descr_value |}, ctxt) ⇒
      return ?
        ((Script_typed_ir.LamRec
          (close_descr
            (descr_value
              (Script_typed_ir.Item_t ret_value Script_typed_ir.Bot_t)))
          script_instr), ctxt)
    end)

and "'parse_contract" :=
  (fun (err : Set) ⇒ fun
    (stack_depth : int) (ctxt : Alpha_context.context)
    (error_details :
      Script_tc_errors.error_details Alpha_context.Script.location)
    (loc_value : Alpha_context.Script.location) (arg : Script_typed_ir.ty)
    (destination : Alpha_context.Destination.t)
    (entrypoint : Alpha_context.Entrypoint.t) ⇒
    let error_value {B : Set}
      (ctxt : Alpha_context.context)
      (f_err : Alpha_context.Script.location → Error_monad._error)
      : Alpha_context.context × Pervasives.result B err :=
      (ctxt,
        (Pervasives.Error
          match error_details with
          | Script_tc_errors.Fast ⇒
            cast err Script_tc_errors.Inconsistent_types_fast
          | Script_tc_errors.Informative loc_value ⇒
            let loc_value := cast Alpha_context.Script.location loc_value in
            cast err (Error_monad.trace_of_error (f_err loc_value))
          end)) in
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.parse_instr_cycle in
    match destination with
    | Alpha_context.Destination.Contract contract ⇒
      match contract with
      | Contract_repr.Implicit pkh ⇒
        if Alpha_context.Entrypoint.is_default entrypoint then
          let ? '(eq_value , ctxt ) :=
            Gas_monad.run ctxt (ty_eq error_details arg Script_typed_ir.unit_t)
            in
          return ?
            (ctxt,
              (let ? 'Eq := eq_value in
              return ? (Script_typed_ir.Typed_implicit pkh)))
        else
          return ?
            (error_value ctxt
              (fun (_loc : Alpha_context.Script.location) ⇒
                Build_extensible "No_such_entrypoint" Alpha_context.Entrypoint.t
                  entrypoint))
      | Contract_repr.Originated contract_hash ⇒
        Error_monad.trace_value
          (Build_extensible "Invalid_contract"
            (Alpha_context.Script.location × Alpha_context.Contract.t)
            (loc_value, contract))
          (let ? '(ctxt , code ) :=
            Alpha_context.Contract.get_script_code ctxt contract_hash in
          match code with
          | None ⇒
            return ?
              (error_value ctxt
                (fun (loc_value : Alpha_context.Script.location) ⇒
                  Build_extensible "Invalid_contract"
                    (Alpha_context.Script.location × Alpha_context.Contract.t)
                    (loc_value, contract)))
          | Some code ⇒
            let ? '(code , ctxt ) :=
              Alpha_context.Script.force_decode_in_context
                Alpha_context.Script.When_needed ctxt code in
            let ? '({| toplevel.arg_type := arg_type |}, ctxt ) :=
              parse_toplevel_aux ctxt true code in
            let ?
              '(Ex_parameter_ty_and_entrypoints {|
                ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.arg_type :=
                  targ ;
                  ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.entrypoints
                    := entrypoints
                  |}, ctxt ) :=
              parse_parameter_ty_and_entrypoints_aux ctxt (stack_depth +i 1)
                true arg_type in
            let 'existT _ __Ex_parameter_ty_and_entrypoints_'a1
              [ctxt, entrypoints, targ] :=
              cast_exists (Es := Set)
                (fun __Ex_parameter_ty_and_entrypoints_'a1 ⇒
                  [Alpha_context.context ** Script_typed_ir.entrypoints **
                    Script_typed_ir.ty]) [ctxt, entrypoints, targ] in
            let ? '(entrypoint_arg , ctxt ) :=
              Gas_monad.run ctxt
                ((find_entrypoint_for_type
                  (full := __Ex_parameter_ty_and_entrypoints_'a1)) error_details
                  targ arg entrypoints entrypoint) in
            return ?
              (ctxt,
                (let ? '(entrypoint , arg_ty ) := entrypoint_arg in
                return ?
                  (Script_typed_ir.Typed_originated
                    {|
                      Script_typed_ir.typed_contract.Typed_originated.arg_ty :=
                        arg_ty;
                      Script_typed_ir.typed_contract.Typed_originated.contract_hash
                        := contract_hash;
                      Script_typed_ir.typed_contract.Typed_originated.entrypoint
                        := entrypoint; |})))
          end)
      end
    | Alpha_context.Destination.Tx_rollup tx_rollup ⇒
      let ? ctxt := Alpha_context.Tx_rollup_state.assert_exist ctxt tx_rollup in
      return ?
        (if Alpha_context.Entrypoint.is_deposit entrypoint then
          match arg with
          |
            Script_typed_ir.Pair_t (Script_typed_ir.Ticket_t _ _)
              Script_typed_ir.Tx_rollup_l2_address_t _ _ ⇒
            (ctxt,
              (return ?
                (Script_typed_ir.Typed_tx_rollup
                  {|
                    Script_typed_ir.typed_contract.Typed_tx_rollup.arg_ty :=
                      arg;
                    Script_typed_ir.typed_contract.Typed_tx_rollup.tx_rollup :=
                      tx_rollup; |})))
          | _ ⇒
            error_value ctxt
              (fun (loc_value : Alpha_context.Script.location) ⇒
                Build_extensible "Tx_rollup_bad_deposit_parameter"
                  (Alpha_context.Script.location × Alpha_context.Script.expr)
                  (loc_value, (Script_ir_unparser.serialize_ty_for_error arg)))
          end
        else
          error_value ctxt
            (fun (_loc : Alpha_context.Script.location) ⇒
              Build_extensible "No_such_entrypoint" Alpha_context.Entrypoint.t
                entrypoint))
    | Alpha_context.Destination.Zk_rollup zk_rollup ⇒
      let ? ctxt := Alpha_context.Zk_rollup.assert_exist ctxt zk_rollup in
      return ?
        (if Alpha_context.Entrypoint.is_deposit entrypoint then
          match arg with
          |
            Script_typed_ir.Pair_t (Script_typed_ir.Ticket_t _ _)
              Script_typed_ir.Bytes_t _ _ ⇒
            (ctxt,
              (return ?
                (Script_typed_ir.Typed_zk_rollup
                  {|
                    Script_typed_ir.typed_contract.Typed_zk_rollup.arg_ty :=
                      arg;
                    Script_typed_ir.typed_contract.Typed_zk_rollup.zk_rollup :=
                      zk_rollup; |})))
          | _ ⇒
            error_value ctxt
              (fun (loc_value : Alpha_context.Script.location) ⇒
                Build_extensible "Zk_rollup_bad_deposit_parameter"
                  (Alpha_context.Script.location × Alpha_context.Script.expr)
                  (loc_value, (Script_ir_unparser.serialize_ty_for_error arg)))
          end
        else
          error_value ctxt
            (fun (_loc : Alpha_context.Script.location) ⇒
              Build_extensible "No_such_entrypoint" Alpha_context.Entrypoint.t
                entrypoint))
    | Alpha_context.Destination.Sc_rollup sc_rollup ⇒
      let ? '(parameters_type , ctxt ) :=
        Alpha_context.Sc_rollup.parameters_type ctxt sc_rollup in
      match parameters_type with
      | None ⇒
        return ?
          (error_value ctxt
            (fun (_loc : Alpha_context.Script.location) ⇒
              Build_extensible "Sc_rollup_does_not_exist"
                Alpha_context.Sc_rollup.t sc_rollup))
      | Some parameters_type ⇒
        let ? '(parameters_type , ctxt ) :=
          Alpha_context.Script.force_decode_in_context
            Alpha_context.Script.When_needed ctxt parameters_type in
        let ?
          '(Ex_parameter_ty_and_entrypoints {|
            ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.arg_type :=
              full_value ;
              ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.entrypoints
                := entrypoints
              |}, ctxt ) :=
          parse_parameter_ty_and_entrypoints_aux ctxt (stack_depth +i 1) true
            (Micheline.root_value parameters_type) in
        let 'existT _ __Ex_parameter_ty_and_entrypoints_'a2
          [ctxt, entrypoints, full_value] :=
          cast_exists (Es := Set)
            (fun __Ex_parameter_ty_and_entrypoints_'a2 ⇒
              [Alpha_context.context ** Script_typed_ir.entrypoints **
                Script_typed_ir.ty]) [ctxt, entrypoints, full_value] in
        let ? '(entrypoint_arg , ctxt ) :=
          Gas_monad.run ctxt
            ((find_entrypoint_for_type
              (full := __Ex_parameter_ty_and_entrypoints_'a2)) error_details
              full_value arg entrypoints entrypoint) in
        return ?
          (ctxt,
            (let ? '(entrypoint , arg_ty ) := entrypoint_arg in
            return ?
              (Script_typed_ir.Typed_sc_rollup
                {|
                  Script_typed_ir.typed_contract.Typed_sc_rollup.arg_ty :=
                    arg_ty;
                  Script_typed_ir.typed_contract.Typed_sc_rollup.sc_rollup :=
                    sc_rollup;
                  Script_typed_ir.typed_contract.Typed_sc_rollup.entrypoint :=
                    entrypoint; |})))
      end
    end)

and "'parse_contract_data_aux" :=
  (fun
    (stack_depth : int) (ctxt : Alpha_context.context)
    (loc_value : Alpha_context.Script.location) (arg : Script_typed_ir.ty)
    (destination : Alpha_context.Destination.t)
    (entrypoint : Alpha_context.Entrypoint.t) ⇒
    let parse_contract {err} := 'parse_contract err in
    let error_details := Script_tc_errors.Informative loc_value in
    let ? '(ctxt , res ) :=
      parse_contract (stack_depth +i 1) ctxt error_details loc_value arg
        destination entrypoint in
    let ? res := res in
    return ? (ctxt, res)).

Definition parse_views := 'parse_views.
Definition parse_kdescr := 'parse_kdescr.
Definition parse_lam_rec := 'parse_lam_rec.
Definition parse_contract {err : Set} := 'parse_contract err.
Definition parse_contract_data_aux := 'parse_contract_data_aux.

Definition parse_contract_for_script
  (ctxt : Alpha_context.context) (loc_value : Alpha_context.Script.location)
  (arg : Script_typed_ir.ty) (destination : Alpha_context.Destination.t)
  (entrypoint : Alpha_context.Entrypoint.t)
  : M ? (Alpha_context.context × option Script_typed_ir.typed_contract ) :=
  let ? '(ctxt , res ) :=
    parse_contract 0 ctxt Script_tc_errors.Fast loc_value arg destination
      entrypoint in
  return ?
    (ctxt,
      match res with
      | Pervasives.Ok res ⇒ Some res
      | Pervasives.Error Script_tc_errors.Inconsistent_types_fast ⇒ None
      end).

Definition view_size (view : Script_typed_ir.view)
  : Cache_memory_helpers.nodes_and_size :=
  Script_typed_ir_size.op_plusplus
    (Script_typed_ir_size.op_plusplus
      (Script_typed_ir_size.node_size view.(Script_typed_ir.view.view_code))
      (Script_typed_ir_size.node_size view.(Script_typed_ir.view.input_ty)))
    (Script_typed_ir_size.node_size view.(Script_typed_ir.view.output_ty)).

Definition code_size {A : Set}
  (ctxt : Alpha_context.context) (code : Script_typed_ir.lambda)
  (views : Script_typed_ir.map A Script_typed_ir.view)
  : M ? (Cache_memory_helpers.sint × Alpha_context.context ) :=
  let views_size :=
    Script_map.fold
      (fun (function_parameter : A) ⇒
        let '_ := function_parameter in
        fun (v_value : Script_typed_ir.view) ⇒
          fun (s_value : Cache_memory_helpers.nodes_and_size) ⇒
            Script_typed_ir_size.op_plusplus (view_size v_value) s_value) views
      Script_typed_ir_size.zero in
  let ir_size := Script_typed_ir_size.lambda_size code in
  let '(nodes, code_size) := Script_typed_ir_size.op_plusplus views_size ir_size
    in
  let ? ctxt :=
    Alpha_context.Gas.consume ctxt (Script_typed_ir_size_costs.nodes_cost nodes)
    in
  return ? (code_size, ctxt).

Definition parse_code
  (elab_conf : elab_conf) (ctxt : Alpha_context.context)
  (code : Alpha_context.Script.lazy_expr)
  : M ? (ex_code × Alpha_context.context ) :=
  let ? '(code , ctxt ) :=
    Alpha_context.Script.force_decode_in_context
      Alpha_context.Script.When_needed ctxt code in
  let legacy := elab_conf.(Script_ir_translator_config.elab_config.legacy) in
  let ? '(ctxt , code ) := Alpha_context.Global_constants_storage.expand ctxt code
    in
  let ?
    '({|
      toplevel.code_field := code_field ;
        toplevel.arg_type := arg_type ;
        toplevel.storage_type := storage_type ;
        toplevel.views := views
        |}, ctxt ) := parse_toplevel_aux ctxt legacy code in
  let arg_type_loc := location arg_type in
  let ?
    '(Ex_parameter_ty_and_entrypoints {|
      ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.arg_type :=
        arg_type ;
        ex_parameter_ty_and_entrypoints.Ex_parameter_ty_and_entrypoints.entrypoints
          := entrypoints
        |}, ctxt ) :=
    Error_monad.record_trace
      (Build_extensible "Ill_formed_type"
        (option string × Alpha_context.Script.expr ×
          Alpha_context.Script.location)
        ((Some "parameter"), code, arg_type_loc))
      (parse_parameter_ty_and_entrypoints_aux ctxt 0 legacy arg_type) in
  let storage_type_loc := location storage_type in
  let ? '(Script_typed_ir.Ex_ty storage_type , ctxt ) :=
    Error_monad.record_trace
      (Build_extensible "Ill_formed_type"
        (option string × Alpha_context.Script.expr ×
          Alpha_context.Script.location)
        ((Some "storage"), code, storage_type_loc))
      (parse_storage_ty ctxt 0 legacy storage_type) in
  let ? 'Script_typed_ir.Ty_ex_c arg_type_full :=
    Script_typed_ir.pair_t storage_type_loc arg_type storage_type in
  let ? 'Script_typed_ir.Ty_ex_c ret_type_full :=
    Script_typed_ir.pair_t storage_type_loc Script_typed_ir.list_operation_t
      storage_type in
  let ? '(kdescr , ctxt ) :=
    Error_monad.trace_value
      (Build_extensible "Ill_typed_contract"
        (Alpha_context.Script.expr × Script_tc_errors.type_map) (code, nil))
      (parse_kdescr elab_conf 0
        (Tc_context.toplevel_value storage_type arg_type entrypoints) ctxt
        arg_type_full ret_type_full code_field) in
  let code := Script_typed_ir.Lam kdescr code_field in
  let ? '(code_size , ctxt ) := code_size ctxt code views in
  return ?
    ((Ex_code
      (Code
        {| code.Code.code := code; code.Code.arg_type := arg_type;
          code.Code.storage_type := storage_type; code.Code.views := views;
          code.Code.entrypoints := entrypoints;
          code.Code.code_size := code_size; |})), ctxt).

Definition parse_storage {storage : Set}
  (elab_conf : elab_conf) (ctxt : Alpha_context.context) (allow_forged : bool)
  (storage_type : Script_typed_ir.ty)
  (storage_value : Alpha_context.Script.lazy_expr)
  : M ? (storage × Alpha_context.context ) :=
  let ? '(storage_value , ctxt ) :=
    Alpha_context.Script.force_decode_in_context
      Alpha_context.Script.When_needed ctxt storage_value in
  Error_monad.trace_eval
    (fun (function_parameter : unit) ⇒
      let '_ := function_parameter in
      let storage_type := Script_ir_unparser.serialize_ty_for_error storage_type
        in
      Build_extensible "Ill_typed_data"
        (option string × Alpha_context.Script.expr × Alpha_context.Script.expr)
        (None, storage_value, storage_type))
    (parse_data_aux elab_conf 0 ctxt allow_forged storage_type
      (Micheline.root_value storage_value)).

Definition parse_script
  (elab_conf : elab_conf) (ctxt : Alpha_context.context)
  (allow_forged_in_storage : bool) (function_parameter : Alpha_context.Script.t)
  : M ? (ex_script × Alpha_context.context ) :=
  let '{|
    Alpha_context.Script.t.code := code;
      Alpha_context.Script.t.storage := storage_value
      |} := function_parameter in
  let ?
    '(Ex_code
      (Code {|
        code.Code.code := code ;
          code.Code.arg_type := arg_type ;
          code.Code.storage_type := storage_type ;
          code.Code.views := views ;
          code.Code.entrypoints := entrypoints ;
          code.Code.code_size := code_size
          |}), ctxt ) := parse_code elab_conf ctxt code in
  let 'existT _ __Ex_code_'c
    [ctxt, code_size, entrypoints, views, storage_type, arg_type, code] :=
    cast_exists (Es := Set)
      (fun __Ex_code_'c ⇒
        [Alpha_context.context ** Cache_memory_helpers.sint **
          Script_typed_ir.entrypoints ** Script_typed_ir.view_map **
          Script_typed_ir.ty ** Script_typed_ir.ty ** Script_typed_ir.lambda])
      [ctxt, code_size, entrypoints, views, storage_type, arg_type, code] in
  let ? '(storage_value , ctxt ) :=
    parse_storage elab_conf ctxt allow_forged_in_storage storage_type
      storage_value in
  return ?
    ((Ex_script
      (Script_typed_ir.Script
        {| Script_typed_ir.script.Script.code := code;
          Script_typed_ir.script.Script.arg_type := arg_type;
          Script_typed_ir.script.Script.storage :=
            (storage_value : __Ex_code_'c);
          Script_typed_ir.script.Script.storage_type := storage_type;
          Script_typed_ir.script.Script.views := views;
          Script_typed_ir.script.Script.entrypoints := entrypoints;
          Script_typed_ir.script.Script.code_size := code_size; |})), ctxt).

Records for the constructor parameters

This function is called only on storage and parameter types of contracts, once per typechecked contract. It has a complexity linear in the size of the types, which happen to be literally written types, so the gas for them has already been paid.

Transforms a value potentially containing lazy storage in an intermediary state to a value containing lazy storage only represented by identifiers.

Returns the updated value, the updated set of ids to copy, and the lazy storage diff to show on the receipt and apply on the storage.

#[bypass_check(guard)]
Definition extract_lazy_storage_updates {A : Set}
  (ctxt : Alpha_context.context) (mode : Script_ir_unparser.unparsing_mode)
  (temporary : bool) (ids_to_copy : Alpha_context.Lazy_storage.IdSet.t)
  (acc_value : Alpha_context.Lazy_storage.diffs) (ty_value : Script_typed_ir.ty)
  (x_value : A)
  : M ?
    (Alpha_context.context × A × Alpha_context.Lazy_storage.IdSet.t ×
      Alpha_context.Lazy_storage.diffs ) :=
  let fix aux {a : Set}
    (ctxt : Alpha_context.context) (mode : Script_ir_unparser.unparsing_mode)
    (temporary : bool) (ids_to_copy : Alpha_context.Lazy_storage.IdSet.t)
    (acc_value : Alpha_context.Lazy_storage.diffs)
    (ty_value : Script_typed_ir.ty) (x_value : a)
    (has_lazy_storage_value : has_lazy_storage) {struct has_lazy_storage_value}
    : M ?
      (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
        Alpha_context.Lazy_storage.diffs ) :=
    let ? ctxt :=
      Alpha_context.Gas.consume ctxt Typecheck_costs.parse_instr_cycle in
    match (has_lazy_storage_value, ty_value, x_value) with
    | (False_f, _, _) ⇒
      cast
        (M ?
          (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
            Alpha_context.Lazy_storage.diffs ))
      ((return ? (ctxt, x_value, ids_to_copy, acc_value)) :
        M ?
          (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
            Alpha_context.Lazy_storage.diffs ))
    | (Big_map_f, Script_typed_ir.Big_map_t _ _ _, map) ⇒
      let map := cast Script_typed_ir.big_map map in
      cast
        (M ?
          (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
            Alpha_context.Lazy_storage.diffs ))
      (let ? '(diff_value , id , ctxt ) :=
        diff_of_big_map ctxt mode temporary ids_to_copy map in
      let map :=
        let 'Script_typed_ir.Big_map map := map in
        Script_typed_ir.Big_map
          (Script_typed_ir.big_map.Big_map.with_diff
            {|
              Script_typed_ir.big_map_overlay.map :=
                Script_typed_ir.Big_map_overlay.(Map.S.empty);
              Script_typed_ir.big_map_overlay.size := 0; |}
            (Script_typed_ir.big_map.Big_map.with_id (Some id) map)) in
      let diff_value :=
        Alpha_context.Lazy_storage.make Alpha_context.Lazy_storage.Kind.Big_map
          id diff_value in
      let ids_to_copy :=
        Alpha_context.Lazy_storage.IdSet.add
          Alpha_context.Lazy_storage.Kind.Big_map id ids_to_copy in
      return ? (ctxt, map, ids_to_copy, (cons diff_value acc_value)))
    | (Sapling_state_f, Script_typed_ir.Sapling_state_t _, sapling_state) ⇒
      let sapling_state := cast Alpha_context.Sapling.state sapling_state in
      cast
        (M ?
          (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
            Alpha_context.Lazy_storage.diffs ))
      (let ? '(diff_value , id , ctxt ) :=
        diff_of_sapling_state ctxt temporary ids_to_copy sapling_state in
      let sapling_state :=
        Alpha_context.Sapling.empty_state (Some id)
          sapling_state.(Alpha_context.Sapling.state.memo_size) tt in
      let diff_value :=
        Alpha_context.Lazy_storage.make
          Alpha_context.Lazy_storage.Kind.Sapling_state id diff_value in
      let ids_to_copy :=
        Alpha_context.Lazy_storage.IdSet.add
          Alpha_context.Lazy_storage.Kind.Sapling_state id ids_to_copy in
      return ? (ctxt, sapling_state, ids_to_copy, (cons diff_value acc_value)))
    | (Pair_f hl hr, Script_typed_ir.Pair_t tyl tyr _ _, x_value) ⇒
      let 'existT _ [__2, __3] [x_value, tyr, tyl, hr, hl] :=
        cast_exists (Es := [Set ** Set])
          (fun '[__2 , __3 ] ⇒
            [__2 × __3 ** Script_typed_ir.ty ** Script_typed_ir.ty **
              has_lazy_storage ** has_lazy_storage]) [x_value, tyr, tyl, hr, hl]
        in
      cast
        (M ?
          (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
            Alpha_context.Lazy_storage.diffs ))
      (let '(xl, xr) := x_value in
      let ? '(ctxt , xl , ids_to_copy , acc_value ) :=
        aux ctxt mode temporary ids_to_copy acc_value tyl xl hl in
      let ? '(ctxt , xr , ids_to_copy , acc_value ) :=
        aux ctxt mode temporary ids_to_copy acc_value tyr xr hr in
      return ? (ctxt, (xl, xr), ids_to_copy, acc_value))
    |
      (Union_f has_lazy_storage_l has_lazy_storage_r,
        Script_typed_ir.Union_t tyl tyr _ _, x_value) ⇒
      let 'existT _ [__4, __5]
        [x_value, tyr, tyl, has_lazy_storage_r, has_lazy_storage_l] :=
        cast_exists (Es := [Set ** Set])
          (fun '[__4 , __5 ] ⇒
            [Script_typed_ir.union __4 __5 ** Script_typed_ir.ty **
              Script_typed_ir.ty ** has_lazy_storage ** has_lazy_storage])
          [x_value, tyr, tyl, has_lazy_storage_r, has_lazy_storage_l] in
      cast
        (M ?
          (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
            Alpha_context.Lazy_storage.diffs ))
      match x_value with
      | Script_typed_ir.L x_value ⇒
        let ? '(ctxt , x_value , ids_to_copy , acc_value ) :=
          aux ctxt mode temporary ids_to_copy acc_value tyl x_value
            has_lazy_storage_l in
        return ? (ctxt, (Script_typed_ir.L x_value), ids_to_copy, acc_value)
      | Script_typed_ir.R x_value ⇒
        let ? '(ctxt , x_value , ids_to_copy , acc_value ) :=
          aux ctxt mode temporary ids_to_copy acc_value tyr x_value
            has_lazy_storage_r in
        return ? (ctxt, (Script_typed_ir.R x_value), ids_to_copy, acc_value)
      end
    |
      (Option_f has_lazy_storage_value, Script_typed_ir.Option_t ty_value _ _,
        x_value) ⇒
      let 'existT _ __6 [x_value, ty_value, has_lazy_storage_value] :=
        cast_exists (Es := Set)
          (fun __6 ⇒ [option __6 ** Script_typed_ir.ty ** has_lazy_storage])
          [x_value, ty_value, has_lazy_storage_value] in
      cast
        (M ?
          (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
            Alpha_context.Lazy_storage.diffs ))
      match x_value with
      | Some x_value ⇒
        let ? '(ctxt , x_value , ids_to_copy , acc_value ) :=
          aux ctxt mode temporary ids_to_copy acc_value ty_value x_value
            has_lazy_storage_value in
        return ? (ctxt, (Some x_value), ids_to_copy, acc_value)
      | None ⇒ return ? (ctxt, None, ids_to_copy, acc_value)
      end
    |
      (List_f has_lazy_storage_value, Script_typed_ir.List_t ty_value _, l_value)
      ⇒
      let 'existT _ __7 [l_value, ty_value, has_lazy_storage_value] :=
        cast_exists (Es := Set)
          (fun __7 ⇒
            [Script_list.t __7 ** Script_typed_ir.ty ** has_lazy_storage])
          [l_value, ty_value, has_lazy_storage_value] in
      cast
        (M ?
          (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
            Alpha_context.Lazy_storage.diffs ))
      (let ? '(ctxt , l_value , ids_to_copy , acc_value ) :=
        List.fold_left_es
          (fun (function_parameter :
            Alpha_context.context × Script_list.t __7 ×
              Alpha_context.Lazy_storage.IdSet.t ×
              Alpha_context.Lazy_storage.diffs) ⇒
            let '(ctxt, l_value, ids_to_copy, acc_value) := function_parameter
              in
            fun (x_value : __7) ⇒
              let ? '(ctxt , x_value , ids_to_copy , acc_value ) :=
                aux ctxt mode temporary ids_to_copy acc_value ty_value x_value
                  has_lazy_storage_value in
              return ?
                (ctxt, (Script_list.cons_value x_value l_value), ids_to_copy,
                  acc_value)) (ctxt, Script_list.empty, ids_to_copy, acc_value)
          l_value.(Script_list.t.elements) in
      let reversed := Script_list.rev l_value in
      return ? (ctxt, reversed, ids_to_copy, acc_value))
    | (Map_f has_lazy_storage_value, Script_typed_ir.Map_t _ ty_value _, map) ⇒
      let 'existT _ [__8, __9] [map, ty_value, has_lazy_storage_value] :=
        cast_exists (Es := [Set ** Set])
          (fun '[__8 , __9 ] ⇒
            [Script_typed_ir.map __8 __9 ** Script_typed_ir.ty **
              has_lazy_storage]) [map, ty_value, has_lazy_storage_value] in
      cast
        (M ?
          (Alpha_context.context × a × Alpha_context.Lazy_storage.IdSet.t ×
            Alpha_context.Lazy_storage.diffs ))
      (let M := Script_map.get_module map in
      let 'existS _ _ M := M in
      let bindings {C : Set}
        (m_value :
          M.(Script_typed_ir.Boxed_map.OPS).(Script_typed_ir.Boxed_map_OPS.t) C)
        : list (__8 × C) :=
        M.(Script_typed_ir.Boxed_map.OPS).(Script_typed_ir.Boxed_map_OPS.fold)
          (fun (k_value : __8) ⇒
            fun (v_value : C) ⇒
              fun (bs : list (__8 × C)) ⇒ cons (k_value, v_value) bs) m_value
          nil in
      let ? '(ctxt , m_value , ids_to_copy , acc_value ) :=
        List.fold_left_es
          (fun (function_parameter :
            Alpha_context.context ×
              M.(Script_typed_ir.Boxed_map.OPS).(Script_typed_ir.Boxed_map_OPS.t)
                __9 × Alpha_context.Lazy_storage.IdSet.t ×
              Alpha_context.Lazy_storage.diffs) ⇒
            let '(ctxt, m_value, ids_to_copy, acc_value) := function_parameter
              in
            fun (function_parameter : __8 × __9) ⇒
              let '(k_value, x_value) := function_parameter in
              let ? '(ctxt , x_value , ids_to_copy , acc_value ) :=
                aux ctxt mode temporary ids_to_copy acc_value ty_value x_value
                  has_lazy_storage_value in
              return ?
                (ctxt,
                  (M.(Script_typed_ir.Boxed_map.OPS).(Script_typed_ir.Boxed_map_OPS.add)
                    k_value x_value m_value), ids_to_copy, acc_value))
          (ctxt,
            M.(Script_typed_ir.Boxed_map.OPS).(Script_typed_ir.Boxed_map_OPS.empty),
            ids_to_copy, acc_value)
          (bindings M.(Script_typed_ir.Boxed_map.boxed)) in
      let M :=
        let OPS := M.(Script_typed_ir.Boxed_map.OPS) in
        let key : Set := __8 in
        let value : Set := __9 in
        let boxed := m_value in
        let size_value := M.(Script_typed_ir.Boxed_map.size_value) in
        let boxed_map_tag := tt in
        {|
          Script_typed_ir.Boxed_map.OPS := OPS;
          Script_typed_ir.Boxed_map.boxed := boxed;
          Script_typed_ir.Boxed_map.size_value := size_value;
          Script_typed_ir.Boxed_map.boxed_map_tag := boxed_map_tag
        |} in
      return ?
        (ctxt, (Script_map.make (existS (A := Set → Set) _ _ M)), ids_to_copy,
          acc_value))
    | _ ⇒ unreachable_gadt_branch
    end in
  let has_lazy_storage_value := has_lazy_storage_value ty_value in
  aux ctxt mode temporary ids_to_copy acc_value ty_value x_value
    has_lazy_storage_value.

We namespace an error type for [fold_lazy_storage]. The error case is only available when the ['error] parameter is equal to unit.

Module Fold_lazy_storage.
  Inductive result (acc : Set) : Set :=
  | Ok : acc → result acc
  | Error : result acc.

  Arguments Ok {_}.
  Arguments Error {_}.
End Fold_lazy_storage.

Prematurely abort if [f] generates an error. Use this function without the [unit] type for [error] if you are in a case where errors are impossible.