removing ppx_deriving (#10)

gitoleg · ivg · commit e0e61e3428fc · 2017-11-02T10:11:05.000-04:00
* removed [@@deriving enum] because something dirty happen in theirs ppx world * removed tests * added unit tests * renaming * refactored, added mli file * refactored * rewritten
diff --git a/.merlin b/.merlin
@@ -11,6 +11,8 @@ PKG bap
 PKG bap-traces
 PKG uri
 PKG cmdliner
+PKG ppx_jane
 
-B _build
+B _build/lib
 B _build/plugin
+S lib/
diff --git a/_oasis b/_oasis
@@ -9,10 +9,10 @@ BuildTools:  ocamlbuild
 
 Library "bap-frames"
   Path:            lib/
-  Modules:         Frame_arch, Frame_events, Frame_mach, Frame_piqi, Frame_reader
+  Modules:         Frame_arch, Frame_events, Frame_mach, Frame_piqi, Frame_reader, Frame_enum
   FindlibName:     bap-frames
   BuildTools:      piqi
-  BuildDepends:    bap, bap-traces, core_kernel, piqirun.pb, ppx_jane, ppx_deriving.std
+  BuildDepends:    bap, bap-traces, core_kernel, piqirun.pb, ppx_jane
   CompiledObject:  best
   DataFiles:       ../piqi/*.piqi
 
@@ -21,4 +21,24 @@ Library "bap-plugin-frames"
   FindlibName:     bap-plugin-frames
   Modules:         Frame_trace_plugin
   BuildDepends:    bap, bap-frames, bap-traces
-  XMETADescription: read traces in frames format
+  XMETADescription: read traces in frames format
+
+Library "frames-tests"
+  Path:            test
+  FindlibName:     bap-frames-tests
+  Build$:          flag(tests)
+  Install:         false
+  Modules:         Test_enum
+  BuildDepends:    bap-frames, oUnit
+
+Executable run_frames_tests
+  Path:            test/
+  Build$:          flag(tests)
+  CompiledObject:  best
+  BuildDepends:    bap-frames-tests
+  Install:         false
+  MainIs:          run_frames_tests.ml
+
+Test unit_tests
+  TestTools: run_frames_tests
+  Command: $run_frames_tests -runner sequential
diff --git a/lib/.merlin b/lib/.merlin
@@ -1,4 +1,6 @@
 REC
-PKG ppx_deriving.std
+PKG ppx_jane
 PKG piqirun
+PKG bap
+
 B ../_build/lib
diff --git a/lib/frame_arch.ml b/lib/frame_arch.ml
@@ -1,3 +1,5 @@
+open Core_kernel.Std
+
 (** Type definitions from BFD library.
 
     Note: this definitions are taken from a correspoind
@@ -96,4 +98,10 @@ type t =
   | Lm32
   | Microblaze
   | Last
-  [@@deriving enum]
+[@@deriving enumerate, variants]
+
+include Frame_enum.Make(struct
+    type nonrec t = t
+    let rank = Variants.to_rank
+    let all = all
+  end)
diff --git a/lib/frame_enum.ml b/lib/frame_enum.ml
@@ -0,0 +1,58 @@
+open Core_kernel.Std
+
+module type Enumerated = sig
+  type t
+  val rank : t -> int
+  val all : t list
+end
+
+module type Enumerable = sig
+  type t
+  val to_enum : t -> int
+  val of_enum : int -> t option
+  val max : int
+  val min : int
+end
+
+let make_values rank xs =
+  List.fold ~init:Int.Map.empty
+    ~f:(fun vals x -> Map.add vals ~key:(rank x) ~data:x) xs
+
+module type Substitution = sig
+  include Enumerated
+  val subs : (t * int) list
+end
+
+module Substitute(S : Substitution) : Enumerated with type t = S.t  = struct
+  include S
+
+  let new_rank =
+    let values = make_values rank all in
+    let xs = Map.to_alist values in
+    let subs = List.map ~f:(fun (x, ind) -> rank x, ind) subs in
+    let values, _ =
+      List.fold xs ~init:(Int.Map.empty,0) ~f:(fun (vals,ind') (ind, x) ->
+          match List.find ~f:(fun (old_ind, new_ind) -> old_ind = ind) subs  with
+          | None ->
+            Map.add vals ~key:ind ~data:(ind', x), ind' + 1
+          | Some (_, new_ind) ->
+            Map.add vals ~key:ind ~data:(new_ind, x), new_ind + 1) in
+    fun x -> fst @@ Map.find_exn values (rank x)
+
+  let rank = new_rank
+end
+
+module Make(E : Enumerated) : Enumerable with type t := E.t  = struct
+  include E
+
+  let values = make_values rank all
+  let of_enum i = Map.find values i
+  let to_enum x = rank x
+  let max = Option.value_map ~default:0 ~f:fst (Map.max_elt values)
+  let min = Option.value_map ~default:0 ~f:fst (Map.min_elt values)
+end
+
+module Make_substitute(S : Substitution) : Enumerable with type t := S.t  = struct
+  module E = Substitute(S)
+  include Make(E)
+end
diff --git a/lib/frame_enum.mli b/lib/frame_enum.mli
@@ -0,0 +1,30 @@
+open Core_kernel.Std
+
+module type Enumerated = sig
+  type t
+  val rank : t -> int
+  val all : t list
+end
+
+(** Replaces [@@deriving enum] interface from ppx_deriving, that
+    treats variants with argument-less constructors as
+    enumerations with an integer value assigned to every constructor. *)
+module type Enumerable = sig
+  type t
+
+  val to_enum : t -> int
+  val of_enum : int -> t option
+  val max : int
+  val min : int
+end
+
+module type Substitution = sig
+  include Enumerated
+
+  (** [subs] is a list of substitions [ (t, ind); ... ], where
+      an explicit index [ind] is set to a particular variant [t]. *)
+  val subs : (t * int) list
+end
+
+module Make(A : Enumerated) : Enumerable with type t := A.t
+module Make_substitute(S : Substitution) : Enumerable with type t := S.t
diff --git a/lib/frame_mach.ml b/lib/frame_mach.ml
@@ -1,12 +1,19 @@
 module I386 = struct
   type t =
     | Unknown
-    | I386          [@value 1]
+    | I386
     | I8086
     | I386_intel
-    | X86_64        [@value 64]
+    | X86_64
     | X86_64_intel
-    [@@deriving enum]
+  [@@deriving enumerate, variants]
+
+  include Frame_enum.Make_substitute(struct
+      type nonrec t = t
+      let subs = [X86_64, 64]
+      let rank = Variants.to_rank
+      let all = all
+    end)
 end
 
 module Arm = struct
@@ -25,33 +32,61 @@ module Arm = struct
     |  Ep9312
     |  Iwmmxt
     |  Iwmmxt2
-    [@@deriving enum]
+  [@@deriving enumerate, variants]
+
+  include Frame_enum.Make(struct
+      type nonrec t = t
+      let rank = Variants.to_rank
+      let all = all
+    end)
+
 end
 
 module Mips = struct
   type t =
-    |  Unknown [@value  0]
-    |  Isa32   [@value 32]
+    |  Unknown
+    |  Isa32
     |  Isa32r2
-    |  Isa64   [@value 64]
+    |  Isa64
     |  Isa64r2
-    [@@deriving enum]
+  [@@deriving enumerate, variants]
+
+  include Frame_enum.Make_substitute(struct
+      type nonrec t = t
+      let subs = [Isa32, 32; Isa64, 64]
+      let rank = Variants.to_rank
+      let all = all
+    end)
 end
 
 module Ppc = struct
   type t =
-    |  Unknown   [@value  0]
-    |  Ppc32     [@value 32]
-    |  Ppc64     [@value 64]
-    [@@deriving enum]
+    |  Unknown
+    |  Ppc32
+    |  Ppc64
+  [@@deriving enumerate, variants]
+
+  include Frame_enum.Make_substitute(struct
+      type nonrec t = t
+      let subs = [Ppc32, 32; Ppc64, 64]
+      let rank = Variants.to_rank
+      let all = all
+    end)
 end
 
 module Sparc = struct
   type t =
-    |  Unknown [@value 0]
-    |  Sparc   [@value 1]
-    |  V9      [@value 7]
+    |  Unknown
+    |  Sparc
+    |  V9
     |  V9a
     |  V9b
-    [@@deriving enum]
+  [@@deriving enumerate, variants]
+
+  include Frame_enum.Make_substitute(struct
+      type nonrec t = t
+      let subs = [V9, 7]
+      let rank = Variants.to_rank
+      let all = all
+    end)
 end
diff --git a/lib/frame_reader.ml b/lib/frame_reader.ml
@@ -13,7 +13,17 @@ type field =
   | Bfd_mach
   | Frames
   | Toc
-  [@@deriving enum, variants]
+[@@deriving enumerate, variants]
+
+module F = Frame_enum.Make(struct
+    type t = field
+    let rank = Variants_of_field.to_rank
+    let all = all_of_field
+  end)
+
+let field_to_enum = F.to_enum
+let field_of_enum = F.of_enum
+let max_field = F.max
 
 type header = {
   magic : int64;
diff --git a/test/.merlin b/test/.merlin
@@ -0,0 +1,6 @@
+REC
+S .
+B ../_build/test
+
+PKG oUnit
+PKG bap-frames
diff --git a/test/run_frames_tests.ml b/test/run_frames_tests.ml
@@ -0,0 +1,9 @@
+
+open OUnit2
+
+let suite () =
+  "Bap-frames" >::: [
+    Test_enum.suite ();
+  ]
+
+let () = run_test_tt_main (suite ())
diff --git a/test/test_enum.ml b/test/test_enum.ml
@@ -0,0 +1,54 @@
+open Core_kernel.Std
+open OUnit2
+open Frame_enum
+
+type t = A | B | C | D | E [@@deriving enumerate, variants]
+
+module E = struct
+  include Make(struct
+      type nonrec t = t
+      let rank = Variants.to_rank
+      let all = all
+    end)
+end
+
+module S = struct
+  include Make_substitute(struct
+      type nonrec t = t
+      let subs = [B, 42; D, 56;]
+      let rank = Variants.to_rank
+      let all = all
+    end)
+end
+
+let check x ctxt = assert_bool "test_enum failed" x
+
+let suite () =
+  "Frame_enum"  >::: [
+    "of_enum 0" >:: check (E.of_enum 0 = Some A);
+    "of_enum 1" >:: check (E.of_enum 1 = Some B);
+    "of_enum 2" >:: check (E.of_enum 2 = Some C);
+    "of_enum 3" >:: check (E.of_enum 3 = Some D);
+    "of_enum 4" >:: check (E.of_enum 4 = Some E);
+    "of_enum 5" >:: check (E.of_enum 5 = None);
+    "max"       >:: check (E.max = 4);
+    "min"       >:: check (E.min = 0);
+    "to_enum A" >:: check (E.to_enum A = 0);
+    "to_enum B" >:: check (E.to_enum B = 1);
+    "to_enum C" >:: check (E.to_enum C = 2);
+    "to_enum D" >:: check (E.to_enum D = 3);
+    "to_enum E" >:: check (E.to_enum E = 4);
+    "substitute.of_enum 0" >:: check (S.of_enum 0 = Some A);
+    "substitute.of_enum 42" >:: check (S.of_enum 42 = Some B);
+    "substitute.of_enum 43" >:: check (S.of_enum 43 = Some C);
+    "substitute.of_enum 56" >:: check (S.of_enum 56 = Some D);
+    "substitute.of_enum 57" >:: check (S.of_enum 57 = Some E);
+    "substitute.of_enum 3" >:: check (S.of_enum 1 = None);
+    "substitute.max"       >:: check (S.max = 57);
+    "substitute.min"       >:: check (S.min = 0);
+    "substitute.to_enum A" >:: check (S.to_enum A = 0);
+    "substitute.to_enum B" >:: check (S.to_enum B = 42);
+    "substitute.to_enum C" >:: check (S.to_enum C = 43);
+    "substitute.to_enum D" >:: check (S.to_enum D = 56);
+    "substitute.to_enum E" >:: check (S.to_enum E = 57);
+  ]
