balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

use dig/dug for get/set

Browse Source
This commit is contained in:
galfour 2019-10-17 15:48:24 +02:00
parent 56269231b3
commit 8a4b9695e7
2 changed files with 25 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/passes/8-compiler/compiler_environment.ml
View File

@ -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

3
vendors/ligo-utils/tezos-utils/x_michelson.ml vendored
View File

@ -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]