This stuff is now unused
This commit is contained in:
parent
31591f1669
commit
bd987613d5
@ -41,109 +41,3 @@ let set : environment -> string -> michelson result = fun e s ->
|
|||||||
let code = aux position in
|
let code = aux position in
|
||||||
|
|
||||||
ok code
|
ok code
|
||||||
|
|
||||||
let add : environment -> (string * type_value) -> michelson result = fun _ (_s , _) ->
|
|
||||||
let code = seq [] in
|
|
||||||
|
|
||||||
ok code
|
|
||||||
|
|
||||||
let select ?(rev = false) ?(keep = true) : environment -> string list -> michelson result = fun e lst ->
|
|
||||||
let module L = Logger.Stateful() in
|
|
||||||
let e_lst =
|
|
||||||
let e_lst = Environment.to_list e in
|
|
||||||
let aux selector (s , _) =
|
|
||||||
L.log @@ Format.asprintf "Selector : %a\n" PP_helpers.(list_sep string (const " , ")) selector ;
|
|
||||||
match List.mem s selector with
|
|
||||||
| true -> List.remove_element s selector , keep
|
|
||||||
| false -> selector , not keep in
|
|
||||||
let e_lst' =
|
|
||||||
if rev = keep
|
|
||||||
then List.fold_map aux lst e_lst
|
|
||||||
else List.fold_map_right aux lst e_lst
|
|
||||||
in
|
|
||||||
let e_lst'' = List.combine e_lst e_lst' in
|
|
||||||
e_lst'' in
|
|
||||||
let code =
|
|
||||||
let aux = fun code (_ , b) ->
|
|
||||||
match b with
|
|
||||||
| false -> seq [dip code ; i_drop]
|
|
||||||
| true -> dip code
|
|
||||||
in
|
|
||||||
List.fold_right' aux (seq []) e_lst in
|
|
||||||
|
|
||||||
ok code
|
|
||||||
|
|
||||||
let select_env : environment -> environment -> michelson result = fun source filter ->
|
|
||||||
let lst = Environment.get_names filter in
|
|
||||||
select source lst
|
|
||||||
|
|
||||||
let clear : environment -> (michelson * environment) result = fun e ->
|
|
||||||
let lst = Environment.get_names e in
|
|
||||||
let%bind first_name =
|
|
||||||
trace_option (simple_error "try to clear empty env") @@
|
|
||||||
List.nth_opt lst 0 in
|
|
||||||
let%bind code = select ~rev:true e [ first_name ] in
|
|
||||||
let e' = Environment.select ~rev:true [ first_name ] e in
|
|
||||||
ok (code , e')
|
|
||||||
|
|
||||||
let pack : environment -> michelson result = fun e ->
|
|
||||||
let%bind () =
|
|
||||||
trace_strong (simple_error "pack empty env") @@
|
|
||||||
Assert.assert_true (List.length e <> 0) in
|
|
||||||
let code = seq @@ List.map (Function.constant i_pair) @@ List.tl e in
|
|
||||||
|
|
||||||
ok code
|
|
||||||
|
|
||||||
let unpack : environment -> michelson result = fun e ->
|
|
||||||
let%bind () =
|
|
||||||
trace_strong (simple_error "unpack empty env") @@
|
|
||||||
Assert.assert_true (List.length e <> 0) in
|
|
||||||
|
|
||||||
let l = List.length e - 1 in
|
|
||||||
let rec aux n =
|
|
||||||
match n with
|
|
||||||
| 0 -> seq []
|
|
||||||
| n -> seq [
|
|
||||||
i_unpair ;
|
|
||||||
dip (aux (n - 1)) ;
|
|
||||||
] in
|
|
||||||
let code = aux l in
|
|
||||||
|
|
||||||
ok code
|
|
||||||
|
|
||||||
|
|
||||||
let pack_select : environment -> string list -> michelson result = fun e lst ->
|
|
||||||
let module L = Logger.Stateful() in
|
|
||||||
let e_lst =
|
|
||||||
let e_lst = Environment.to_list e in
|
|
||||||
let aux selector (s , _) =
|
|
||||||
L.log @@ Format.asprintf "Selector : %a\n" PP_helpers.(list_sep string (const " , ")) selector ;
|
|
||||||
match List.mem s selector with
|
|
||||||
| true -> List.remove_element s selector , true
|
|
||||||
| false -> selector , false in
|
|
||||||
let e_lst' = List.fold_map_right aux lst e_lst in
|
|
||||||
let e_lst'' = List.combine e_lst e_lst' in
|
|
||||||
e_lst'' in
|
|
||||||
let (_ , code) =
|
|
||||||
let aux = fun (first , code) (_ , b) ->
|
|
||||||
match b with
|
|
||||||
| false -> (first , seq [dip code ; i_swap])
|
|
||||||
| true -> (false ,
|
|
||||||
match first with
|
|
||||||
| true -> i_dup
|
|
||||||
| false -> seq [dip code ; i_dup ; dip i_pair ; i_swap]
|
|
||||||
)
|
|
||||||
in
|
|
||||||
List.fold_right' aux (true , seq []) e_lst in
|
|
||||||
|
|
||||||
ok code
|
|
||||||
|
|
||||||
let add_packed_anon : environment -> type_value -> michelson result = fun _ _ ->
|
|
||||||
let code = seq [i_pair] in
|
|
||||||
|
|
||||||
ok code
|
|
||||||
|
|
||||||
let pop : environment -> environment result = fun e ->
|
|
||||||
match e with
|
|
||||||
| [] -> simple_fail "pop empty env"
|
|
||||||
| _ :: tl -> ok tl
|
|
||||||
|
@ -54,12 +54,6 @@ module Environment (* : ENVIRONMENT *) = struct
|
|||||||
|
|
||||||
let fold : _ -> 'a -> t -> 'a = List.fold_left
|
let fold : _ -> 'a -> t -> 'a = List.fold_left
|
||||||
let filter : _ -> t -> t = List.filter
|
let filter : _ -> t -> t = List.filter
|
||||||
|
|
||||||
let closure_representation : t -> type_value = fun t ->
|
|
||||||
match t with
|
|
||||||
| [] -> T_base Base_unit
|
|
||||||
| [ a ] -> snd a
|
|
||||||
| hd :: tl -> List.fold_left (fun acc cur -> T_pair (acc , snd cur)) (snd hd) tl
|
|
||||||
end
|
end
|
||||||
|
|
||||||
include Environment
|
include Environment
|
||||||
|
Loading…
Reference in New Issue
Block a user