diff --git a/src/passes/8-compiler/compiler_environment.ml b/src/passes/8-compiler/compiler_environment.ml index a196d9c49..4f06f8446 100644 --- a/src/passes/8-compiler/compiler_environment.ml +++ b/src/passes/8-compiler/compiler_environment.ml @@ -14,31 +14,46 @@ let get : environment -> string -> michelson result = fun e s -> error title content in generic_try error @@ (fun () -> Environment.get_i s e) in - let rec aux = fun n -> + let rec aux_bubble = fun n -> match n with | 0 -> i_dup | n -> seq [ - dip @@ aux (n - 1) ; + dip @@ aux_bubble (n - 1) ; i_swap ; ] in - let code = aux position in + let aux_dig = fun n -> seq [ + dipn n i_dup ; + i_dig n ; + ] + in + let code = + if position < 2 + then aux_bubble position + else aux_dig position in ok code let set : environment -> string -> michelson result = fun e s -> let%bind (_ , position) = - generic_try (simple_error "Environment.get") @@ + generic_try (simple_error "Environment.set") @@ (fun () -> Environment.get_i s e) in - let rec aux = fun n -> + let rec aux_bubble = fun n -> match n with | 0 -> dip i_drop | n -> seq [ i_swap ; - dip (aux (n - 1)) ; + dip (aux_bubble (n - 1)) ; ] in - let code = aux position in + let aux_dug = fun n -> seq [ + dipn (n + 1) i_drop ; + i_dug n ; + ] in + let code = + if position < 2 + then aux_bubble position + else aux_dug position in ok code diff --git a/vendors/ligo-utils/tezos-utils/x_michelson.ml b/vendors/ligo-utils/tezos-utils/x_michelson.ml index 8f8527f30..1b94837b7 100644 --- a/vendors/ligo-utils/tezos-utils/x_michelson.ml +++ b/vendors/ligo-utils/tezos-utils/x_michelson.ml @@ -67,6 +67,9 @@ let i_assert_some = i_if_none (seq [i_push_string "ASSERT_SOME" ; i_failwith]) ( let i_assert_some_msg msg = i_if_none (seq [msg ; i_failwith]) (seq []) let dip code : michelson = prim ~children:[seq [code]] I_DIP +let dipn n code = prim ~children:[Int (0 , Z.of_int n) ; seq [code]] I_DIP +let i_dig n : michelson = prim ~children:[Int (0 , Z.of_int n)] I_DIG +let i_dug n : michelson = prim ~children:[Int (0 , Z.of_int n)] I_DUG let i_unpair = seq [i_dup ; i_car ; dip i_cdr] let i_unpiar = seq [i_dup ; i_cdr ; dip i_car]