Address code reviews

src/analyses/extractPthread.ml

@@ -131,8 +131,7 @@ module Tbls = struct
       in
       Hashtbl.find table k |> Option.default_delayed new_value_thunk
 
-
-    let get_key v = table |> Hashtbl.to_seq |> Seq.find_map (fun (k,v') -> if v' = v then Some k else None)
+    let get_key v = table |> Hashtbl.to_seq |> Seq.find_map (fun (k,v') -> if v' = v then Some k else None) (* TODO: inefficient look up by value from Hashtbl *)
 
     let to_list () = table |> Hashtbl.bindings
   end
@@ -144,7 +143,7 @@ module Tbls = struct
 
     let get k = Hashtbl.find table k
 
-    let get_key v = table |> Hashtbl.bindings |> List.assoc_inv v
+    let get_key v = table |> Hashtbl.to_seq |> Seq.find_map (fun (k,v') -> if v' = v then Some k else None) (* TODO: inefficient look up by value from Hashtbl *)
   end
 
   let all_keys_count table = table |> Hashtbl.to_seq_keys |> Seq.length
@@ -167,9 +166,9 @@ module Tbls = struct
     let extend k v = Hashtbl.modify_def Set.empty k (Set.add v) table
 
     let get_fun_for_tid v =
-      Hashtbl.to_seq_keys table
-      |> Seq.find (fun k ->
-          Option.get @@ Hashtbl.find table k |> Set.exists (( = ) v))
+      table
+      |> Hashtbl.to_seq
+      |> Seq.find_map (fun (k,v') -> if Set.exists (( = ) v) v' then Some k else None)
   end
 
   module MutexMidTbl = SymTbl (struct
@@ -331,8 +330,7 @@ end = struct
     let action_of_edge (_, action, _) = action in
     table
     |> Hashtbl.to_seq_values
-    |> Seq.map Set.to_seq
-    |> Seq.concat
+    |> Seq.concat_map Set.to_seq
     |> Seq.filter_map (f % action_of_edge)
     |> List.of_seq
 

src/analyses/threadId.ml

@@ -170,14 +170,14 @@ struct
 
 
   let print_tid_info () =
-    let tids = Hashtbl.to_seq !tids in
-    let uniques = Seq.filter_map (fun (a,b) -> if Thread.is_unique a then Some a else None) tids in
-    let non_uniques = Seq.filter_map (fun (a,b) -> if not (Thread.is_unique a) then Some a else None) tids in
-    let uc = Seq.length uniques in
-    let nc = Seq.length non_uniques in
+    let tids = Hashtbl.to_seq_keys !tids in
+    let uniques, non_uniques = Seq.partition Thread.is_unique tids in
+    let uniques, non_uniques = List.of_seq uniques, List.of_seq non_uniques in
+    let uc = List.length uniques in
+    let nc = List.length non_uniques in
     M.debug_noloc ~category:Analyzer "Encountered number of thread IDs (unique): %i (%i)" (uc+nc) uc;
-    M.msg_group Debug ~category:Analyzer "Unique TIDs" (List.map (fun tid -> (Thread.pretty () tid, None)) @@ List.of_seq uniques);
-    M.msg_group Debug ~category:Analyzer "Non-unique TIDs" (List.map (fun tid -> (Thread.pretty () tid, None)) @@ List.of_seq non_uniques)
+    M.msg_group Debug ~category:Analyzer "Unique TIDs" (List.map (fun tid -> (Thread.pretty () tid, None)) uniques);
+    M.msg_group Debug ~category:Analyzer "Non-unique TIDs" (List.map (fun tid -> (Thread.pretty () tid, None)) non_uniques)
 
   let finalize () =
     if GobConfig.get_bool "dbg.print_tids" then print_tid_info ();

src/cdomains/apron/apronDomain.apron.ml

@@ -301,6 +301,7 @@ struct
           | texpr1 -> Some texpr1
           | exception Convert.Unsupported_CilExp _ -> None
         ))
+      |> Seq.memoize
       |> Seq.partition (fun (_, e_opt) -> Option.is_some e_opt)
     in
     (* parallel assign supported *)
@@ -366,6 +367,7 @@ struct
           | texpr1 -> Some texpr1
           | exception Convert.Unsupported_CilExp _ -> None
         ))
+      |> Seq.memoize
       |> Seq.partition (fun (_, e_opt) -> Option.is_some e_opt)
     in
     (* parallel substitute supported *)

src/common/framework/cfgTools.ml

@@ -422,7 +422,7 @@ let createCFG (file: file) =
                     | [] ->
                       let scc_node =
                         NH.to_seq_keys scc.nodes
-                        |> BatList.of_seq
+                        |> BatList.of_seq (* TODO: do not convert to list to find min *)
                         |> BatList.min ~cmp:Node.compare (* use min for consistency for incremental CFG comparison *)
                       in
                       (* default to pseudo return if no suitable candidates *)