add type map_or_big_map to solve issue of typing big_map_empty from map_add

src/bin/expect_tests/ligo_interpreter_tests.ml

@@ -43,12 +43,12 @@ let%expect_test _ =
     val map_finds = Some(2 : int)
     val map_finds_fail = "failed map find" : failure
     val map_empty = {  ; 0 = ([]) ; 1 = ([]) }
-    val m = [ ; "one" : string -> 1 : int ; "two" : string -> 2 : int ; "three" : string -> 3 : int]
+    val m = [ ; "one" : string -> 1 : int ; "three" : string -> 3 : int ; "two" : string -> 2 : int]
     val map_fold = 4 : int
     val map_iter = unit
-    val map_map = [ ; "one" : string -> 4 : int ; "two" : string -> 5 : int ; "three" : string -> 8 : int]
+    val map_map = [ ; "one" : string -> 4 : int ; "three" : string -> 8 : int ; "two" : string -> 5 : int]
     val map_mem = {  ; 0 = (true) ; 1 = (false) }
-    val map_remove = {  ; 0 = ([ ; "two" : string -> 2 : int ; "three" : string -> 3 : int]) ; 1 = ([ ; "one" : string -> 1 : int ; "two" : string -> 2 : int ; "three" : string -> 3 : int]) }
+    val map_remove = {  ; 0 = ([ ; "three" : string -> 3 : int ; "two" : string -> 2 : int]) ; 1 = ([ ; "one" : string -> 1 : int ; "three" : string -> 3 : int ; "two" : string -> 2 : int]) }
     val map_update = {  ; 0 = ([ ; "one" : string -> 1 : int]) ; 1 = ([]) ; 2 = ([]) ; 3 = ([ ; "one" : string -> 1 : int]) }
     val s = { ; 1 : int ; 2 : int ; 3 : int}
     val set_add = {  ; 0 = ({ ; 1 : int ; 2 : int ; 3 : int}) ; 1 = ({ ; 1 : int ; 2 : int ; 3 : int ; 4 : int}) ; 2 = ({ ; 1 : int}) }

src/passes/10-interpreter/interpreter.ml

@@ -171,6 +171,7 @@ let rec apply_operator : Ast_typed.constant' -> value list -> value result =
           eval body env'
         )
         init elts
+    | ( C_MAP_EMPTY , []) -> ok @@ V_Map ([])
     | ( C_MAP_FOLD , [ V_Func_val (arg_name, body, env) ; V_Map kvs ; init ] ) ->
       bind_fold_list
         (fun prev kv ->

src/passes/10-transpiler/transpiler.ml

@@ -141,6 +141,8 @@ let rec transpile_type (t:AST.type_expression) : type_value result =
   | T_operator (TC_big_map (key,value)) ->
       let%bind kv' = bind_map_pair transpile_type (key, value) in
       ok (T_big_map kv')
+  | T_operator (TC_map_or_big_map (_,_)) ->
+      fail @@ corner_case ~loc:"transpiler" "TC_map_or_big_map should be resolve before transpilation"
   | T_operator (TC_list t) ->
       let%bind t' = transpile_type t in
       ok (T_list t')

src/passes/10-transpiler/untranspiler.ml

@@ -160,30 +160,32 @@ let rec untranspile (v : value) (t : AST.type_expression) : AST.expression resul
             let%bind v' = untranspile v v_ty in
             ok (k', v') in
           bind_map_list aux map in
+        let map' = List.sort_uniq compare map' in
         let aux = fun prev (k, v) ->
           let (k', v') = (k , v ) in
           return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
         in
         let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
-        bind_fold_list aux init map'
+        bind_fold_right_list aux init map'
       )
     | TC_big_map (k_ty, v_ty) -> (
-        let%bind map =
+        let%bind big_map =
           trace_strong (wrong_mini_c_value "big_map" v) @@
           get_big_map v in
-        let%bind map' =
+        let%bind big_map' =
           let aux = fun (k, v) ->
             let%bind k' = untranspile k k_ty in
             let%bind v' = untranspile v v_ty in
             ok (k', v') in
-          bind_map_list aux map in
+          bind_map_list aux big_map in
-        let map' = List.sort_uniq compare map' in
+        let big_map' = List.sort_uniq compare big_map' in
         let aux = fun prev (k, v) ->
           return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k ; v ; prev]}
         in
-        let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
+        let%bind init = return @@ E_constant {cons_name=C_BIG_MAP_EMPTY;arguments=[]} in
-        bind_fold_list aux init map'
+        bind_fold_right_list aux init big_map'
       )
+    | TC_map_or_big_map (_, _) -> fail @@ corner_case ~loc:"untranspiler" "should not be present in mini-c"
     | TC_list ty -> (
         let%bind lst =
           trace_strong (wrong_mini_c_value "list" v) @@

src/passes/4-imperative_to_sugar/imperative_to_sugar.ml

@@ -154,6 +154,9 @@ and compile_type_operator : I.type_operator -> O.type_operator result =
     | TC_big_map (k,v) ->
       let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in
       ok @@ O.TC_big_map (k,v)
+    | TC_map_or_big_map (k,v) ->
+      let%bind (k,v) = bind_map_pair compile_type_expression (k,v) in
+      ok @@ O.TC_map_or_big_map (k,v)
     | TC_arrow (i,o) ->
       let%bind (i,o) = bind_map_pair compile_type_expression (i,o) in
       ok @@ O.TC_arrow (i,o)
@@ -569,6 +572,9 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
     | TC_big_map (k,v) ->
       let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
       ok @@ I.TC_big_map (k,v)
+    | TC_map_or_big_map (k,v) ->
+      let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
+      ok @@ I.TC_map_or_big_map (k,v)
     | TC_arrow (i,o) ->
       let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
       ok @@ I.TC_arrow (i,o)

src/passes/6-sugar_to_core/sugar_to_core.ml

@@ -55,6 +55,9 @@ and idle_type_operator : I.type_operator -> O.type_operator result =
     | TC_big_map (k,v) ->
       let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in
       ok @@ O.TC_big_map (k,v)
+    | TC_map_or_big_map (k,v) ->
+      let%bind (k,v) = bind_map_pair idle_type_expression (k,v) in
+      ok @@ O.TC_map_or_big_map (k,v)
     | TC_arrow (i,o) ->
       let%bind (i,o) = bind_map_pair idle_type_expression (i,o) in
       ok @@ O.TC_arrow (i,o)
@@ -115,16 +118,16 @@ let rec compile_expression : I.expression -> O.expression result =
         return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
       in
       let%bind init = return @@ E_constant {cons_name=C_MAP_EMPTY;arguments=[]} in
-      bind_fold_list aux init map
+      bind_fold_right_list aux init map
     )
     | I.E_big_map big_map -> (
-      let map = List.sort_uniq compare big_map in
+      let big_map = List.sort_uniq compare big_map in
       let aux = fun prev (k, v) ->
         let%bind (k', v') = bind_map_pair (compile_expression) (k, v) in
-        return @@ E_constant {cons_name=C_BIG_MAP_ADD;arguments=[k' ; v' ; prev]}
+        return @@ E_constant {cons_name=C_MAP_ADD;arguments=[k' ; v' ; prev]}
       in
       let%bind init = return @@ E_constant {cons_name=C_BIG_MAP_EMPTY;arguments=[]} in
-      bind_fold_list aux init map
+      bind_fold_right_list aux init big_map
     )
     | I.E_list lst ->
       let%bind lst' = bind_map_list (compile_expression) lst in
@@ -258,6 +261,9 @@ and uncompile_type_operator : O.type_operator -> I.type_operator result =
     | TC_big_map (k,v) ->
       let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
       ok @@ I.TC_big_map (k,v)
+    | TC_map_or_big_map (k,v) ->
+      let%bind (k,v) = bind_map_pair uncompile_type_expression (k,v) in
+      ok @@ I.TC_map_or_big_map (k,v)
     | TC_arrow (i,o) ->
       let%bind (i,o) = bind_map_pair uncompile_type_expression (i,o) in
       ok @@ I.TC_arrow (i,o)

src/passes/8-typer-new/solver.ml

@@ -70,6 +70,7 @@ module Wrap = struct
           | TC_set s               -> (C_set, [s])
           | TC_map ( k , v )       -> (C_map, [k;v])
           | TC_big_map ( k , v)    -> (C_big_map, [k;v])
+          | TC_map_or_big_map ( k , v)    -> (C_map, [k;v])
           | TC_arrow ( arg , ret ) -> (C_arrow, [ arg ; ret ])
           | TC_list l              -> (C_list, [l])
           | TC_contract c          -> (C_contract, [c])
@@ -103,6 +104,7 @@ module Wrap = struct
           | TC_set  s              -> (C_set    , [s])
           | TC_map  ( k , v )      -> (C_map    , [k;v])
           | TC_big_map  ( k , v )  -> (C_big_map, [k;v])
+          | TC_map_or_big_map ( k , v)    -> (C_map, [k;v])
           | TC_contract c          -> (C_contract, [c])
           | TC_arrow ( arg , ret ) -> (C_arrow, [ arg ; ret ])
       )

src/passes/8-typer-new/typer.ml

@@ -345,6 +345,10 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
             let%bind k = evaluate_type e k in 
             let%bind v = evaluate_type e v in 
             ok @@ O.TC_big_map (k,v) 
+        | TC_map_or_big_map (k,v) ->
+            let%bind k = evaluate_type e k in 
+            let%bind v = evaluate_type e v in 
+            ok @@ O.TC_map_or_big_map (k,v) 
         | TC_contract c ->
             let%bind c = evaluate_type e c in
             ok @@ O.TC_contract c
@@ -837,6 +841,10 @@ let rec untype_type_expression (t:O.type_expression) : (I.type_expression) resul
          let%bind k = untype_type_expression k in
          let%bind v = untype_type_expression v in
          ok @@ I.TC_big_map (k,v)
+      | O.TC_map_or_big_map (k,v) ->     
+         let%bind k = untype_type_expression k in
+         let%bind v = untype_type_expression v in
+         ok @@ I.TC_map_or_big_map (k,v)
       | O.TC_arrow ( arg , ret ) ->
          let%bind arg' = untype_type_expression arg in
          let%bind ret' = untype_type_expression ret in

src/passes/8-typer-old/typer.ml

@@ -381,6 +381,10 @@ and evaluate_type (e:environment) (t:I.type_expression) : O.type_expression resu
             let%bind k = evaluate_type e k in 
             let%bind v = evaluate_type e v in 
             ok @@ O.TC_big_map (k,v) 
+        | TC_map_or_big_map (k,v) ->
+            let%bind k = evaluate_type e k in 
+            let%bind v = evaluate_type e v in 
+            ok @@ O.TC_map_or_big_map (k,v) 
         | TC_arrow ( arg , ret ) ->
             let%bind arg' = evaluate_type e arg in
             let%bind ret' = evaluate_type e ret in
@@ -602,21 +606,7 @@ and type_expression' : environment -> ?tv_opt:O.type_expression -> I.expression
       let tv_val = get_type_expression val' in
       let tv = match tv_opt with 
           Some (tv) -> tv 
-        | None -> t_map tv_key tv_val ()
+        | None -> t_map_or_big_map tv_key tv_val ()
-      in
-      let%bind map' =  type_expression' e ~tv_opt:tv map in
-      let tv_map = get_type_expression map' in 
-      let tv_lst = [tv_key;tv_val;tv_map] in
-      let%bind (name', tv) = type_constant cst tv_lst tv_opt in
-      return (E_constant {cons_name=name';arguments=[key';val';map']}) tv
-  | E_constant {cons_name=C_BIG_MAP_ADD as cst; arguments=[key;value;map]} ->
-      let%bind key' = type_expression' e key in
-      let%bind val' = type_expression' e value in
-      let tv_key = get_type_expression key' in
-      let tv_val = get_type_expression val' in
-      let tv = match tv_opt with 
-          Some (tv) -> tv 
-        | None -> t_big_map tv_key tv_val ()
       in
       let%bind map' =  type_expression' e ~tv_opt:tv map in
       let tv_map = get_type_expression map' in 

src/passes/operators/operators.ml

@@ -624,7 +624,16 @@ module Typer = struct
   let map_empty = typer_0 "MAP_EMPTY" @@ fun tv_opt ->
     match tv_opt with
     | None -> simple_fail "untyped MAP_EMPTY"
-    | Some t -> ok t
+    | Some t -> 
+      let%bind (src, dst) = get_t_map t in
+      ok @@ t_map src dst ()
+
+  let big_map_empty = typer_0 "BIG_MAP_EMPTY" @@ fun tv_opt ->
+    match tv_opt with
+    | None -> simple_fail "untyped BIG_MAP_EMPTY"
+    | Some t -> 
+      let%bind (src, dst) = get_t_big_map t in
+      ok @@ t_big_map src dst ()
 
   let map_add : typer = typer_3 "MAP_ADD" @@ fun k v m ->
     let%bind (src, dst) = bind_map_or (get_t_map , get_t_big_map) m in
@@ -1171,6 +1180,7 @@ module Typer = struct
     | C_LIST_FOLD           -> ok @@ list_fold ;
     (* MAP *)
     | C_MAP_EMPTY           -> ok @@ map_empty ;
+    | C_BIG_MAP_EMPTY       -> ok @@ big_map_empty ;
     | C_MAP_ADD             -> ok @@ map_add ;
     | C_MAP_REMOVE          -> ok @@ map_remove ;
     | C_MAP_UPDATE          -> ok @@ map_update ;

src/stages/4-ast_typed/combinators.ml

@@ -64,6 +64,7 @@ let t_pair a b ?s ()   : type_expression = ez_t_record [(Label "0",a) ; (Label "
 
 let t_map key value ?s () = make_t (T_operator (TC_map (key , value))) s
 let t_big_map key value ?s () = make_t (T_operator (TC_big_map (key , value))) s
+let t_map_or_big_map key value ?s () = make_t (T_operator (TC_map_or_big_map (key,value))) s
 
 let t_sum m ?s () : type_expression = make_t (T_sum m) s
 let make_t_ez_sum (lst:(constructor' * type_expression) list) : type_expression =
@@ -190,11 +191,13 @@ let get_t_record (t:type_expression) : type_expression label_map result = match
 let get_t_map (t:type_expression) : (type_expression * type_expression) result =
   match t.type_content with
   | T_operator (TC_map (k,v)) -> ok (k, v)
+  | T_operator (TC_map_or_big_map (k,v)) -> ok (k, v)
   | _ -> fail @@ Errors.not_a_x_type "map" t ()
 
 let get_t_big_map (t:type_expression) : (type_expression * type_expression) result =
   match t.type_content with
   | T_operator (TC_big_map (k,v)) -> ok (k, v)
+  | T_operator (TC_map_or_big_map (k,v)) -> ok (k, v)
   | _ -> fail @@ Errors.not_a_x_type "big_map" t ()
 
 let get_t_map_key : type_expression -> type_expression result = fun t ->

src/stages/4-ast_typed/combinators.mli

@@ -31,6 +31,7 @@ val ez_t_record : ( label * type_expression ) list -> ?s:S.type_expression -> un
 
 val t_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
 val t_big_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
+val t_map_or_big_map : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression
 val t_sum : type_expression constructor_map -> ?s:S.type_expression -> unit -> type_expression
 val make_t_ez_sum : ( constructor' * type_expression ) list -> type_expression
 val t_function : type_expression -> type_expression -> ?s:S.type_expression -> unit -> type_expression

src/stages/4-ast_typed/misc.ml

@@ -338,10 +338,11 @@ let rec assert_type_expression_eq (a, b: (type_expression * type_expression)) :
       | TC_list la, TC_list lb
       | TC_contract la, TC_contract lb
       | TC_set la, TC_set lb -> ok @@ ([la], [lb])
-      | TC_map (ka,va), TC_map (kb,vb)
+      | (TC_map (ka,va) | TC_map_or_big_map (ka,va)), (TC_map (kb,vb) | TC_map_or_big_map (kb,vb))
-      | TC_big_map (ka,va), TC_big_map (kb,vb) -> ok @@ ([ka;va] ,[kb;vb]) 
+      | (TC_big_map (ka,va) | TC_map_or_big_map (ka,va)), (TC_big_map (kb,vb) | TC_map_or_big_map (kb,vb))
-      | (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_arrow _),
+       -> ok @@ ([ka;va] ,[kb;vb]) 
-        (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_arrow _ ) -> fail @@ different_operators opa opb
+      | (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ | TC_arrow _),
+        (TC_option _ | TC_list _ | TC_contract _ | TC_set _ | TC_map _ | TC_big_map _ | TC_map_or_big_map _ | TC_arrow _ ) -> fail @@ different_operators opa opb
       in
       if List.length lsta <> List.length lstb then
         fail @@ different_operator_number_of_arguments opa opb (List.length lsta) (List.length lstb)

src/stages/5-mini_c/PP.ml

@@ -217,7 +217,6 @@ and constant ppf : constant' -> unit = function
   | C_MAP_FIND_OPT          -> fprintf ppf "MAP_FIND_OP"
   (* Big Maps *)
   | C_BIG_MAP               -> fprintf ppf "BIG_MAP"
-  | C_BIG_MAP_ADD           -> fprintf ppf "BIG_MAP_ADD"
   | C_BIG_MAP_EMPTY         -> fprintf ppf "BIG_MAP_EMPTY"
   | C_BIG_MAP_LITERAL       -> fprintf ppf "BIG_MAP_LITERAL"
   (* Crypto *)

src/stages/common/PP.ml

@@ -127,7 +127,6 @@ let constant ppf : constant' -> unit = function
   | C_MAP_FIND_OPT          -> fprintf ppf "MAP_FIND_OP"
   (* Big Maps *)
   | C_BIG_MAP               -> fprintf ppf "BIG_MAP"
-  | C_BIG_MAP_ADD           -> fprintf ppf "BIG_MAP_ADD"
   | C_BIG_MAP_EMPTY         -> fprintf ppf "BIG_MAP_EMPTY"
   | C_BIG_MAP_LITERAL       -> fprintf ppf "BIG_MAP_LITERAL"
   (* Crypto *)
@@ -266,6 +265,7 @@ module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
       | TC_set te -> Format.asprintf "set(%a)" f te
       | TC_map (k, v) -> Format.asprintf "Map (%a,%a)" f k f v
       | TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
+      | TC_map_or_big_map (k, v) -> Format.asprintf "Map Or Big Map (%a,%a)" f k f v
       | TC_arrow (k, v) -> Format.asprintf "arrow (%a,%a)" f k f v
       | TC_contract te  -> Format.asprintf "Contract (%a)" f te
     in

src/stages/common/types.ml

@@ -53,6 +53,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
     | TC_set of type_expression
     | TC_map of type_expression * type_expression
     | TC_big_map of type_expression * type_expression
+    | TC_map_or_big_map of type_expression * type_expression
     | TC_arrow of type_expression * type_expression
 
 
@@ -66,6 +67,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
     | TC_set x -> TC_set (f x)
     | TC_map (x , y) -> TC_map (f x , f y)
     | TC_big_map (x , y)-> TC_big_map (f x , f y)
+    | TC_map_or_big_map (x , y)-> TC_map_or_big_map (f x , f y)
     | TC_arrow (x, y) -> TC_arrow (f x, f y)
 
   let bind_map_type_operator f = function
@@ -75,6 +77,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
     | TC_set x -> let%bind x = f x in ok @@ TC_set x
     | TC_map (x , y) -> let%bind x = f x in let%bind y = f y in ok @@ TC_map (x , y)
     | TC_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_big_map (x , y)
+    | TC_map_or_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_map_or_big_map (x , y)
     | TC_arrow (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_arrow (x , y)
 
   let type_operator_name = function
@@ -84,6 +87,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
       | TC_set      _ -> "TC_set"
       | TC_map      _ -> "TC_map"
       | TC_big_map  _ -> "TC_big_map"
+      | TC_map_or_big_map _ -> "TC_map_or_big_map"
       | TC_arrow    _ -> "TC_arrow"
 
   let type_expression'_of_string = function
@@ -122,6 +126,7 @@ module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
     | TC_set       x       -> "TC_set"      , [x]
     | TC_map       (x , y) -> "TC_map"      , [x ; y]
     | TC_big_map   (x , y) -> "TC_big_map"  , [x ; y]
+    | TC_map_or_big_map   (x , y) -> "TC_map_or_big_map"  , [x ; y]
     | TC_arrow     (x , y) -> "TC_arrow"    , [x ; y]
 
   let string_of_type_constant = function
@@ -269,7 +274,6 @@ and constant' =
   | C_MAP_FIND_OPT
   (* Big Maps *)
   | C_BIG_MAP
-  | C_BIG_MAP_ADD
   | C_BIG_MAP_EMPTY
   | C_BIG_MAP_LITERAL
   (* Crypto *)