diff --git a/src/passes/3-self_ast_simplified/helpers.ml b/src/passes/3-self_ast_simplified/helpers.ml index 04b641f87..7044f3f63 100644 --- a/src/passes/3-self_ast_simplified/helpers.ml +++ b/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 - ok res' + let%bind res = bind_fold_list self init' lst in + ok res ) | E_map lst | E_big_map lst -> ( - let%bind res' = bind_fold_list (bind_fold_pair self) init' lst in - ok res' + let%bind res = bind_fold_list (bind_fold_pair self) init' lst in + 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 - ok res' + let%bind res = bind_fold_pair self init' ab in + ok res ) | E_lambda { binder = _ ; input_type = _ ; output_type = _ ; result = e } | E_annotation (e , _) | E_constructor (_ , e) -> ( - let%bind res' = self init' e in - ok res' + let%bind res = self init' e in + ok res ) - | E_assign (_ , path , e) | E_accessor (e , path) -> ( - let%bind res' = fold_path f init' path in - let%bind res' = self res' e in - ok res' + | E_assign (_ , _path , e) | E_accessor (e , _path) -> ( + let%bind res = self init' e in + 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 - ok res' + let%bind res = fold_expression self init'' expr in + 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 diff --git a/src/passes/4-typer-new/solver.ml b/src/passes/4-typer-new/solver.ml index f134ddf6e..af7a68c38 100644 --- a/src/passes/4-typer-new/solver.ml +++ b/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 -> diff --git a/src/passes/4-typer-new/typer.ml b/src/passes/4-typer-new/typer.ml index 6f7b82eea..ad7edacf9 100644 --- a/src/passes/4-typer-new/typer.ml +++ b/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 diff --git a/src/passes/4-typer-new/typer.ml.old b/src/passes/4-typer-new/typer.ml.old index dfd99cbbe..0e471a081 100644 --- a/src/passes/4-typer-new/typer.ml.old +++ b/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 diff --git a/src/passes/4-typer-old/typer.ml b/src/passes/4-typer-old/typer.ml index 8abdca6db..cc9280531 100644 --- a/src/passes/4-typer-old/typer.ml +++ b/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 diff --git a/src/passes/6-transpiler/transpiler.ml b/src/passes/6-transpiler/transpiler.ml index f8dab5d8e..86bb79f3c 100644 --- a/src/passes/6-transpiler/transpiler.ml +++ b/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 diff --git a/src/stages/ast_simplified/PP.ml b/src/stages/ast_simplified/PP.ml index b99e7e62e..d69dff9ae 100644 --- a/src/stages/ast_simplified/PP.ml +++ b/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 diff --git a/src/stages/ast_simplified/combinators.ml b/src/stages/ast_simplified/combinators.ml index d50df9ba1..48bdbca08 100644 --- a/src/stages/ast_simplified/combinators.ml +++ b/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_map _ -> simple_fail "not an access record" + | Access_tuple _ -> simple_fail "not an access record" | Access_record s -> ok s let get_e_pair = fun t -> diff --git a/src/stages/ast_simplified/types.ml b/src/stages/ast_simplified/types.ml index ca30d42b4..f066b3be2 100644 --- a/src/stages/ast_simplified/types.ml +++ b/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 diff --git a/src/stages/ast_typed/PP.ml b/src/stages/ast_typed/PP.ml index c60eec0dd..930fba72b 100644 --- a/src/stages/ast_typed/PP.ml +++ b/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 diff --git a/src/stages/ast_typed/types.ml b/src/stages/ast_typed/types.ml index ba34c433e..a818463f3 100644 --- a/src/stages/ast_typed/types.ml +++ b/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