Skip to content

Commit e0e61e3

Browse files
gitolegivg
gitoleg
authored and
ivg
committed
removing ppx_deriving (#10)
* removed [@@deriving enum] because something dirty happen in theirs ppx world * removed tests * added unit tests * renaming * refactored, added mli file * refactored * rewritten
1 parent 0ea2abb commit e0e61e3

File tree

11 files changed

+257
-23
lines changed

11 files changed

+257
-23
lines changed

‎.merlin‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -11,6 +11,8 @@ PKG bap
1111
PKG bap-traces
1212
PKG uri
1313
PKG cmdliner
14+
PKG ppx_jane
1415

15-
B _build
16+
B _build/lib
1617
B _build/plugin
18+
S lib/

‎_oasis‎

Lines changed: 23 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -9,10 +9,10 @@ BuildTools: ocamlbuild
99

1010
Library "bap-frames"
1111
Path: lib/
12-
Modules: Frame_arch, Frame_events, Frame_mach, Frame_piqi, Frame_reader
12+
Modules: Frame_arch, Frame_events, Frame_mach, Frame_piqi, Frame_reader, Frame_enum
1313
FindlibName: bap-frames
1414
BuildTools: piqi
15-
BuildDepends: bap, bap-traces, core_kernel, piqirun.pb, ppx_jane, ppx_deriving.std
15+
BuildDepends: bap, bap-traces, core_kernel, piqirun.pb, ppx_jane
1616
CompiledObject: best
1717
DataFiles: ../piqi/*.piqi
1818

@@ -21,4 +21,24 @@ Library "bap-plugin-frames"
2121
FindlibName: bap-plugin-frames
2222
Modules: Frame_trace_plugin
2323
BuildDepends: bap, bap-frames, bap-traces
24-
XMETADescription: read traces in frames format
24+
XMETADescription: read traces in frames format
25+
26+
Library "frames-tests"
27+
Path: test
28+
FindlibName: bap-frames-tests
29+
Build$: flag(tests)
30+
Install: false
31+
Modules: Test_enum
32+
BuildDepends: bap-frames, oUnit
33+
34+
Executable run_frames_tests
35+
Path: test/
36+
Build$: flag(tests)
37+
CompiledObject: best
38+
BuildDepends: bap-frames-tests
39+
Install: false
40+
MainIs: run_frames_tests.ml
41+
42+
Test unit_tests
43+
TestTools: run_frames_tests
44+
Command: $run_frames_tests -runner sequential

‎lib/.merlin‎

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,4 +1,6 @@
11
REC
2-
PKG ppx_deriving.std
2+
PKG ppx_jane
33
PKG piqirun
4+
PKG bap
5+
46
B ../_build/lib

‎lib/frame_arch.ml‎

Lines changed: 9 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,5 @@
1+
open Core_kernel.Std
2+
13
(** Type definitions from BFD library.
24
35
Note: this definitions are taken from a correspoind
@@ -96,4 +98,10 @@ type t =
9698
| Lm32
9799
| Microblaze
98100
| Last
99-
[@@deriving enum]
101+
[@@deriving enumerate, variants]
102+
103+
include Frame_enum.Make(struct
104+
type nonrec t = t
105+
let rank = Variants.to_rank
106+
let all = all
107+
end)

‎lib/frame_enum.ml‎

Lines changed: 58 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,58 @@
1+
open Core_kernel.Std
2+
3+
module type Enumerated = sig
4+
type t
5+
val rank : t -> int
6+
val all : t list
7+
end
8+
9+
module type Enumerable = sig
10+
type t
11+
val to_enum : t -> int
12+
val of_enum : int -> t option
13+
val max : int
14+
val min : int
15+
end
16+
17+
let make_values rank xs =
18+
List.fold ~init:Int.Map.empty
19+
~f:(fun vals x -> Map.add vals ~key:(rank x) ~data:x) xs
20+
21+
module type Substitution = sig
22+
include Enumerated
23+
val subs : (t * int) list
24+
end
25+
26+
module Substitute(S : Substitution) : Enumerated with type t = S.t = struct
27+
include S
28+
29+
let new_rank =
30+
let values = make_values rank all in
31+
let xs = Map.to_alist values in
32+
let subs = List.map ~f:(fun (x, ind) -> rank x, ind) subs in
33+
let values, _ =
34+
List.fold xs ~init:(Int.Map.empty,0) ~f:(fun (vals,ind') (ind, x) ->
35+
match List.find ~f:(fun (old_ind, new_ind) -> old_ind = ind) subs with
36+
| None ->
37+
Map.add vals ~key:ind ~data:(ind', x), ind' + 1
38+
| Some (_, new_ind) ->
39+
Map.add vals ~key:ind ~data:(new_ind, x), new_ind + 1) in
40+
fun x -> fst @@ Map.find_exn values (rank x)
41+
42+
let rank = new_rank
43+
end
44+
45+
module Make(E : Enumerated) : Enumerable with type t := E.t = struct
46+
include E
47+
48+
let values = make_values rank all
49+
let of_enum i = Map.find values i
50+
let to_enum x = rank x
51+
let max = Option.value_map ~default:0 ~f:fst (Map.max_elt values)
52+
let min = Option.value_map ~default:0 ~f:fst (Map.min_elt values)
53+
end
54+
55+
module Make_substitute(S : Substitution) : Enumerable with type t := S.t = struct
56+
module E = Substitute(S)
57+
include Make(E)
58+
end

‎lib/frame_enum.mli‎

Lines changed: 30 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,30 @@
1+
open Core_kernel.Std
2+
3+
module type Enumerated = sig
4+
type t
5+
val rank : t -> int
6+
val all : t list
7+
end
8+
9+
(** Replaces [@@deriving enum] interface from ppx_deriving, that
10+
treats variants with argument-less constructors as
11+
enumerations with an integer value assigned to every constructor. *)
12+
module type Enumerable = sig
13+
type t
14+
15+
val to_enum : t -> int
16+
val of_enum : int -> t option
17+
val max : int
18+
val min : int
19+
end
20+
21+
module type Substitution = sig
22+
include Enumerated
23+
24+
(** [subs] is a list of substitions [ (t, ind); ... ], where
25+
an explicit index [ind] is set to a particular variant [t]. *)
26+
val subs : (t * int) list
27+
end
28+
29+
module Make(A : Enumerated) : Enumerable with type t := A.t
30+
module Make_substitute(S : Substitution) : Enumerable with type t := S.t

‎lib/frame_mach.ml‎

Lines changed: 51 additions & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -1,12 +1,19 @@
11
module I386 = struct
22
type t =
33
| Unknown
4-
| I386 [@value 1]
4+
| I386
55
| I8086
66
| I386_intel
7-
| X86_64 [@value 64]
7+
| X86_64
88
| X86_64_intel
9-
[@@deriving enum]
9+
[@@deriving enumerate, variants]
10+
11+
include Frame_enum.Make_substitute(struct
12+
type nonrec t = t
13+
let subs = [X86_64, 64]
14+
let rank = Variants.to_rank
15+
let all = all
16+
end)
1017
end
1118

1219
module Arm = struct
@@ -25,33 +32,61 @@ module Arm = struct
2532
| Ep9312
2633
| Iwmmxt
2734
| Iwmmxt2
28-
[@@deriving enum]
35+
[@@deriving enumerate, variants]
36+
37+
include Frame_enum.Make(struct
38+
type nonrec t = t
39+
let rank = Variants.to_rank
40+
let all = all
41+
end)
42+
2943
end
3044

3145
module Mips = struct
3246
type t =
33-
| Unknown [@value 0]
34-
| Isa32 [@value 32]
47+
| Unknown
48+
| Isa32
3549
| Isa32r2
36-
| Isa64 [@value 64]
50+
| Isa64
3751
| Isa64r2
38-
[@@deriving enum]
52+
[@@deriving enumerate, variants]
53+
54+
include Frame_enum.Make_substitute(struct
55+
type nonrec t = t
56+
let subs = [Isa32, 32; Isa64, 64]
57+
let rank = Variants.to_rank
58+
let all = all
59+
end)
3960
end
4061

4162
module Ppc = struct
4263
type t =
43-
| Unknown [@value 0]
44-
| Ppc32 [@value 32]
45-
| Ppc64 [@value 64]
46-
[@@deriving enum]
64+
| Unknown
65+
| Ppc32
66+
| Ppc64
67+
[@@deriving enumerate, variants]
68+
69+
include Frame_enum.Make_substitute(struct
70+
type nonrec t = t
71+
let subs = [Ppc32, 32; Ppc64, 64]
72+
let rank = Variants.to_rank
73+
let all = all
74+
end)
4775
end
4876

4977
module Sparc = struct
5078
type t =
51-
| Unknown [@value 0]
52-
| Sparc [@value 1]
53-
| V9 [@value 7]
79+
| Unknown
80+
| Sparc
81+
| V9
5482
| V9a
5583
| V9b
56-
[@@deriving enum]
84+
[@@deriving enumerate, variants]
85+
86+
include Frame_enum.Make_substitute(struct
87+
type nonrec t = t
88+
let subs = [V9, 7]
89+
let rank = Variants.to_rank
90+
let all = all
91+
end)
5792
end

‎lib/frame_reader.ml‎

Lines changed: 11 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -13,7 +13,17 @@ type field =
1313
| Bfd_mach
1414
| Frames
1515
| Toc
16-
[@@deriving enum, variants]
16+
[@@deriving enumerate, variants]
17+
18+
module F = Frame_enum.Make(struct
19+
type t = field
20+
let rank = Variants_of_field.to_rank
21+
let all = all_of_field
22+
end)
23+
24+
let field_to_enum = F.to_enum
25+
let field_of_enum = F.of_enum
26+
let max_field = F.max
1727

1828
type header = {
1929
magic : int64;

‎test/.merlin‎

Lines changed: 6 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,6 @@
1+
REC
2+
S .
3+
B ../_build/test
4+
5+
PKG oUnit
6+
PKG bap-frames

‎test/run_frames_tests.ml‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,9 @@
1+
2+
open OUnit2
3+
4+
let suite () =
5+
"Bap-frames" >::: [
6+
Test_enum.suite ();
7+
]
8+
9+
let () = run_test_tt_main (suite ())

0 commit comments

Comments
 (0)