File 5223-dialyzer_dataflow-Use-the-map-syntax-instead-of-the-.patch of Package erlang
From 22de1a197fa672dbab68957d0eaff1c00a421f65 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Bj=C3=B6rn=20Gustavsson?= <bjorn@erlang.org>
Date: Thu, 3 Nov 2022 15:06:01 +0100
Subject: [PATCH 3/3] dialyzer_dataflow: Use the map syntax instead of the maps
module
---
lib/dialyzer/src/dialyzer_dataflow.erl | 52 +++++++++++++-------------
1 file changed, 27 insertions(+), 25 deletions(-)
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index 53eacb0625..bb77ea972f 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -1784,8 +1784,13 @@ bind_guard(Guard, Map, Env, Eval, State) ->
{Map, Type};
var ->
?debug("Looking for var(~w)...", [cerl_trees:get_label(Guard)]),
- case maps:find(get_label(Guard), Env) of
- error ->
+ GuardLabel = get_label(Guard),
+ case Env of
+ #{GuardLabel := Tree} ->
+ ?debug("Found it\n", []),
+ {Map1, Type} = bind_guard(Tree, Map, Env, Eval, State),
+ {enter_type(Guard, Type, Map1), Type};
+ #{} ->
?debug("Did not find it\n", []),
Type = lookup_type(Guard, Map),
Constr =
@@ -1795,11 +1800,7 @@ bind_guard(Guard, Map, Env, Eval, State)
dont_know -> Type
end,
Inf = t_inf(Constr, Type),
- {enter_type(Guard, Inf, Map), Inf};
- {ok, Tree} ->
- ?debug("Found it\n", []),
- {Map1, Type} = bind_guard(Tree, Map, Env, Eval, State),
- {enter_type(Guard, Type, Map1), Type}
+ {enter_type(Guard, Inf, Map), Inf}
end;
call ->
handle_guard_call(Guard, Map, Env, Eval, State)
@@ -2710,19 +2711,19 @@ enter_type(Key, Val, MS) ->
false ->
#map{map = Map, subst = Subst} = MS,
KeyLabel = get_label(Key),
- case maps:find(KeyLabel, Subst) of
- {ok, NewKey} ->
+ case Subst of
+ #{KeyLabel := NewKey} ->
?debug("Binding ~p to ~p\n", [KeyLabel, NewKey]),
enter_type(NewKey, Val, MS);
- error ->
+ #{} ->
?debug("Entering ~p :: ~ts\n", [KeyLabel, t_to_string(Val)]),
- case maps:find(KeyLabel, Map) of
- {ok, Value} ->
+ case Map of
+ #{KeyLabel := Value} ->
case erl_types:t_is_equal(Val, Value) of
true -> MS;
false -> store_map(KeyLabel, Val, MS)
end;
- error -> store_map(KeyLabel, Val, MS)
+ #{} -> store_map(KeyLabel, Val, MS)
end
end
end
@@ -2731,7 +2732,7 @@ enter_type(Key, Val, MS) ->
store_map(Key, Val, #map{map = Map, ref = undefined} = MapRec) ->
MapRec#map{map = maps:put(Key, Val, Map)};
store_map(Key, Val, #map{map = Map, modified = Mod} = MapRec) ->
- MapRec#map{map = maps:put(Key, Val, Map), modified = [Key | Mod]}.
+ MapRec#map{map = Map#{Key => Val}, modified = [Key | Mod]}.
enter_subst(Key, Val0, #map{subst = Subst} = MS) ->
KeyLabel = get_label(Key),
@@ -2744,10 +2745,10 @@ enter_subst(Key, Val0, #map{subst = Subst} = MS) ->
false -> MS;
true ->
ValLabel = get_label(Val),
- case maps:find(ValLabel, Subst) of
- {ok, NewVal} ->
+ case Subst of
+ #{ValLabel := NewVal} ->
enter_subst(Key, NewVal, MS);
- error ->
+ #{} ->
if KeyLabel =:= ValLabel -> MS;
true ->
?debug("Subst: storing ~p = ~p\n", [KeyLabel, ValLabel]),
@@ -2760,7 +2761,7 @@ enter_subst(Key, Val0, #map{subst = Subst} = MS) ->
store_subst(Key, Val, #map{subst = S, ref = undefined} = Map) ->
Map#map{subst = maps:put(Key, Val, S)};
store_subst(Key, Val, #map{subst = S, modified = Mod} = Map) ->
- Map#map{subst = maps:put(Key, Val, S), modified = [Key | Mod]}.
+ Map#map{subst = S#{Key => Val}, modified = [Key | Mod]}.
lookup_type(Key, #map{map = Map, subst = Subst}) ->
lookup(Key, Map, Subst, t_none()).
@@ -2770,13 +2771,14 @@ lookup(Key, Map, Subst, AnyNone) ->
true -> literal_type(Key);
false ->
Label = get_label(Key),
- case maps:find(Label, Subst) of
- {ok, NewKey} -> lookup(NewKey, Map, Subst, AnyNone);
- error ->
- case maps:find(Label, Map) of
- {ok, Val} -> Val;
- error -> AnyNone
- end
+ case Subst of
+ #{Label := NewKey} ->
+ lookup(NewKey, Map, Subst, AnyNone);
+ #{} ->
+ case Map of
+ #{Label := Val} -> Val;
+ #{} -> AnyNone
+ end
end
end.
--
2.35.3