diff --git a/src/contracts/big_map.ligo b/src/contracts/big_map.ligo index 2eb21153e..e05d23899 100644 --- a/src/contracts/big_map.ligo +++ b/src/contracts/big_map.ligo @@ -1,18 +1,11 @@ -// type storage_ is big_map(int, int) * unit -type storage_ is big_map(int, int) - -// function main(const p : unit; const s : storage_) : list(operation) * storage_ is -// block { skip } -// with ((nil : list(operation)), s) +// type storage_ is big_map(int, int) +type storage_ is big_map(int, int) * unit function main(const p : unit; const s : storage_) : list(operation) * storage_ is - // var r : big_map(int, int) := s.0 ; - var r : big_map(int,int) := s ; + var r : big_map(int, int) := s.0 ; var toto : option (int) := Some(0); block { - // r[23] := 2; toto := r[23]; - s := r; - // skip + s.0 := r; } with ((nil: list(operation)), s) \ No newline at end of file diff --git a/src/operators/operators.ml b/src/operators/operators.ml index 61495e0e9..d08a535eb 100644 --- a/src/operators/operators.ml +++ b/src/operators/operators.ml @@ -592,7 +592,11 @@ module Typer = struct map_map ; map_fold ; map_iter ; - map_map ; + big_map_remove ; + big_map_add ; + big_map_update ; + big_map_mem ; + big_map_find ; set_empty ; set_mem ; set_add ; diff --git a/src/transpiler/transpiler.ml b/src/transpiler/transpiler.ml index a2119fe19..7f63fc378 100644 --- a/src/transpiler/transpiler.ml +++ b/src/transpiler/transpiler.ml @@ -58,6 +58,15 @@ them. please report this to the developers." in ] in error ~data title content + let bad_big_map location = + let title () = "bad arguments for main" in + let content () = "only one big_map per program which must appear + on the left hand side of a pair in the contract's storage" in + let data = [ + ("location" , fun () -> Format.asprintf "%a" Location.pp location) ; + ] in + error ~data title content + let missing_entry_point name = let title () = "missing entry point" in let content () = "no entry point with the given name" in @@ -601,10 +610,36 @@ let translate_program (lst:AST.program) : program result = let%bind (statements, _) = List.fold_left aux (ok ([], Environment.empty)) (temp_unwrap_loc_list lst) in ok statements +(* check whether the storage contains a big_map, if yes, check that + it appears on the left hand side of a pair *) +let check_storage f ty loc : (anon_function * _) result = + let rec aux (t:type_value) on_big_map = + match t with + | T_big_map _ -> on_big_map + | T_pair (a , b) -> (aux a true) && (aux b false) + | T_or (a,b) -> (aux a false) && (aux b false) + | T_function (a,b) -> (aux a false) && (aux b false) + | T_deep_closure (_,a,b) -> (aux a false) && (aux b false) + | T_map (a,b) -> (aux a false) && (aux b false) + | T_list a -> (aux a false) + | T_set a -> (aux a false) + | T_contract a -> (aux a false) + | T_option a -> (aux a false) + | _ -> true + in + match f.result.type_value with + | T_pair (_, storage) -> + if aux storage false then ok (f, ty) else fail @@ bad_big_map loc + | _ -> ok (f, ty) + +(* let translate_main (l:AST.lambda) loc : anon_function result = + let%bind expr = translate_lambda Environment.empty l in + match Combinators.Expression.get_content expr with + | E_literal (D_function f) -> check_storage f loc *) let translate_main (l:AST.lambda) loc : (anon_function * _) result = let%bind expr = translate_lambda Environment.empty l in match expr.content , expr.type_value with - | E_literal (D_function f) , T_function ty -> ok (f , ty) + | E_literal (D_function f) , T_function ty -> check_storage f ty loc | _ -> fail @@ not_functional_main loc (* From an expression [expr], build the expression [fun () -> expr] *)