more jsonized

src/lib_utils/trace.ml

@@ -175,6 +175,16 @@ let bind_fold_list f init lst =
   in
   List.fold_left aux (ok init) lst
 
+let bind_fold_map_list = fun f acc lst ->
+  let rec aux (acc , prev) f = function
+    | [] -> ok (acc , prev)
+    | hd :: tl ->
+        f acc hd >>? fun (acc' , hd') ->
+        aux (acc' , hd' :: prev) f tl
+  in
+  aux (acc , []) f (List.rev lst) >>? fun (_acc' , lst') ->
+  ok lst'
+
 let bind_fold_right_list f init lst =
   let aux x y =
     x >>? fun x ->

src/lib_utils/x_list.ml

@@ -7,6 +7,16 @@ let map ?(acc = []) f lst =
   in
   aux acc f (List.rev lst)
 
+let fold_map : type acc ele ret . (acc -> ele -> (acc * ret)) -> acc -> ele list -> ret list =
+  fun f acc lst ->
+  let rec aux (acc , prev) f = function
+    | [] -> (acc , prev)
+    | hd :: tl ->
+        let (acc' , hd') = f acc hd in
+        aux (acc' , hd' :: prev) f tl
+  in
+  snd @@ aux (acc , []) f (List.rev lst)
+
 let fold_right' f init lst = List.fold_left f init (List.rev lst)
 
 let filter_map f =

src/ligo/ast_simplified/PP.ml

@@ -50,6 +50,7 @@ and access ppf (a:access) =
   match a with
   | Access_tuple n -> fprintf ppf "%d" n
   | Access_record s -> fprintf ppf "%s" s
+  | Access_map s -> fprintf ppf "(%a)" annotated_expression s
 
 and access_path ppf (p:access_path) =
   fprintf ppf "%a" (list_sep access (const ".")) p

src/ligo/ast_simplified/types.ml

@@ -75,6 +75,7 @@ and expression =
 and access =
   | Access_tuple of int
   | Access_record of string
+  | Access_map of ae
 
 and access_path = access list
 

src/ligo/ast_typed/PP.ml

@@ -87,6 +87,7 @@ and matching : type a . (formatter -> a -> unit) -> _ -> a matching -> unit = fu
 and pre_access ppf (a:access) = match a with
   | Access_record n -> fprintf ppf ".%s" n
   | Access_tuple i -> fprintf ppf ".%d" i
+  | Access_map n -> fprintf ppf ".%a" annotated_expression n
 
 and instruction ppf (i:instruction) = match i with
   | I_skip -> fprintf ppf "skip"

src/ligo/ast_typed/types.ml

@@ -119,9 +119,12 @@ and instruction =
   | I_skip
   | I_patch of named_type_value * access_path * ae
 
-and access = Ast_simplified.access
+and access =
+  | Access_tuple of int
+  | Access_record of string
+  | Access_map of ae
 
-and access_path = Ast_simplified.access_path
+and access_path = access list
 
 and 'a matching =
   | Match_bool of {

src/ligo/transpiler/transpiler.ml

@@ -137,6 +137,7 @@ and translate_instruction (env:Environment.t) (i:AST.instruction) : statement li
             let%bind (_, path) = record_access_to_lr ty' ty'_map prop in
             let path' = List.map snd path in
             ok (Map.String.find prop ty_map, path' @ acc)
+        | Access_map _k -> simple_fail "no patch for map yet"
       in
       let%bind (_, path) = bind_fold_list aux (ty, []) s in
       let%bind v' = translate_annotated_expression env v in

src/ligo/typer/typer.ml

@@ -159,15 +159,24 @@ and type_instruction (e:environment) : I.instruction -> (environment * O.instruc
           match access with
           | I.Access_record s ->
               let%bind m = O.Combinators.get_t_record ty in
+              let%bind ty =
                 trace_option (simple_error "unbound record access in record_patch") @@
-              Map.String.find_opt s m
-          | Access_tuple i ->
+                Map.String.find_opt s m in
+              ok (ty , O.Access_record s)
+          | I.Access_tuple i ->
               let%bind t = O.Combinators.get_t_tuple ty in
+              let%bind ty =
                 generic_try (simple_error "unbound tuple access in record_patch") @@
-              (fun () -> List.nth t i)
+                (fun () -> List.nth t i) in
+              ok (ty , O.Access_tuple i)
+          | I.Access_map ind ->
+              let%bind (k , v) = O.Combinators.get_t_map ty in
+              let%bind ind' = type_annotated_expression e ind in
+              let%bind () = Ast_typed.assert_type_value_eq (get_type_annotation ind' ,  k) in
+              ok (v , O.Access_map ind')
         in
-        let%bind _assert = bind_fold_list aux ty.type_value (path @ [Access_record s]) in
-        ok @@ O.I_patch (tv, path @ [Access_record s], ae')
+        let%bind path' = bind_fold_map_list aux ty.type_value (path @ [Access_record s]) in
+        ok @@ O.I_patch (tv, path' @ [Access_record s], ae')
       in
       let%bind lst' = bind_map_list aux lst in
       ok (e, lst')
@@ -351,6 +360,13 @@ and type_annotated_expression : environment -> I.annotated_expression -> O.annot
               @@ (fun () -> SMap.find property r_tv) in
             return (E_record_accessor (prev , property)) tv
           )
+        | Access_map ae -> (
+            let%bind ae' = type_annotated_expression e ae in
+            let%bind (k , v) = get_t_map prev.type_annotation in
+            let%bind () =
+              Ast_typed.assert_type_value_eq (k , get_type_annotation ae') in
+            return (E_look_up (prev , ae')) v
+          )
       in
       trace (simple_error "accessing") @@
       bind_fold_list aux e' path
@@ -643,8 +659,19 @@ and untype_instruction (i:O.instruction) : (I.instruction) result =
         List.rev_uncons_opt p in
       let%bind tl_name = match tl with
         | Access_record n -> ok n
-        | Access_tuple _ -> simple_fail "last element of patch is tuple" in
-      ok @@ I_record_patch (s.type_name, hds, [tl_name, e'])
+        | Access_tuple _ -> simple_fail "last element of patch is tuple"
+        | Access_map _ -> simple_fail "last element of patch is map"
+      in
+      let%bind hds' = bind_map_list untype_access hds in
+      ok @@ I_record_patch (s.type_name, hds', [tl_name, e'])
+
+and untype_access (a:O.access) : I.access result =
+  match a with
+  | Access_record n -> ok @@ I.Access_record n
+  | Access_tuple n -> ok @@ I.Access_tuple n
+  | Access_map n ->
+      let%bind n' = untype_annotated_expression n in
+      ok @@ I.Access_map n'
 
 and untype_matching : type o i . (o -> i result) -> o O.matching -> (i I.matching) result = fun f m ->
   let open I in