[swift] Llair to Textual: translate and collect all the nodes in a proc

Summary:
In llair, there is only a reference to the entry block, so when we translate blocks to Textual nodes, we also need to collect the nodes to be able to translate them and add them to the proc_descs.

So we translate nodes, starting from the entry node, and following jumps, translating nodes as we go and collecting the successors. We keep a set of node names of seen nodes to make sure the recursion stops in the presence of loops.

Reviewed By: davidpichardie

Differential Revision: D69785730

fbshipit-source-id: 771a6dcfa3b12042f8abc4515b7669e8830515f9

infer/src/swift/Llair2Textual.ml

@@ -92,35 +92,6 @@ let to_textual_call (call : 'a Llair.call) =
   Textual.Instr.Let {id; exp= Call {proc; args; kind}; loc}
 
 
-let to_textual_jump jump =
-  let label = block_to_node_name jump.dst in
-  let node_call = Textual.Terminator.{label; ssa_args= []} in
-  Textual.Terminator.Jump [node_call]
-
-
-let to_terminator term =
-  match term with
-  | Call call ->
-      to_textual_jump call.return
-  | Return {exp= Some exp} ->
-      Textual.Terminator.Ret (to_textual_exp exp)
-  | Return {exp= None} ->
-      Textual.Terminator.Ret (Textual.Exp.Typ Textual.Typ.Void)
-  | Throw {exc} ->
-      Textual.Terminator.Throw (to_textual_exp exc)
-  | Switch {key; tbl; els} -> (
-    match StdUtils.iarray_to_list tbl with
-    | [(exp, zero_jump)] when Exp.equal exp Exp.false_ ->
-        let bexp = to_textual_bool_exp key in
-        let else_ = to_textual_jump zero_jump in
-        let then_ = to_textual_jump els in
-        Textual.Terminator.If {bexp; then_; else_}
-    | _ ->
-        Textual.Terminator.Unreachable (* TODO translate Switch *) )
-  | Iswitch _ | Abort _ | Unreachable ->
-      Textual.Terminator.Unreachable
-
-
 let cmnd_to_instrs block =
   let to_instr inst =
     (* TODO translate instructions *)
@@ -143,22 +114,70 @@ let cmnd_to_instrs block =
   List.append instrs (Option.to_list call_instr_opt)
 
 
+let rec to_textual_jump_and_succs ~seen_nodes jump =
+  let block = jump.dst in
+  let node_label = block_to_node_name block in
+  let node_label, succs =
+    (* If we've seen this node, stop the recursion *)
+    if Textual.NodeName.Set.mem node_label seen_nodes then (node_label, Textual.Node.Set.empty)
+    else
+      let node, nodes = block_to_node_and_succs ~seen_nodes jump.dst in
+      (node.label, nodes)
+  in
+  let node_call = Textual.Terminator.{label= node_label; ssa_args= []} in
+  (Textual.Terminator.Jump [node_call], succs)
+
+
+and to_terminator_and_succs ~seen_nodes term =
+  let no_succs = Textual.Node.Set.empty in
+  match term with
+  | Call call ->
+      to_textual_jump_and_succs ~seen_nodes call.return
+  | Return {exp= Some exp} ->
+      (Textual.Terminator.Ret (to_textual_exp exp), no_succs)
+  | Return {exp= None} ->
+      (Textual.Terminator.Ret (Textual.Exp.Typ Textual.Typ.Void), no_succs)
+  | Throw {exc} ->
+      (Textual.Terminator.Throw (to_textual_exp exc), no_succs)
+  | Switch {key; tbl; els} -> (
+    match StdUtils.iarray_to_list tbl with
+    | [(exp, zero_jump)] when Exp.equal exp Exp.false_ ->
+        let bexp = to_textual_bool_exp key in
+        let else_, zero_nodes = to_textual_jump_and_succs ~seen_nodes zero_jump in
+        let then_, els_nodes = to_textual_jump_and_succs ~seen_nodes els in
+        let term = Textual.Terminator.If {bexp; then_; else_} in
+        let nodes = Textual.Node.Set.union zero_nodes els_nodes in
+        (term, nodes)
+    | _ ->
+        (Textual.Terminator.Unreachable, no_succs (* TODO translate Switch *)) )
+  | Iswitch _ | Abort _ | Unreachable ->
+      (Textual.Terminator.Unreachable, no_succs)
+
+
 (* TODO still various parts of the node left to be translated *)
-let block_to_node (block : Llair.block) =
-  Textual.Node.
-    { label= block_to_node_name block
-    ; ssa_parameters= []
-    ; exn_succs= []
-    ; last= to_terminator block.term
-    ; instrs= cmnd_to_instrs block
-    ; last_loc= Textual.Location.Unknown
-    ; label_loc= Textual.Location.Unknown }
+and block_to_node_and_succs ~seen_nodes (block : Llair.block) : Textual.Node.t * Textual.Node.Set.t
+    =
+  let node_name = block_to_node_name block in
+  let terminator, succs =
+    to_terminator_and_succs ~seen_nodes:(Textual.NodeName.Set.add node_name seen_nodes) block.term
+  in
+  let node =
+    Textual.Node.
+      { label= node_name
+      ; ssa_parameters= []
+      ; exn_succs= []
+      ; last= terminator
+      ; instrs= cmnd_to_instrs block
+      ; last_loc= Textual.Location.Unknown
+      ; label_loc= Textual.Location.Unknown }
+  in
+  (* We add the nodes here to make sure they always get added even in the case of recursive jumps *)
+  (node, Textual.Node.Set.add node succs)
 
 
 let func_to_nodes func =
-  let node = block_to_node func.Llair.entry in
-  (* TODO translate all nodes *)
-  [node]
+  let _, nodes = block_to_node_and_succs ~seen_nodes:Textual.NodeName.Set.empty func.Llair.entry in
+  Textual.Node.Set.to_list nodes
 
 
 let translate_llair_functions functions =

infer/src/textual/Textual.ml

@@ -972,14 +972,22 @@ module Terminator = struct
 end
 
 module Node = struct
-  type t =
-    { label: NodeName.t
-    ; ssa_parameters: (Ident.t * Typ.t) list
-    ; exn_succs: NodeName.t list
-    ; last: Terminator.t
-    ; instrs: Instr.t list
-    ; last_loc: Location.t
-    ; label_loc: Location.t }
+  module T = struct
+    type t =
+      { label: NodeName.t
+      ; ssa_parameters: (Ident.t * Typ.t) list
+      ; exn_succs: NodeName.t list
+      ; last: Terminator.t
+      ; instrs: Instr.t list
+      ; last_loc: Location.t
+      ; label_loc: Location.t }
+
+    let equal node1 node2 = NodeName.equal node1.label node2.label
+
+    let compare node1 node2 = NodeName.compare node1.label node2.label
+  end
+
+  include T
 
   (* see the specification of Instr.is_ready_for_to_sil_conversion above *)
   let is_ready_for_to_sil_conversion node =
@@ -1003,7 +1011,7 @@ module Node = struct
     F.fprintf fmt "@\n@]"
 
 
-  let equal node1 node2 = NodeName.equal node1.label node2.label
+  module Set = Stdlib.Set.Make (T)
 end
 
 module ProcDesc = struct

infer/src/textual/Textual.mli

@@ -374,6 +374,8 @@ module Terminator : sig
     | Unreachable
 end
 
+[@@@warning "-unused-module"]
+
 module Node : sig
   type t =
     { label: NodeName.t
@@ -384,6 +386,8 @@ module Node : sig
     ; last_loc: Location.t  (** location of last instruction in file *)
     ; label_loc: Location.t  (** location of label in file *) }
   [@@deriving equal]
+
+  module Set : Stdlib.Set.S with type elt = t
 end
 
 module ProcDesc : sig