add map to lists ; fix error with lists

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
+            let%bind popped' = Compiler_environment.pop body_env in
-            Compiler_environment.select_env popped 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

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%bind lst' =
-        let aux acc cur = cur :: acc in
-        let lst = List.fold_left aux lst [] in
-        List.rev lst in
-      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' =

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)

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

src/main/run_simplified.ml

@@ -17,8 +17,11 @@ let run_simplityped
   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

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

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_ ;

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 =

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 =

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 =