diff --git a/src/ast_simplified/combinators.ml b/src/ast_simplified/combinators.ml index edc8ef449..9fcb96afd 100644 --- a/src/ast_simplified/combinators.ml +++ b/src/ast_simplified/combinators.ml @@ -104,7 +104,7 @@ let e_typed_list ?loc lst t = e_annotation ?loc (e_list lst) (t_list t) let e_typed_map ?loc lst k v = e_annotation ?loc (e_map lst) (t_map k v) - + let e_typed_set ?loc lst k = e_annotation ?loc (e_set lst) (t_set k) let e_lambda ?loc (binder : string) diff --git a/src/compiler/compiler_program.ml b/src/compiler/compiler_program.ml index 6da10d7c5..aa737a071 100644 --- a/src/compiler/compiler_program.ml +++ b/src/compiler/compiler_program.ml @@ -397,13 +397,13 @@ and translate_expression ?push_var_name (expr:expression) (env:environment) : (m ) | "MAP" -> ( let%bind restrict = - let%bind popped = Compiler_environment.pop body_env in - Compiler_environment.select_env popped env in + let%bind popped' = Compiler_environment.pop body_env in + Compiler_environment.select_env popped' popped in let%bind code = ok (seq [ expr' ; - i_map (seq [body' ; restrict]) ; + i_map (seq [body' ; dip restrict]) ; ]) in - return code + return ~prepend_env:popped code ) | s -> ( let error = error (thunk "bad iterator") (thunk s) in diff --git a/src/compiler/uncompiler.ml b/src/compiler/uncompiler.ml index d8855471e..8453c6c5a 100644 --- a/src/compiler/uncompiler.ml +++ b/src/compiler/uncompiler.ml @@ -68,15 +68,11 @@ let rec translate_value (Ex_typed_value (ty, value)) : value result = in ok @@ D_map lst' | (List_t (ty, _)), lst -> - let lst' = - let aux acc cur = cur :: acc in - let lst = List.fold_left aux lst [] in - List.rev lst in - let%bind lst'' = + let%bind lst' = let aux = fun t -> translate_value (Ex_typed_value (ty, t)) in - bind_map_list aux lst' + bind_map_list aux lst in - ok @@ D_list lst'' + ok @@ D_list lst' | (Set_t (ty, _)), (module S) -> ( let lst = S.OPS.elements S.boxed in let lst' = diff --git a/src/contracts/list.ligo b/src/contracts/list.ligo index 503d72ffb..99920b92a 100644 --- a/src/contracts/list.ligo +++ b/src/contracts/list.ligo @@ -27,3 +27,7 @@ function iter_op (const s : list(int)) : int is begin list_iter(s , aggregate) ; end with r + +function map_op (const s : list(int)) : list(int) is + function increment (const i : int) : int is block { skip } with i + 1 + block { skip } with list_map(s , increment) diff --git a/src/main/run_mini_c.ml b/src/main/run_mini_c.ml index 24a38b489..5c8f12e5d 100644 --- a/src/main/run_mini_c.ml +++ b/src/main/run_mini_c.ml @@ -41,5 +41,14 @@ let run_entry ?(debug_michelson = false) ?options (entry:anon_function) (input:v Format.printf "Compiled Input: %a\n" Michelson.pp input_michelson ; ) ; let%bind ex_ty_value = run_aux ?options compiled input_michelson in + if debug_michelson then ( + let (Ex_typed_value (ty , v)) = ex_ty_value in + ignore @@ + let%bind michelson_value = + trace_tzresult_lwt (simple_error "debugging run_mini_c") @@ + Proto_alpha_utils.Memory_proto_alpha.unparse_michelson_data ty v in + Format.printf "Compiled Output: %a\n" Michelson.pp michelson_value ; + ok () + ) ; let%bind (result : value) = Compiler.Uncompiler.translate_value ex_ty_value in ok result diff --git a/src/main/run_simplified.ml b/src/main/run_simplified.ml index 17833d6b3..4faf34aaf 100644 --- a/src/main/run_simplified.ml +++ b/src/main/run_simplified.ml @@ -11,14 +11,17 @@ let run_simplityped match last_declaration with | Declaration_constant (_ , (_ , post_env)) -> post_env in - Typer.type_expression env input in + Typer.type_expression env input in let%bind typed_result = Run_typed.run_typed ?options ~debug_mini_c ~debug_michelson entry program typed_input in let%bind annotated_result = Typer.untype_expression typed_result in ok annotated_result -let evaluate_simplityped ?options (program : Ast_typed.program) (entry : string) +let evaluate_simplityped + ?options + ?(debug_mini_c = false) ?(debug_michelson = false) + (program : Ast_typed.program) (entry : string) : Ast_simplified.expression result = - let%bind typed_result = Run_typed.evaluate_typed ?options entry program in + let%bind typed_result = Run_typed.evaluate_typed ?options ~debug_mini_c ~debug_michelson entry program in let%bind annotated_result = Typer.untype_expression typed_result in ok annotated_result diff --git a/src/main/run_typed.ml b/src/main/run_typed.ml index 4f0ff0f77..788a10406 100644 --- a/src/main/run_typed.ml +++ b/src/main/run_typed.ml @@ -13,12 +13,18 @@ let transpile_value let%bind r = Run_mini_c.run_entry f input in ok r -let evaluate_typed ?options (entry:string) (program:Ast_typed.program) : Ast_typed.annotated_expression result = +let evaluate_typed + ?(debug_mini_c = false) ?(debug_michelson = false) + ?options (entry:string) (program:Ast_typed.program) : Ast_typed.annotated_expression result = trace (simple_error "easy evaluate typed") @@ let%bind result = let%bind mini_c_main = Transpiler.translate_entry program entry in - Run_mini_c.run_entry ?options mini_c_main (Mini_c.Combinators.d_unit) in + (if debug_mini_c then + Format.(printf "Mini_c : %a\n%!" Mini_c.PP.function_ mini_c_main) + ) ; + Run_mini_c.run_entry ?options ~debug_michelson mini_c_main (Mini_c.Combinators.d_unit) + in let%bind typed_result = let%bind typed_main = Ast_typed.get_entry program entry in Transpiler.untranspile result typed_main.type_annotation in diff --git a/src/operators/operators.ml b/src/operators/operators.ml index befd3b961..6a30913f5 100644 --- a/src/operators/operators.ml +++ b/src/operators/operators.ml @@ -80,6 +80,9 @@ module Simplify = struct ("set_remove" , "SET_REMOVE") ; ("set_iter" , "SET_ITER") ; ("list_iter" , "LIST_ITER") ; + ("list_map" , "LIST_MAP") ; + ("map_iter" , "MAP_ITER") ; + ("map_map" , "MAP_MAP") ; ] let type_constants = type_constants @@ -501,7 +504,7 @@ module Typer = struct let%bind (arg , res) = get_t_function body in let%bind key = get_t_list lst in if eq_1 key arg - then ok res + then ok (t_list res ()) else simple_fail "bad list iter" let not_ = typer_1 "NOT" @@ fun elt -> @@ -582,12 +585,14 @@ module Typer = struct map_map ; map_fold ; map_iter ; + map_map ; set_empty ; set_mem ; set_add ; set_remove ; set_iter ; list_iter ; + list_map ; int ; size ; failwith_ ; diff --git a/src/test/integration_tests.ml b/src/test/integration_tests.ml index e79ebdd92..d3f54421e 100644 --- a/src/test/integration_tests.ml +++ b/src/test/integration_tests.ml @@ -356,15 +356,15 @@ let list () : unit result = let lst' = List.map e_int lst in e_typed_list lst' t_int in + let%bind () = + let expected = ez [23 ; 42] in + expect_eq_evaluate program "fb" expected + in let%bind () = let make_input = fun n -> (ez @@ List.range n) in let make_expected = e_nat in expect_eq_n_strict_pos_small program "size_" make_input make_expected in - let%bind () = - let expected = ez [23 ; 42] in - expect_eq_evaluate program "fb" expected - in let%bind () = let expected = ez [144 ; 51 ; 42 ; 120 ; 421] in expect_eq_evaluate program "bl" expected @@ -372,7 +372,13 @@ let list () : unit result = let%bind () = expect_eq program "iter_op" (e_list [e_int 2 ; e_int 4 ; e_int 7]) - (e_int 13) in + (e_int 13) + in + let%bind () = + expect_eq program "map_op" + (e_list [e_int 2 ; e_int 4 ; e_int 7]) + (e_list [e_int 3 ; e_int 5 ; e_int 8]) + in ok () let condition () : unit result = diff --git a/src/test/test_helpers.ml b/src/test/test_helpers.ml index 32f45d4a4..60da8f999 100644 --- a/src/test/test_helpers.ml +++ b/src/test/test_helpers.ml @@ -97,7 +97,7 @@ let expect_evaluate program entry_point expecter = let content () = Format.asprintf "Entry_point: %s" entry_point in error title content in trace error @@ - let%bind result = Ligo.Run.evaluate_simplityped program entry_point in + let%bind result = Ligo.Run.evaluate_simplityped ~debug_mini_c:true ~debug_michelson:true program entry_point in expecter result let expect_eq_evaluate program entry_point expected = diff --git a/src/transpiler/transpiler.ml b/src/transpiler/transpiler.ml index 14b42227a..3aed3edb5 100644 --- a/src/transpiler/transpiler.ml +++ b/src/transpiler/transpiler.ml @@ -409,7 +409,7 @@ and translate_annotated_expression (ae:AST.annotated_expression) : expression re let aux : expression -> expression -> expression result = fun prev cur -> return @@ E_constant ("CONS", [cur ; prev]) in let%bind (init : expression) = return @@ E_make_empty_list t in - bind_fold_list aux init lst' + bind_fold_right_list aux init lst' ) | E_set lst -> ( let%bind t =