makes all plugins compilable under modern BAP and Core

this all mostly about ~equal and polymorphic compare

checkpath/checkpath.ml

@@ -26,13 +26,14 @@ let string_of_point project point =
 (** [touches point block] true if block ends up with a call to
     [point] *)
 let touches point block =
-  Bil.exists (object
-    inherit [unit] Bil.finder
-    method enter_int target search =
-      if in_jmp && target = point then
-        search.return (Some ());
-      search
-  end) (Insn.bil (Block.terminator block))
+  Insn.bil (Block.terminator block) |>
+  List.exists ~f:(Stmt.exists (object
+                    inherit [unit] Stmt.finder
+                    method enter_int target search =
+                      if in_jmp && target = point then
+                        search.return (Some ());
+                      search
+                  end))
 
 
 let dfs cfg blk =

fold_consts/main.ml

@@ -7,7 +7,7 @@ let stack_offset = 0x40000000L
 
 let simpl_load lookup =
   Exp.map (object(self)
-    inherit Bil.mapper as super
+    inherit Stmt.mapper as super
     method! map_load ~mem ~addr endian size =
       match lookup ~mem ~addr endian size with
       | None -> super#map_load ~mem ~addr endian size

minos/color.ml

@@ -31,9 +31,6 @@ let to_terminal = function
   | Purple -> "\x1b[35m"
   | White -> "\x1b[37m"
 
-let make_color_map l c =
-  List.fold l ~init:[] ~f:(fun acc name ->
-      List.Assoc.add acc name c)
 
 let (!) = to_int
 let (!!) = to_terminal

minos/ctxt.mli

@@ -15,6 +15,6 @@ type t = {
   trim : trim;
   max_depth : int; (** depth to go to before terminating path *)
   sample: int; (** number of paths to sample *)
-  g : (module Graphlib.Graph with type edge = Graphs.Tid.edge and
+  g : (module Graph with type edge = Graphs.Tid.edge and
       type node = tid and type t = Graphs.Tid.t)
 }

minos/dependence.ml

@@ -104,6 +104,8 @@ let inter_dep deps1 deps2 =
   Tid.Set.inter (Tid.Set.of_list (Seq.to_list deps2)) |>
   Tid.Set.to_sequence
 
+let equal = Polymorphic_compare.equal
+
 let highlight_cli ?(highlight=[]) (ctxt : Check.ctxt) sub dependence =
   let open Color in
   let output = "" in
@@ -127,15 +129,15 @@ let highlight_cli ?(highlight=[]) (ctxt : Check.ctxt) sub dependence =
           Seq.fold ~init:output ~f:(fun output elt ->
               match elt with
               | `Def def ->
-                (match List.Assoc.find highlight (Term.tid def) with
+                (match List.Assoc.find ~equal highlight (Term.tid def) with
                  | Some color ->
                    let s = Format.sprintf "%s\n" (color^to_string_def def^no) in
                    output^s
                  | None ->
                    let s = Format.sprintf "%s\n" @@ to_string_def def in
                    output^s)
               | `Jmp jmp ->
-                (match List.Assoc.find highlight (Term.tid jmp) with
+                (match List.Assoc.find ~equal highlight (Term.tid jmp) with
                  | Some color ->
                    let s =  Format.sprintf "%s\n" (color^to_string_jmp jmp^no) in
                    output^s
@@ -150,7 +152,7 @@ let highlight_cli ?(highlight=[]) (ctxt : Check.ctxt) sub dependence =
 let output sub' arg_dependence jmp_dependence sink_intersect_dependence jmp_tids
     (ctxt : Check.ctxt) =
   let open Color in
-  let add_color = List.Assoc.add in
+  let add_color = List.Assoc.add ~equal in
   let add_aqua l tid = add_color l tid !!Aqua in
   let add_red l tid = add_color l tid !!Red in
   let add_green l tid = add_color l tid !!Green in

minos/interprocedural.ml

@@ -99,7 +99,7 @@ let inline_sub_called_by_blk project ccall callsite_tid blk sub =
 (** For a blk with a call, inline the call and return an updated
     global sub. Skip recursive. *)
 let inline_update_blk project sub blk_name (filtr: Filter.t) =
-  let blk = Util.blk_of_tid sub @@ Tid.(!blk_name) in
+  let blk = Util.blk_of_tid sub @@ Tid.(!!blk_name) in
   match Util.calls_of_blk_with_tid blk with
   | [] -> sub,[]
   | [(callsite_tid,ccall)] when not (filtered_call ~f:filtr ccall) ->
@@ -119,7 +119,7 @@ let inline project sub (filtr : Filter.t) =
 
 let make_color_map l c =
   List.fold l ~init:[] ~f:(fun acc name ->
-      List.Assoc.add acc name c)
+      List.Assoc.add ~equal:Polymorphic_compare.equal acc name c)
 
 (** Inline n times. Note we don't have to fail if we detect mutually
     recursive calls. Just warn. *)

minos/mem_to_reg.ml

@@ -13,7 +13,7 @@ let print_store_map =
 (* We might see:
    000000f4: t_167 := mem64[0x601050:64, el]:u8*)
 let mem_read_to_var exp =
-  (object inherit Bil.mapper
+  (object inherit Stmt.mapper
     method! map_load ~mem ~addr endian size =
       match addr with
       | Bil.Int addr ->
@@ -22,7 +22,7 @@ let mem_read_to_var exp =
       | exp ->
         (* binop mapper so we hit every instance of a mem read in an
            expression *)
-        (object inherit Bil.mapper
+        (object inherit Stmt.mapper
           method! map_binop op o1 o2 =
             let orig = Bil.binop op o1 o2 in
             match (op,o1,o2) with

minos/path_producer.ml

@@ -272,7 +272,7 @@ let produce project options path_dir trim_dir trim check =
   *)
   let sub' = view_to_sub filtered_graph graph sub |> kill_non_existing_jmps in
 
-  let module G' = (val filtered_graph : Graphlib.Graph with
+  let module G' = (val filtered_graph : Graph with
                     type edge = Graphs.Tid.edge and
                   type node = tid and
                   type t = Graphs.Tid.t) in

minos/pathlib.ml

@@ -69,7 +69,7 @@ let debug succs blk =
   Format.printf "\n%!"
 
 let rec fold_paths_graph ?(rev=false)
-    (module G : Graphlib.Graph with
+    (module G : Graph with
       type edge = Graphs.Tid.edge and
     type node = tid and
     type t = Graphs.Tid.t)

minos/pathlib.mli

@@ -31,7 +31,7 @@ val fold_paths:
     representation. Supports reverse traversal. *)
 val fold_paths_graph :
   ?rev:bool ->
-  (module Graphlib.Graph
+  (module Graph
     with type edge = Graphs.Tid.edge and
     type node = tid and
     type t = Graphs.Tid.t) ->

minos/profile.ml

@@ -11,8 +11,10 @@ type t = {
   cyc_comp : int;
 }
 
+let equal = Polymorphic_compare.equal
+
 let sub_profile_with_view
-    (module G : Graphlib.Graph with type edge = Graphs.Tid.edge and
+    (module G : Graph with type edge = Graphs.Tid.edge and
     type node = tid and type t = Graphs.Tid.t) sub =
   let name = Sub.name sub in
   let num_blks = Seq.length (Term.enum blk_t sub) in
@@ -106,9 +108,9 @@ let output_dot_cfg
 
   let node_attrs node =
     let base =
-      if List.Assoc.mem highlight @@ Term.name (Cfg.Node.label node) then
+      if List.Assoc.mem ~equal highlight @@ Term.name (Cfg.Node.label node) then
         [`Shape `Box; `Style `Filled; `Fillcolor
-           (List.Assoc.find_exn highlight (Term.name (Cfg.Node.label node)))]
+           (List.Assoc.find_exn ~equal highlight (Term.name (Cfg.Node.label node)))]
       else
         [`Shape `Box; `Style `Filled; `Fillcolor !White] in
     base
@@ -156,14 +158,14 @@ let output_dot_cfg_path ?(special=[]) ?(highlight=[]) ?(v=false)
 
   let node_attrs node =
     let blk_name = Term.name (Cfg.Node.label node) in
-    if List.Assoc.mem special blk_name then
+    if List.Assoc.mem ~equal special blk_name then
       [`Shape `Box; `Style `Filled; `Fillcolor
-         (List.Assoc.find_exn special blk_name)]
+         (List.Assoc.find_exn ~equal special blk_name)]
     else if Seq.exists path ~f:(fun tid -> Tid.name tid = blk_name) then
       [`Shape `Box; `Style `Filled; `Fillcolor !Green; `Fontcolor !White]
-    else if List.Assoc.mem highlight blk_name then
+    else if List.Assoc.mem ~equal highlight blk_name then
       [`Shape `Box; `Style `Filled; `Fillcolor
-         (List.Assoc.find_exn highlight blk_name)]
+         (List.Assoc.find_exn ~equal highlight blk_name)]
     else
       [`Shape `Box; `Style `Filled; `Fillcolor !White]
   in

minos/profile.mli

@@ -11,7 +11,7 @@ type t = {
 }
 
 val sub_profile_with_view :
-  (module Graphlib.Graph with type edge = Graphs.Tid.edge and
+  (module Graph with type edge = Graphs.Tid.edge and
   type node =  tid and type t = Graphs.Tid.t) ->
   Sub.t -> t
 

minos/util.ml

@@ -191,7 +191,7 @@ let contains_call blk call_name =
 let calls_self sub =
   let blk_tids = blks_with_calls sub in
   List.exists blk_tids ~f:(fun t ->
-      let blk = blk_of_tid sub @@ Tid.(!t) in
+      let blk = blk_of_tid sub @@ Tid.(!!t) in
       match calls_of_blk_with_tid blk with
       | [] -> false
       | [(lhs_tid, call)] ->
@@ -238,7 +238,7 @@ let callgraph_of_sub project sub_tid =
 (** Bil mapper. Takes a stmt list and gives you back a stmt list.
     This one resolves memory. *)
 let resolve_indirects project =
-  Bil.map (object inherit Bil.mapper as super
+  Stmt.map (object inherit Stmt.mapper as super
     method! map_load ~mem ~addr endian scale =
       let exp = super#map_load ~mem ~addr endian scale in
       match addr with
@@ -256,7 +256,7 @@ let resolve_indirects project =
 (** Exp mapper. Everything is the same as the above, but we use
     Exp.map! *)
 let resolve_indirects project =
-  Bil.map (object inherit Bil.mapper as super
+  Stmt.map (object inherit Stmt.mapper as super
     method! map_load ~mem ~addr endian scale =
       let exp = super#map_load ~mem ~addr endian scale in
       match addr with
@@ -458,7 +458,7 @@ let resolve_symbols_of_calls project () =
 
 (** TODO add check that confirms no back-edges are traversed *)
 let num_paths_dag
-    (module G : Graphlib.Graph with type edge = Graphs.Tid.edge and
+    (module G : Graph with type edge = Graphs.Tid.edge and
     type node = tid and type t = Graphs.Tid.t)
     graph start_tid =
   let dp = Tid.Table.create () in

minos/util.mli

@@ -75,7 +75,7 @@ val make_call_returns_explicit : Sub.t -> Sub.t
 (** Find number of paths in a dag. Uses DP on dfs. MUST be a DAG with
     a single exit node. Undefined behavior for multiple exit nodes. *)
 val num_paths_dag :
-  (module Graphlib.Graph with type edge = Graphs.Tid.edge and
+  (module Graph with type edge = Graphs.Tid.edge and
   type node = tid and type t = Graphs.Tid.t) ->
   Graphs.Tid.t -> tid -> int