Support non top level letrecs in dialyzer

Dialyzer so far only supported letrecs at the top-level
and comprehension-like letrecs (i.e. that were directly applied)
in their body.

This commit address this issue by storing in the callgraph
bound letrec labels pointing to their functions. This information
is then used by the dataflow to properly lookup recursive
definitions.

3 files changed, 45 insertions, 17 deletions

diff --git a/lib/dialyzer/src/dialyzer_callgraph.erl b/lib/dialyzer/src/dialyzer_callgraph.erl
index b9ad3f857d..bc32110751 100644
--- a/lib/dialyzer/src/dialyzer_callgraph.erl
+++ b/lib/dialyzer/src/dialyzer_callgraph.erl
@@ -35,6 +35,7 @@
 	 is_escaping/2,
 	 is_self_rec/2,
 	 non_local_calls/1,
+	 lookup_letrec/2,
 	 lookup_rec_var/2,
 	 lookup_call_site/2,
 	 lookup_label/2,
@@ -81,6 +82,8 @@
 %% digraph	-  A digraph representing the callgraph. 
 %%		   Nodes are represented as MFAs or labels.
 %% esc		-  A set of all escaping functions as reported by dialyzer_dep.
+%% letrec_map	-  A dict mapping from letrec bound labels to function labels.
+%%		   Includes all functions.
 %% name_map	-  A mapping from label to MFA.
 %% rev_name_map	-  A reverse mapping of the name_map.
 %% rec_var_map	-  A dict mapping from letrec bound labels to function names.
@@ -93,6 +96,7 @@
 -record(callgraph, {digraph        = digraph:new() :: digraph(),
 		    active_digraph                 :: active_digraph(),
                     esc	                           :: ets:tid(),
+                    letrec_map                     :: ets:tid(),
                     name_map	                   :: ets:tid(),
                     rev_name_map                   :: ets:tid(),
                     rec_var_map                    :: ets:tid(),
@@ -117,11 +121,12 @@
 -spec new() -> callgraph().
 
 new() ->
-  [ETSEsc, ETSNameMap, ETSRevNameMap, ETSRecVarMap, ETSSelfRec, ETSCalls] =
+  [ETSEsc, ETSNameMap, ETSRevNameMap, ETSRecVarMap, ETSLetrecMap, ETSSelfRec, ETSCalls] =
     [ets:new(N,[public, {read_concurrency, true}]) ||
       N <- [callgraph_esc, callgraph_name_map, callgraph_rev_name_map,
-	    callgraph_rec_var_map, callgraph_self_rec, callgraph_calls]],
+	    callgraph_rec_var_map, callgraph_letrec_map, callgraph_self_rec, callgraph_calls]],
   #callgraph{esc            = ETSEsc,
+	     letrec_map     = ETSLetrecMap,
 	     name_map       = ETSNameMap,
 	     rev_name_map   = ETSRevNameMap,
 	     rec_var_map    = ETSRecVarMap,
@@ -144,6 +149,12 @@ lookup_rec_var(Label, #callgraph{rec_var_map = RecVarMap})
   when is_integer(Label) ->
   ets_lookup_dict(Label, RecVarMap).
 
+-spec lookup_letrec(label(), callgraph()) -> 'error' | {'ok', label()}.
+
+lookup_letrec(Label, #callgraph{letrec_map = LetrecMap})
+  when is_integer(Label) ->
+  ets_lookup_dict(Label, LetrecMap).
+
 -spec lookup_call_site(label(), callgraph()) -> 'error' | {'ok', [_]}. % XXX: refine
 
 lookup_call_site(Label, #callgraph{calls = Calls})
@@ -348,16 +359,18 @@ ets_lookup_set(Key, Table) ->
 
 scan_core_tree(Tree, #callgraph{calls = ETSCalls,
 				esc = ETSEsc,
+				letrec_map = ETSLetrecMap,
 				name_map = ETSNameMap,
 				rec_var_map = ETSRecVarMap,
 				rev_name_map = ETSRevNameMap,
 				self_rec = ETSSelfRec}) ->
   %% Build name map and recursion variable maps.
-  build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap),
+  build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap, ETSLetrecMap),
 
   %% First find the module-local dependencies.
-  {Deps0, EscapingFuns, Calls} = dialyzer_dep:analyze(Tree),
+  {Deps0, EscapingFuns, Calls, Letrecs} = dialyzer_dep:analyze(Tree),
   true = ets:insert(ETSCalls, dict:to_list(Calls)),
+  true = ets:insert(ETSLetrecMap, dict:to_list(Letrecs)),
   true = ets:insert(ETSEsc, [{E} || E <- EscapingFuns]),
 
   LabelEdges = get_edges_from_deps(Deps0),
@@ -394,7 +407,7 @@ scan_core_tree(Tree, #callgraph{calls = ETSCalls,
   NamedEdges3 = NewNamedEdges1 ++ NewNamedEdges2,
   {Names3, NamedEdges3}.
 
-build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap) ->
+build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap, ETSLetrecMap) ->
   %% We only care about the named (top level) functions. The anonymous
   %% functions will be analysed together with their parents. 
   Defs = cerl:module_defs(Tree),
@@ -406,6 +419,7 @@ build_maps(Tree, ETSRecVarMap, ETSNameMap, ETSRevNameMap) ->
 	MFA = {Mod, FunName, Arity},
 	FunLabel = get_label(Function),
 	VarLabel = get_label(Var),
+	true = ets:insert(ETSLetrecMap, {VarLabel, FunLabel}),
 	true = ets:insert(ETSNameMap, {FunLabel, MFA}),
 	true = ets:insert(ETSRevNameMap, {MFA, FunLabel}),
 	true = ets:insert(ETSRecVarMap, {VarLabel, MFA})
diff --git a/lib/dialyzer/src/dialyzer_dataflow.erl b/lib/dialyzer/src/dialyzer_dataflow.erl
index 6956850f1a..922ccad599 100644
--- a/lib/dialyzer/src/dialyzer_dataflow.erl
+++ b/lib/dialyzer/src/dialyzer_dataflow.erl
@@ -308,7 +308,7 @@ traverse(Tree, Map, State) ->
       {State1, Map1, Type};
     var ->
       ?debug("Looking up unknown variable: ~p\n", [Tree]),
-      case state__lookup_type_for_rec_var(Tree, State) of
+      case state__lookup_type_for_letrec(Tree, State) of
 	error ->
 	  LType = lookup_type(Tree, Map),
 	  Opaques = State#state.opaques,
@@ -1468,7 +1468,7 @@ bind_pat_vars([Pat|PatLeft], [Type|TypeLeft], Acc, Map, State, Rev) ->
       var ->
 	Opaques = State#state.opaques,
 	VarType1 =
-	  case state__lookup_type_for_rec_var(Pat, State) of
+	  case state__lookup_type_for_letrec(Pat, State) of
 	    error ->
 	      LType = lookup_type(Pat, Map),
 	      case t_opaque_match_record(LType, Opaques) of
@@ -2829,12 +2829,11 @@ state__get_warnings(#state{tree_map = TreeMap, fun_tab = FunTab,
 state__is_escaping(Fun, #state{callgraph = Callgraph}) ->
   dialyzer_callgraph:is_escaping(Fun, Callgraph).
 
-state__lookup_type_for_rec_var(Var, #state{callgraph = Callgraph} = State) ->
+state__lookup_type_for_letrec(Var, #state{callgraph = Callgraph} = State) ->
   Label = get_label(Var),
-  case dialyzer_callgraph:lookup_rec_var(Label, Callgraph) of
+  case dialyzer_callgraph:lookup_letrec(Label, Callgraph) of
     error -> error;
-    {ok, MFA} ->
-      {ok, FunLabel} = dialyzer_callgraph:lookup_label(MFA, Callgraph),
+    {ok, FunLabel} ->
       {ok, state__fun_type(FunLabel, State)}
   end.
 
diff --git a/lib/dialyzer/src/dialyzer_dep.erl b/lib/dialyzer/src/dialyzer_dep.erl
index febb65b766..1a477f4388 100644
--- a/lib/dialyzer/src/dialyzer_dep.erl
+++ b/lib/dialyzer/src/dialyzer_dep.erl
@@ -39,7 +39,7 @@
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 %%
-%% analyze(CoreTree) -> {Deps, Esc, Calls}.
+%% analyze(CoreTree) -> {Deps, Esc, Calls, Letrecs}.
 %%
 %% Deps =  a dict mapping labels of functions to an ordset of functions
 %%         it calls.
@@ -53,6 +53,10 @@
 %%         which the operation can refer to. If 'external' is part of
 %%         the set the operation can be externally defined.
 %%
+%% Letrecs = a dict mapping var labels to their recursive definition.
+%%           top-level letrecs are not included as they are handled
+%%           separatedly.
+%%
 
 -spec analyze(cerl:c_module()) -> {dict(), ordset('external' | label()), dict()}.
 
@@ -64,7 +68,8 @@ analyze(Tree) ->
   State1 = state__add_deps(external, output(Esc), State),
   Deps = state__deps(State1),
   Calls = state__calls(State1),
-  {map__finalize(Deps), set__to_ordsets(Esc), map__finalize(Calls)}.
+  Letrecs = state__letrecs(State1),
+  {map__finalize(Deps), set__to_ordsets(Esc), map__finalize(Calls), Letrecs}.
 
 traverse(Tree, Out, State, CurrentFun) ->
   %% io:format("Type: ~w\n", [cerl:type(Tree)]),
@@ -131,9 +136,12 @@ traverse(Tree, Out, State, CurrentFun) ->
     letrec ->
       Defs = cerl:letrec_defs(Tree),
       Body = cerl:letrec_body(Tree),
+      State1 = lists:foldl(fun({ Var, Fun }, Acc) ->
+	state__add_letrecs(cerl_trees:get_label(Var), cerl_trees:get_label(Fun), Acc)
+      end, State, Defs),
       Out1 = bind_defs(Defs, Out),
-      State1 = traverse_defs(Defs, Out1, State, CurrentFun),
-      traverse(Body, Out1, State1, CurrentFun);
+      State2 = traverse_defs(Defs, Out1, State1, CurrentFun),
+      traverse(Body, Out1, State2, CurrentFun);
     literal ->
       {output(none), State};
     module ->
@@ -463,7 +471,8 @@ all_vars(Tree, AccIn) ->
 -record(state, {deps    :: dict(), 
 		esc     :: local_set(), 
 		call    :: dict(), 
-		arities :: dict()}).
+		arities :: dict(),
+		letrecs :: dict()}).
 
 state__new(Tree) ->
   Exports = set__from_list([X || X <- cerl:module_exports(Tree)]),
@@ -471,7 +480,7 @@ state__new(Tree) ->
 			    || {Var, Fun} <- cerl:module_defs(Tree),
 			       set__is_element(Var, Exports)]),
   Arities = cerl_trees:fold(fun find_arities/2, dict:new(), Tree),
-  #state{deps = map__new(), esc = InitEsc, call = map__new(), arities = Arities}.
+  #state{deps = map__new(), esc = InitEsc, call = map__new(), arities = Arities, letrecs = map__new()}.
 
 find_arities(Tree, AccMap) ->
   case cerl:is_c_fun(Tree) of
@@ -490,9 +499,15 @@ state__add_deps(From, #output{type = single, content=To},
   %% io:format("Adding deps from ~w to ~w\n", [From, set__to_ordsets(To)]),
   State#state{deps = map__add(From, To, Map)}.
 
+state__add_letrecs(Var, Fun, #state{letrecs = Map} = State) ->
+  State#state{letrecs = map__store(Var, Fun, Map)}.
+
 state__deps(#state{deps = Deps}) ->
   Deps.
 
+state__letrecs(#state{letrecs = Letrecs}) ->
+  Letrecs.
+
 state__add_esc(#output{content = none}, State) ->
   State;
 state__add_esc(#output{type = single, content = Set},