remove 'Access_Map'

src/passes/3-self_ast_simplified/helpers.ml

@@ -8,26 +8,25 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
   match e.expression with
   | E_literal _ | E_variable _ | E_skip -> ok init'
   | E_list lst | E_set lst | E_tuple lst | E_constant (_ , lst) -> (
-    let%bind res' = bind_fold_list self init' lst in
+    let%bind res = bind_fold_list self init' lst in
-    ok res'
+    ok res
   )
   | E_map lst | E_big_map lst -> (
-    let%bind res' = bind_fold_list (bind_fold_pair self) init' lst in
+    let%bind res = bind_fold_list (bind_fold_pair self) init' lst in
-    ok res'
+    ok res
   )
   | E_look_up ab | E_sequence ab | E_loop ab | E_application ab -> (
-      let%bind res' = bind_fold_pair self init' ab in
+      let%bind res = bind_fold_pair self init' ab in
-      ok res'
+      ok res
     )
   | E_lambda { binder = _ ; input_type = _ ; output_type = _ ; result = e }
   | E_annotation (e , _) | E_constructor (_ , e) -> (
-      let%bind res' = self init' e in
+      let%bind res = self init' e in
-      ok res'
+      ok res
     )
-  | E_assign (_ , path , e) | E_accessor (e , path) -> (
+  | E_assign (_ , _path , e) | E_accessor (e , _path) -> (
-      let%bind res' = fold_path f init' path in
+      let%bind res = self init' e in
-      let%bind res' = self res' e in
+      ok res
-      ok res'
     )
   | E_matching (e , cases) -> (
       let%bind res = self init' e in
@@ -36,8 +35,8 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
     )
   | E_record m -> (
     let aux init'' _ expr =
-      let%bind res' = fold_expression self init'' expr in
+      let%bind res = fold_expression self init'' expr in
-      ok res'
+      ok res
     in
     let%bind res = bind_fold_smap aux (ok init') m in
     ok res
@@ -48,16 +47,6 @@ let rec fold_expression : 'a folder -> 'a -> expression -> 'a result = fun f ini
       ok res
     )
 
-and fold_path : 'a folder -> 'a -> access_path -> 'a result = fun f init p -> bind_fold_list (fold_access f) init p
-
-and fold_access : 'a folder -> 'a -> access -> 'a result = fun f init a ->
-  match a with
-  | Access_map e -> (
-      let%bind e' = fold_expression f init e in
-      ok e'
-    )
-  | _ -> ok init
-
 and fold_cases : 'a folder -> 'a -> matching_expr -> 'a result = fun f init m ->
   match m with
   | Match_bool { match_true ; match_false } -> (
@@ -127,8 +116,7 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
     )
   | E_assign (name , path , e) -> (
       let%bind e' = self e in
-      let%bind path' = map_path f path in
+      return @@ E_assign (name , path , e')
-      return @@ E_assign (name , path' , e')
     )
   | E_matching (e , cases) -> (
       let%bind e' = self e in
@@ -137,8 +125,7 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
     )
   | E_accessor (e , path) -> (
       let%bind e' = self e in
-      let%bind path' = map_path f path in
+      return @@ E_accessor (e' , path)
-      return @@ E_accessor (e' , path')
     )
   | E_record m -> (
     let%bind m' = bind_map_smap self m in
@@ -171,15 +158,6 @@ let rec map_expression : mapper -> expression -> expression result = fun f e ->
     )
   | E_literal _ | E_variable _ | E_skip as e' -> return e'
 
-and map_path : mapper -> access_path -> access_path result = fun f p -> bind_map_list (map_access f) p
-
-and map_access : mapper -> access -> access result = fun f a ->
-  match a with
-  | Access_map e -> (
-      let%bind e' = map_expression f e in
-      ok @@ Access_map e'
-    )
-  | a -> ok a
 
 and map_cases : mapper -> matching_expr -> matching_expr result = fun f m ->
   match m with

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

@@ -150,7 +150,6 @@ module Wrap = struct
     (* let t_literal_t   = t *)
     let t_literal_bool   = bool
     let t_literal_string = string
-    let t_access_map     = forall2 "k" "v" @@ fun k v -> map k v --> k --> v
     let t_application    = forall2 "a" "b" @@ fun a b -> (a --> b) --> a --> b
     let t_look_up        = forall2 "ind" "v" @@ fun ind v -> map ind v --> ind --> option v
     let t_sequence       = forall "b" @@ fun b -> unit --> b --> b
@@ -166,20 +165,6 @@ module Wrap = struct
   let access_int ~base ~index = access_label ~base ~label:(L_int index)
   let access_string ~base ~property = access_label ~base ~label:(L_string property)
 
-  let access_map : base:T.type_value -> key:T.type_value -> (constraints * T.type_name) =
-    let mk_map_type key_type element_type =
-      O.P_constant O.(C_map , [P_variable element_type; P_variable key_type]) in
-    fun ~base ~key ->
-      let key_type = Core.fresh_type_variable () in
-      let element_type = Core.fresh_type_variable () in
-      let base' = type_expression_to_type_value base in
-      let key' = type_expression_to_type_value key in
-      let base_expected = mk_map_type key_type element_type in
-      let expr_type = Core.fresh_type_variable () in
-      O.[C_equation (base' , base_expected);
-         C_equation (key' , P_variable key_type);
-         C_equation (P_variable expr_type , P_variable element_type)] , Type_name expr_type
-
   let constructor
     : T.type_value -> T.type_value -> T.type_value -> (constraints * T.type_name)
     = fun t_arg c_arg sum ->

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

@@ -191,15 +191,6 @@ module Errors = struct
     ] in
     error ~data title message ()
 
-  let not_supported_yet (message : string) (ae : I.expression) () =
-    let title = (thunk "not supported yet") in
-    let message () = message in
-    let data = [
-      ("expression" , fun () -> Format.asprintf "%a"  I.PP.expression ae) ;
-      ("location" , fun () -> Format.asprintf "%a" Location.pp ae.location)
-    ] in
-    error ~data title message ()
-
   let not_supported_yet_untranspile (message : string) (ae : O.expression) () =
     let title = (thunk "not supported yet") in
     let message () = message in
@@ -491,14 +482,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e
       let wrapped = Wrap.access_string ~base:base'.type_annotation ~property in
       return_wrapped (E_record_accessor (base' , property)) state' wrapped
     )
-  | E_accessor (base , [Access_map key_ae]) -> (
-      let%bind (base' , state') = type_expression e state base in
-      let%bind (key_ae' , state'') = type_expression e state' key_ae in
-      let xyz = get_type_annotation key_ae' in
-      let wrapped = Wrap.access_map ~base:base'.type_annotation ~key:xyz in
-      return_wrapped (E_look_up (base' , key_ae')) state'' wrapped
-    )
-
   | E_accessor (_base , []) | E_accessor (_base , _ :: _ :: _) -> (
       failwith
         "The simplifier should produce E_accessor with only a single path element, not a list of path elements."
@@ -791,8 +774,6 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_value -> I.e
               Map.String.find_opt property m in
             ok (tv' , prec_path @ [O.Access_record property])
           )
-        | Access_map _ ->
-          fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae
       in
       bind_fold_list aux (typed_name.type_value , []) path in
     let%bind (expr' , state') = type_expression e state expr in

src/passes/4-typer-new/typer.ml.old

@@ -449,13 +449,6 @@ and type_expression : environment -> ?tv_opt:O.type_expression -> I.expression -
               @@ (fun () -> SMap.find property r_tv) in
             return (E_record_accessor (prev , property)) tv
           )
-        | Access_map ae' -> (
-            let%bind ae'' = type_expression e ae' in
-            let%bind (k , v) = get_t_map prev.type_annotation in
-            let%bind () =
-              Ast_typed.assert_type_expression_eq (k , get_type_annotation ae'') in
-            return (E_look_up (prev , ae'')) v
-          )
       in
       trace (simple_info "accessing") @@
       bind_fold_list aux e' path
@@ -725,8 +718,6 @@ and type_expression : environment -> ?tv_opt:O.type_expression -> I.expression -
               Map.String.find_opt property m in
             ok (tv' , prec_path @ [O.Access_record property])
           )
-        | Access_map _ ->
-          fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae
       in
       bind_fold_list aux (typed_name.type_expression , []) path in
     let%bind expr' = type_expression e expr in

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

@@ -191,15 +191,6 @@ module Errors = struct
     ] in
     error ~data title message ()
 
-  let not_supported_yet (message : string) (ae : I.expression) () =
-    let title = (thunk "not suported yet") in
-    let message () = message in
-    let data = [
-      ("expression" , fun () -> Format.asprintf "%a"  I.PP.expression ae) ;
-      ("location" , fun () -> Format.asprintf "%a" Location.pp ae.location)
-    ] in
-    error ~data title message ()
-
   let not_supported_yet_untranspile (message : string) (ae : O.expression) () =
     let title = (thunk "not suported yet") in
     let message () = message in
@@ -450,13 +441,6 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
               @@ (fun () -> SMap.find property r_tv) in
             return (E_record_accessor (prev , property)) tv
           )
-        | Access_map ae' -> (
-            let%bind ae'' = type_expression' e ae' in
-            let%bind (k , v) = bind_map_or (get_t_map , get_t_big_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_info "accessing") @@
       bind_fold_list aux e' path
@@ -758,8 +742,6 @@ and type_expression' : environment -> ?tv_opt:O.type_value -> I.expression -> O.
               Map.String.find_opt property m in
             ok (tv' , prec_path @ [O.Access_record property])
           )
-        | Access_map _ ->
-          fail @@ not_supported_yet "assign expressions with maps are not supported yet" ae
       in
       bind_fold_list aux (typed_name.type_value , []) path in
     let%bind expr' = type_expression' e ~tv_opt:assign_tv expr in

src/passes/6-transpiler/transpiler.ml

@@ -510,7 +510,6 @@ and transpile_annotated_expression (ae:AST.annotated_expression) : expression re
                 (Map.String.find_opt prop ty_map) in
             ok (prop_in_ty_map, acc @ path')
           )
-          | Access_map _k -> fail (corner_case ~loc:__LOC__ "no patch for map yet")
       in
       let%bind (_, path) = bind_fold_right_list aux (ty, []) path in
       let%bind expr' = transpile_annotated_expression expr in

src/stages/ast_simplified/PP.ml

@@ -82,7 +82,6 @@ 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)" expression s
 
 and access_path ppf (p:access_path) =
   fprintf ppf "%a" (list_sep access (const ".")) p

src/stages/ast_simplified/combinators.ml

@@ -148,8 +148,7 @@ let assert_e_accessor = fun t ->
 
 let get_access_record : access -> string result = fun a ->
   match a with
-  | Access_tuple _
+  | Access_tuple _ -> simple_fail "not an access record"
-  | Access_map _ -> simple_fail "not an access record"
   | Access_record s -> ok s
 
 let get_e_pair = fun t ->

src/stages/ast_simplified/types.ml

@@ -81,7 +81,6 @@ and expression = {
 and access =
   | Access_tuple of int
   | Access_record of string
-  | Access_map of expr
 
 and access_path = access list
 

src/stages/ast_typed/PP.ml

@@ -98,7 +98,6 @@ 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
 
 let declaration ppf (d:declaration) =
   match d with

src/stages/ast_typed/types.ml

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