diff --git a/bap-abi.opam b/bap-abi.opam index f9b888bcd..3d506934f 100644 --- a/bap-abi.opam +++ b/bap-abi.opam @@ -9,10 +9,10 @@ tags: ["bap" "bap-pass" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "regular" {= version} diff --git a/bap-analyze.opam b/bap-analyze.opam index 46ecdfa53..563ef40ee 100644 --- a/bap-analyze.opam +++ b/bap-analyze.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-command" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-main" {= version} "bap-std" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "linenoise" {>= "1.1.0" & < "2.0.0"} "monads" {= version} "bap-common" {= version} diff --git a/bap-api.opam b/bap-api.opam index 646e14c57..99b89556a 100644 --- a/bap-api.opam +++ b/bap-api.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-plugin" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "fileutils" "ppx_bap" {= version} "regular" {= version} diff --git a/bap-arm.opam b/bap-arm.opam index b83285d8f..863c7507b 100644 --- a/bap-arm.opam +++ b/bap-arm.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin" "bap-library" "arm"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-api" {= version} "bap-core-theory" {= version} @@ -21,7 +21,7 @@ depends: [ "bap-traces" {= version} "bitvec-order" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "bap-common" {= version} "ogre" {= version} diff --git a/bap-beagle-strings.opam b/bap-beagle-strings.opam index 9a6d57979..c7a2ba231 100644 --- a/bap-beagle-strings.opam +++ b/bap-beagle-strings.opam @@ -9,8 +9,8 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "bap-beagle" {= version} "ppx_bap" {= version} diff --git a/bap-beagle.opam b/bap-beagle.opam index 7270ca63c..de745dace 100644 --- a/bap-beagle.opam +++ b/bap-beagle.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-future" {= version} "bap-microx" {= version} "bap-primus" {= version} "bap-std" {= version} "bap-strings" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "bap-common" {= version} "ppx_bap" {= version} diff --git a/bap-bil.opam b/bap-bil.opam index e83bc7991..c099aea35 100644 --- a/bap-bil.opam +++ b/bap-bil.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-core-theory" {= version} "bap-future" {= version} "bap-knowledge" {= version} @@ -17,7 +17,7 @@ depends: [ "bap-std" {= version} "bitvec-order" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "bap-common" {= version} "ogre" {= version} diff --git a/bap-bml.opam b/bap-bml.opam index e8b751a24..b6c172535 100644 --- a/bap-bml.opam +++ b/bap-bml.opam @@ -9,9 +9,9 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "odoc" {with-doc} diff --git a/bap-build.opam b/bap-build.opam index 91519beba..1a5b66718 100644 --- a/bap-build.opam +++ b/bap-build.opam @@ -9,8 +9,8 @@ tags: ["bap" "bap-tool" "ocamlbuild"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ocamlbuild" "ocamlfind" diff --git a/bap-bundle.opam b/bap-bundle.opam index ac9cc7adf..0837a59c3 100644 --- a/bap-bundle.opam +++ b/bap-bundle.opam @@ -9,9 +9,9 @@ tags: ["bap" "bap-tool"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "camlzip" {>= "1.0" & < "2.0"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "fileutils" "bap-common" {= version} "ppx_bap" {= version} diff --git a/bap-byteweight-frontend.opam b/bap-byteweight-frontend.opam index 82ce3b459..6d410703f 100644 --- a/bap-byteweight-frontend.opam +++ b/bap-byteweight-frontend.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-frontend" "bap-command"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-byteweight" {= version} "bap-std" {= version} "cmdliner" {>= "1.0" & < "2.0"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "fileutils" "bap-common" {= version} "ocurl" {>= "0.9.0"} diff --git a/bap-byteweight.opam b/bap-byteweight.opam index 30eebb787..5340b46f1 100644 --- a/bap-byteweight.opam +++ b/bap-byteweight.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-library" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-signatures" {= version} "bap-std" {= version} "camlzip" {>= "1.0" & < "2.0"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "regular" {= version} diff --git a/bap-c.opam b/bap-c.opam index 03065f4c5..0ff67b9a6 100644 --- a/bap-c.opam +++ b/bap-c.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-library" "c"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-api" {= version} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "odoc" {with-doc} diff --git a/bap-cache.opam b/bap-cache.opam index 5091474c2..d3322c2f0 100644 --- a/bap-cache.opam +++ b/bap-cache.opam @@ -9,10 +9,10 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "fileutils" "mmap" "bap-common" {= version} diff --git a/bap-callgraph-collator.opam b/bap-callgraph-collator.opam index 818d1bba6..4d29a1d3c 100644 --- a/bap-callgraph-collator.opam +++ b/bap-callgraph-collator.opam @@ -9,10 +9,10 @@ tags: ["bap" "bap-analysis"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "graphlib" {= version} "bap-common" {= version} "ppx_bap" {= version} diff --git a/bap-callsites.opam b/bap-callsites.opam index f3ab5be24..1c46c2948 100644 --- a/bap-callsites.opam +++ b/bap-callsites.opam @@ -9,9 +9,9 @@ tags: ["bap" "bap-plugin" "bap-pass"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "odoc" {with-doc} ] diff --git a/bap-common.opam b/bap-common.opam index 38b5e8d38..826ba295e 100644 --- a/bap-common.opam +++ b/bap-common.opam @@ -9,12 +9,12 @@ tags: ["bap" "meta"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "base" {>= "v0.14" & < "v0.16"} - "dune" {>= "3.1"} + "base" {>= "v0.17" & < "v0.18"} + "dune" {>= "3.8"} "dune-configurator" "dune-site" - "ocaml" {> "4.08.0"} - "stdio" {>= "v0.14" & < "v0.16"} + "ocaml" {>= "5.1.0"} + "stdio" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-constant-tracker.opam b/bap-constant-tracker.opam index 5694ea248..947818b0e 100644 --- a/bap-constant-tracker.opam +++ b/bap-constant-tracker.opam @@ -9,10 +9,10 @@ tags: ["bap" "bap-analysis" "bap-plugin" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "odoc" {with-doc} ] diff --git a/bap-core-theory.opam b/bap-core-theory.opam index 23dba49f1..f88dad394 100644 --- a/bap-core-theory.opam +++ b/bap-core-theory.opam @@ -11,14 +11,14 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-knowledge" {= version} "bap-main" {= version} "bitvec" {= version} "bitvec-binprot" {= version} "bitvec-order" {= version} "bitvec-sexp" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "odoc" {with-doc} diff --git a/bap-core.opam b/bap-core.opam index 9e5ecf3e9..1e1fc987e 100644 --- a/bap-core.opam +++ b/bap-core.opam @@ -10,7 +10,7 @@ tags: ["bap" "meta"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-analyze" {= version} "bap-api" {= version} diff --git a/bap-cxxfilt.opam b/bap-cxxfilt.opam index cacc15a35..2046f1464 100644 --- a/bap-cxxfilt.opam +++ b/bap-cxxfilt.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-demangle" {= version} "bap-std" {= version} "conf-binutils" {>= "0.3"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "odoc" {with-doc} ] diff --git a/bap-demangle.opam b/bap-demangle.opam index 35563b8a5..ab813f50c 100644 --- a/bap-demangle.opam +++ b/bap-demangle.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-main" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "odoc" {with-doc} ] diff --git a/bap-dependencies.opam b/bap-dependencies.opam index d7410b4cf..640b94abe 100644 --- a/bap-dependencies.opam +++ b/bap-dependencies.opam @@ -9,10 +9,10 @@ tags: ["bap" "bap-command"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ogre" {= version} "ppx_bap" {= version} diff --git a/bap-disassemble.opam b/bap-disassemble.opam index 86181fbd0..db79e51b3 100644 --- a/bap-disassemble.opam +++ b/bap-disassemble.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-command"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-main" {= version} @@ -19,7 +19,7 @@ depends: [ "bitvec-order" {= version} "bitvec-sexp" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "bap-common" {= version} "ogre" {= version} diff --git a/bap-dump-symbols.opam b/bap-dump-symbols.opam index f5e68a388..a8b15e0dc 100644 --- a/bap-dump-symbols.opam +++ b/bap-dump-symbols.opam @@ -9,9 +9,9 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "graphlib" {= version} "bap-common" {= version} "ppx_bap" {= version} diff --git a/bap-dwarf.opam b/bap-dwarf.opam index 04f466622..3f81e5d1d 100644 --- a/bap-dwarf.opam +++ b/bap-dwarf.opam @@ -9,9 +9,9 @@ tags: ["bap" "bap-library" "dwarf"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "regular" {= version} diff --git a/bap-elementary.opam b/bap-elementary.opam index 23ada57ad..91b354e12 100644 --- a/bap-elementary.opam +++ b/bap-elementary.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-library" "floating-points"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-std" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-elf.opam b/bap-elf.opam index 000bfa8e4..2807bcd85 100644 --- a/bap-elf.opam +++ b/bap-elf.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-plugin" "elf"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-dwarf" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} - "ppx_bitstring" {>= "4.0.0" & < "5.0.0"} + "ppx_bitstring" {>= "4.0.0"} "regular" {= version} "odoc" {with-doc} ] diff --git a/bap-extra.opam b/bap-extra.opam index 73afb837f..b03168bf6 100644 --- a/bap-extra.opam +++ b/bap-extra.opam @@ -10,7 +10,7 @@ tags: ["bap" "meta"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap" {= version} "bap-byteweight-frontend" {= version} "bap-elf" {= version} diff --git a/bap-flatten.opam b/bap-flatten.opam index bbd4f305a..1d1e50ec0 100644 --- a/bap-flatten.opam +++ b/bap-flatten.opam @@ -9,9 +9,9 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "odoc" {with-doc} ] diff --git a/bap-frontc.opam b/bap-frontc.opam index aaa71bcb4..31a327946 100644 --- a/bap-frontc.opam +++ b/bap-frontc.opam @@ -9,10 +9,10 @@ tags: ["bap" "bap-plugin" "c"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-c" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "FrontC" {>= "4.1.0"} "bap-common" {= version} "odoc" {with-doc} diff --git a/bap-frontend.opam b/bap-frontend.opam index 9352f4ce0..f3279a95e 100644 --- a/bap-frontend.opam +++ b/bap-frontend.opam @@ -9,12 +9,12 @@ tags: ["bap" "bap-command"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ocamlfind" "regular" {= version} diff --git a/bap-future.opam b/bap-future.opam index f3de322c7..6430511ad 100644 --- a/bap-future.opam +++ b/bap-future.opam @@ -11,8 +11,8 @@ tags: ["bap" "future"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "bap-common" {= version} "odoc" {with-doc} diff --git a/bap-ghidra.opam b/bap-ghidra.opam index eead1e0f5..9d6a9f39a 100644 --- a/bap-ghidra.opam +++ b/bap-ghidra.opam @@ -9,8 +9,8 @@ tags: ["bap" "ghidra" "disassembler"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ppx_bap" {= version} "bap-common" {= version} "bap-std" {= version} diff --git a/bap-glibc-runtime.opam b/bap-glibc-runtime.opam index e45ad10b0..072455f8b 100644 --- a/bap-glibc-runtime.opam +++ b/bap-glibc-runtime.opam @@ -9,12 +9,12 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-c" {= version} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ogre" {= version} "odoc" {with-doc} diff --git a/bap-ida-plugin.opam b/bap-ida-plugin.opam index 64e0120f6..091095dcc 100644 --- a/bap-ida-plugin.opam +++ b/bap-ida-plugin.opam @@ -9,9 +9,9 @@ tags: ["bap" "bap-plugin" "bap-ida" "ida-pro"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "regular" {= version} diff --git a/bap-ida.opam b/bap-ida.opam index 3e7a7c1c8..7c3a75ece 100644 --- a/bap-ida.opam +++ b/bap-ida.opam @@ -9,8 +9,8 @@ tags: ["bap" "bap-library" "ida-pro"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "regular" {= version} "fileutils" "bap-common" {= version} diff --git a/bap-knowledge.opam b/bap-knowledge.opam index 0d7ace58d..e7ce1188b 100644 --- a/bap-knowledge.opam +++ b/bap-knowledge.opam @@ -9,8 +9,8 @@ tags: ["bap" "bap-library" "knowledge"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ppx_bap" {= version} "bap-common" {= version} "monads" {= version} diff --git a/bap-llvm.opam b/bap-llvm.opam index fbcfcc1a2..c2b3714ee 100644 --- a/bap-llvm.opam +++ b/bap-llvm.opam @@ -9,10 +9,10 @@ tags: ["bap" "bap-plugin" "llvm"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-std" {= version} "conf-bap-llvm" {>= "1.8"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "mmap" "monads" {= version} "bap-common" {= version} diff --git a/bap-main.opam b/bap-main.opam index 1384328d1..1ea2f4ae8 100644 --- a/bap-main.opam +++ b/bap-main.opam @@ -9,15 +9,15 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-build" {= version} "bap-future" {= version} "bap-plugins" {= version} "bap-recipe" {= version} - "base" {>= "v0.14" & < "v0.16"} + "base" {>= "v0.17" & < "v0.18"} "cmdliner" {>= "1.0" & < "2.0"} "bap-common" {= version} - "stdio" {>= "v0.14" & < "v0.16"} + "stdio" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-mc.opam b/bap-mc.opam index 40a9a4496..9e0896d0b 100644 --- a/bap-mc.opam +++ b/bap-mc.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-command"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-main" {= version} "bap-std" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ogre" {= version} "ppx_bap" {= version} diff --git a/bap-microx.opam b/bap-microx.opam index 5ca6452db..b92fa299d 100644 --- a/bap-microx.opam +++ b/bap-microx.opam @@ -9,9 +9,9 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "bap-common" {= version} "ppx_bap" {= version} diff --git a/bap-mips.opam b/bap-mips.opam index f1ea9e606..8a630b1a8 100644 --- a/bap-mips.opam +++ b/bap-mips.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin" "mips"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-api" {= version} "bap-core-theory" {= version} @@ -17,7 +17,7 @@ depends: [ "bap-knowledge" {= version} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ogre" {= version} "ppx_bap" {= version} diff --git a/bap-objdump.opam b/bap-objdump.opam index 0aebe19d9..192453d16 100644 --- a/bap-objdump.opam +++ b/bap-objdump.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-main" {= version} @@ -19,7 +19,7 @@ depends: [ "bitvec-sexp" {= version} "bitvec" {= version} "conf-binutils" {>= "0.3"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "re" {>= "1.0" & < "2.0"} diff --git a/bap-optimization.opam b/bap-optimization.opam index 3a7cc8a3c..232290c88 100644 --- a/bap-optimization.opam +++ b/bap-optimization.opam @@ -9,8 +9,8 @@ tags: ["bap" "bap-plugin" "bap-pass"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "bap-std" {= version} diff --git a/bap-patterns.opam b/bap-patterns.opam index 7b9676e8b..f91705735 100644 --- a/bap-patterns.opam +++ b/bap-patterns.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin" "bap-command"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-main" {= version} @@ -20,7 +20,7 @@ depends: [ "bitvec-order" {= version} "bitvec-sexp" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "fileutils" "bap-common" {= version} "ppx_bap" {= version} diff --git a/bap-phoenix.opam b/bap-phoenix.opam index d8abb8ba0..10c5cb141 100644 --- a/bap-phoenix.opam +++ b/bap-phoenix.opam @@ -9,12 +9,11 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-std" {= version} "cmdliner" - "cmdliner" {>= "1.0" & < "2.0"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ezjsonm" "graphlib" {= version} "ppx_bap" {= version} diff --git a/bap-piqi.opam b/bap-piqi.opam deleted file mode 100644 index 61b3b62ab..000000000 --- a/bap-piqi.opam +++ /dev/null @@ -1,35 +0,0 @@ -# This file is generated by dune, edit dune-project instead -opam-version: "2.0" -version: "dev" -synopsis: "Serializes BAP Project in various formats using piqi" -maintainer: ["Ivan Gotovchits "] -authors: ["The BAP Team"] -license: "MIT" -tags: ["bap" "bap-plugin"] -homepage: "https://github.com/BinaryAnalysisPlatform/bap" -bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" -depends: [ - "dune" {>= "3.1"} - "bap-common" {= version} - "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} - "piqi" {>= "0.7.8"} - "odoc" {with-doc} -] -build: [ - ["dune" "subst"] {dev} - [ - "dune" - "build" - "-p" - name - "-j" - jobs - "--promote-install-files=false" - "@install" - "@runtest" {with-test} - "@doc" {with-doc} - ] - ["dune" "install" "-p" name "--create-install-files" name] -] -dev-repo: "git+https://github.com/BinaryAnalysisPlatform/bap.git" diff --git a/bap-plugins.opam b/bap-plugins.opam index 784ef9f73..91dba4d41 100644 --- a/bap-plugins.opam +++ b/bap-plugins.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-bundle" {= version} "bap-future" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "fileutils" "ocamlfind" "ppx_bap" {= version} diff --git a/bap-powerpc.opam b/bap-powerpc.opam index ac5cee521..bda618443 100644 --- a/bap-powerpc.opam +++ b/bap-powerpc.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin" "powerpc"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-api" {= version} "bap-common" {= version} @@ -18,7 +18,7 @@ depends: [ "bap-knowledge" {= version} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "ogre" {= version} "ppx_bap" {= version} diff --git a/bap-primus-dictionary.opam b/bap-primus-dictionary.opam index 450a6485a..0d18481d6 100644 --- a/bap-primus-dictionary.opam +++ b/bap-primus-dictionary.opam @@ -9,12 +9,12 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-core-theory" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-primus-exploring-scheduler.opam b/bap-primus-exploring-scheduler.opam index e8d0b2bf0..c5ebf915c 100644 --- a/bap-primus-exploring-scheduler.opam +++ b/bap-primus-exploring-scheduler.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-greedy-scheduler.opam b/bap-primus-greedy-scheduler.opam index e8d0b2bf0..c5ebf915c 100644 --- a/bap-primus-greedy-scheduler.opam +++ b/bap-primus-greedy-scheduler.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-limit.opam b/bap-primus-limit.opam index b461ad79a..bb94d2a07 100644 --- a/bap-primus-limit.opam +++ b/bap-primus-limit.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-primus-lisp.opam b/bap-primus-lisp.opam index 1b2adc595..f9ffbbbc5 100644 --- a/bap-primus-lisp.opam +++ b/bap-primus-lisp.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-core-theory" {= version} "bap-knowledge" {= version} @@ -17,7 +17,7 @@ depends: [ "bap-primus" {= version} "bap-std" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "regular" {= version} "odoc" {with-doc} diff --git a/bap-primus-loader.opam b/bap-primus-loader.opam index d8072e954..fbc4915de 100644 --- a/bap-primus-loader.opam +++ b/bap-primus-loader.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ogre" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-mark-visited.opam b/bap-primus-mark-visited.opam index f0dbd8429..ae9e61222 100644 --- a/bap-primus-mark-visited.opam +++ b/bap-primus-mark-visited.opam @@ -9,12 +9,12 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus-track-visited" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-primus-powerpc.opam b/bap-primus-powerpc.opam index ca01881cc..ead6a4fe6 100644 --- a/bap-primus-powerpc.opam +++ b/bap-primus-powerpc.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-primus-print.opam b/bap-primus-print.opam index 9c7a5e889..852aa4efa 100644 --- a/bap-primus-print.opam +++ b/bap-primus-print.opam @@ -9,14 +9,14 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-core-theory" {= version} "bap-future" {= version} "bap-primus" {= version} "bap-std" {= version} "bare" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-promiscuous.opam b/bap-primus-promiscuous.opam index b98fbb057..5cfd499a0 100644 --- a/bap-primus-promiscuous.opam +++ b/bap-primus-promiscuous.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-propagate-taint.opam b/bap-primus-propagate-taint.opam index 849dcf30f..e71fa56e0 100644 --- a/bap-primus-propagate-taint.opam +++ b/bap-primus-propagate-taint.opam @@ -9,12 +9,12 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} "bap-taint" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-random.opam b/bap-primus-random.opam index 6c2fe76a2..54a13403f 100644 --- a/bap-primus-random.opam +++ b/bap-primus-random.opam @@ -9,14 +9,14 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-main" {= version} "bap-primus" {= version} "bap-std" {= version} "bitvec-sexp" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "zarith" "odoc" {with-doc} diff --git a/bap-primus-region.opam b/bap-primus-region.opam index c331c980c..797271912 100644 --- a/bap-primus-region.opam +++ b/bap-primus-region.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus" "bap-primus-lisp"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-round-robin-scheduler.opam b/bap-primus-round-robin-scheduler.opam index e8d0b2bf0..c5ebf915c 100644 --- a/bap-primus-round-robin-scheduler.opam +++ b/bap-primus-round-robin-scheduler.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-support.opam b/bap-primus-support.opam index f111dfd89..dd8651a36 100644 --- a/bap-primus-support.opam +++ b/bap-primus-support.opam @@ -9,7 +9,7 @@ tags: ["bap" "meta"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-primus-exploring-scheduler" {= version} "bap-primus-greedy-scheduler" {= version} "bap-primus-limit" {= version} diff --git a/bap-primus-symbolic-executor.opam b/bap-primus-symbolic-executor.opam index c8bae944b..2a7e8e3a9 100644 --- a/bap-primus-symbolic-executor.opam +++ b/bap-primus-symbolic-executor.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-primus-track-visited" {= version} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "regular" {= version} "bitvec" {= version} diff --git a/bap-primus-systems.opam b/bap-primus-systems.opam index a5ea180a2..6ceb4742d 100644 --- a/bap-primus-systems.opam +++ b/bap-primus-systems.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-knowledge" {= version} "bap-main" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-taint.opam b/bap-primus-taint.opam index 26e77081b..bccec681a 100644 --- a/bap-primus-taint.opam +++ b/bap-primus-taint.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-taint" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-test.opam b/bap-primus-test.opam index 93c8c67ad..520935b0b 100644 --- a/bap-primus-test.opam +++ b/bap-primus-test.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-primus-track-visited.opam b/bap-primus-track-visited.opam index b9b4d4b4e..3246fee56 100644 --- a/bap-primus-track-visited.opam +++ b/bap-primus-track-visited.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-primus-wandering-scheduler.opam b/bap-primus-wandering-scheduler.opam index e8d0b2bf0..c5ebf915c 100644 --- a/bap-primus-wandering-scheduler.opam +++ b/bap-primus-wandering-scheduler.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "odoc" {with-doc} ] diff --git a/bap-primus-x86.opam b/bap-primus-x86.opam index 8287f7ff6..c68dd76f2 100644 --- a/bap-primus-x86.opam +++ b/bap-primus-x86.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-x86" {= version} "odoc" {with-doc} ] diff --git a/bap-primus.opam b/bap-primus.opam index c5d395e63..93d9eb2cb 100644 --- a/bap-primus.opam +++ b/bap-primus.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-library" "bap-primus"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-common" {= version} "bap-core-theory" {= version} @@ -20,10 +20,10 @@ depends: [ "bap-strings" {= version} "bitvec-binprot" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "graphlib" {= version} "monads" {= version} - "parsexp" {>= "v0.14" & < "v0.16"} + "parsexp" {>= "v0.17" & < "v0.18"} "ppx_bap" {= version} "regular" {= version} "uuidm" {>= "0.9.7"} diff --git a/bap-print.opam b/bap-print.opam index e96015b10..344980490 100644 --- a/bap-print.opam +++ b/bap-print.opam @@ -9,12 +9,12 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-demangle" {= version} "bap-knowledge" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "graphlib" {= version} "ogre" {= version} "ppx_bap" {= version} diff --git a/bap-radare2.opam b/bap-radare2.opam index 6dec2df3f..3d0c5265b 100644 --- a/bap-radare2.opam +++ b/bap-radare2.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin" "radare2"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-arm" {= version} "bap-common" {= version} @@ -21,7 +21,7 @@ depends: [ "bap-std" {= version} "bitvec" {= version} "conf-radare2" - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ogre" {= version} "ppx_bap" {= version} "re" {>= "1.0" & < "2.0"} diff --git a/bap-raw.opam b/bap-raw.opam index 8d8a4935d..2c665d437 100644 --- a/bap-raw.opam +++ b/bap-raw.opam @@ -9,8 +9,8 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "bap-std" {= version} diff --git a/bap-recipe-command.opam b/bap-recipe-command.opam index 1c83d1688..7aebcfa7c 100644 --- a/bap-recipe-command.opam +++ b/bap-recipe-command.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-command" "bap-tool"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-main" {= version} "bap-recipe" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-recipe.opam b/bap-recipe.opam index 30bfdf7d2..84a3d9698 100644 --- a/bap-recipe.opam +++ b/bap-recipe.opam @@ -11,10 +11,10 @@ tags: ["bap" "bap-tool" "command-line"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} - "parsexp" {>= "v0.14" & < "v0.16"} - "stdio" {>= "v0.14" & < "v0.16"} + "parsexp" {>= "v0.17" & < "v0.18"} + "stdio" {>= "v0.17" & < "v0.18"} "stdlib-shims" "uuidm" {>= "0.9.7"} "odoc" {with-doc} diff --git a/bap-relation.opam b/bap-relation.opam index a4169dc0a..ae2bc85f8 100644 --- a/bap-relation.opam +++ b/bap-relation.opam @@ -11,7 +11,7 @@ tags: ["bap" "data-structure"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "odoc" {with-doc} ] diff --git a/bap-relocatable.opam b/bap-relocatable.opam index 5ca8913cd..62adaee03 100644 --- a/bap-relocatable.opam +++ b/bap-relocatable.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-arm" {= version} "bap-common" {= version} @@ -23,7 +23,7 @@ depends: [ "bitvec-order" {= version} "bitvec-sexp" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "ogre" {= version} "ppx_bap" {= version} diff --git a/bap-report.opam b/bap-report.opam index bd1decb2c..53e0df24a 100644 --- a/bap-report.opam +++ b/bap-report.opam @@ -9,8 +9,8 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "bap-std" {= version} "odoc" {with-doc} diff --git a/bap-riscv.opam b/bap-riscv.opam index ba986487e..fd1b3b508 100644 --- a/bap-riscv.opam +++ b/bap-riscv.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin" "riscv"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-api" {= version} "bap-common" {= version} @@ -17,7 +17,7 @@ depends: [ "bap-c" {= version} "bap-knowledge" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "ogre" {= version} "ppx_bap" {= version} diff --git a/bap-run.opam b/bap-run.opam index 38acb0bfb..a2b63d7ff 100644 --- a/bap-run.opam +++ b/bap-run.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-primus" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "graphlib" {= version} "monads" {= version} "regular" {= version} diff --git a/bap-signatures.opam b/bap-signatures.opam index 2a6d77568..7293e31d8 100644 --- a/bap-signatures.opam +++ b/bap-signatures.opam @@ -9,7 +9,7 @@ tags: ["bap" "data"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "odoc" {with-doc} ] dev-repo: "git+https://github.com/BinaryAnalysisPlatform/bap.git" diff --git a/bap-specification.opam b/bap-specification.opam index 74e4dff1d..a84f53219 100644 --- a/bap-specification.opam +++ b/bap-specification.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-command"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ogre" {= version} "odoc" {with-doc} ] diff --git a/bap-ssa.opam b/bap-ssa.opam index bbf6c0638..055aa5c1e 100644 --- a/bap-ssa.opam +++ b/bap-ssa.opam @@ -9,10 +9,10 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-std.opam b/bap-std.opam index 91c0c275b..d18af7e8c 100644 --- a/bap-std.opam +++ b/bap-std.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-bundle" {= version} "bap-core-theory" {= version} @@ -23,12 +23,12 @@ depends: [ "bitvec" {= version} "camlzip" {>= "1.07" & < "2.0"} "cmdliner" - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "fileutils" "graphlib" {= version} "mmap" "monads" {= version} - "ocamlfind" {>= "1.5.6" & < "2.0.0"} + "ocamlfind" {>= "1.9.0" & < "2.0.0"} "ogre" {= version} "ounit" "ppx_bap" {= version} diff --git a/bap-strings.opam b/bap-strings.opam index 2a1970abd..87754a48c 100644 --- a/bap-strings.opam +++ b/bap-strings.opam @@ -21,8 +21,8 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "ppx_bap" {= version} "odoc" {with-doc} diff --git a/bap-stub-resolver.opam b/bap-stub-resolver.opam index d1dd3c727..82f9e8c29 100644 --- a/bap-stub-resolver.opam +++ b/bap-stub-resolver.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-common" {= version} "bap-core-theory" {= version} @@ -19,7 +19,7 @@ depends: [ "bitvec-order" {= version} "bitvec-sexp" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ogre" {= version} "ppx_bap" {= version} "odoc" {with-doc} diff --git a/bap-symbol-reader.opam b/bap-symbol-reader.opam index f4a6d0124..1eee24de3 100644 --- a/bap-symbol-reader.opam +++ b/bap-symbol-reader.opam @@ -9,14 +9,14 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-main" {= version} "bap-relation" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bap-systemz.opam b/bap-systemz.opam index 46f2949d4..64edfdd52 100644 --- a/bap-systemz.opam +++ b/bap-systemz.opam @@ -9,14 +9,14 @@ tags: ["bap" "bap-plugins"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-core-theory" {= version} "bap-knowledge" {= version} "bap-main" {= version} "bap-std" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ogre" {= version} "ppx_bap" {= version} "odoc" {with-doc} diff --git a/bap-taint-propagator.opam b/bap-taint-propagator.opam index b7918b6cc..13998ac9f 100644 --- a/bap-taint-propagator.opam +++ b/bap-taint-propagator.opam @@ -9,11 +9,11 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-core-theory" {= version} "bap-microx" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "graphlib" {= version} "monads" {= version} "regular" {= version} diff --git a/bap-taint.opam b/bap-taint.opam index 4fc2a1581..d14c3e1b8 100644 --- a/bap-taint.opam +++ b/bap-taint.opam @@ -9,12 +9,12 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-primus" {= version} "bap-std" {= version} "bap-strings" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "monads" {= version} "ppx_bap" {= version} "regular" {= version} diff --git a/bap-term-mapper.opam b/bap-term-mapper.opam index b57b3d56c..7a0566e7b 100644 --- a/bap-term-mapper.opam +++ b/bap-term-mapper.opam @@ -9,12 +9,12 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-bml" {= version} "bap-common" {= version} "bap-main" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ppx_bap" {= version} "regular" {= version} "odoc" {with-doc} diff --git a/bap-thumb.opam b/bap-thumb.opam index 96c77c4bc..7704ed6ef 100644 --- a/bap-thumb.opam +++ b/bap-thumb.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-arm" {= version} "bap-common" {= version} "bap-core-theory" {= version} @@ -17,7 +17,7 @@ depends: [ "bap-main" {= version} "bap-std" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ogre" {= version} "ppx_bap" {= version} "odoc" {with-doc} diff --git a/bap-toplevel.opam b/bap-toplevel.opam index 3c4179888..b549ecfde 100644 --- a/bap-toplevel.opam +++ b/bap-toplevel.opam @@ -11,10 +11,10 @@ tags: ["bap" "toplevel"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ocamlfind" "odoc" {with-doc} ] diff --git a/bap-trace.opam b/bap-trace.opam index 3d18922c2..de4012802 100644 --- a/bap-trace.opam +++ b/bap-trace.opam @@ -9,13 +9,13 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-future" {= version} "bap-plugins" {= version} "bap-std" {= version} "bap-traces" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ppx_bap" {= version} "regular" {= version} "uri" diff --git a/bap-traces.opam b/bap-traces.opam index fd3a34b41..496577ab9 100644 --- a/bap-traces.opam +++ b/bap-traces.opam @@ -9,10 +9,10 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} "bap-std" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ppx_bap" {= version} "regular" {= version} "uri" {>= "1.9.0"} diff --git a/bap-trivial-condition-form.opam b/bap-trivial-condition-form.opam index c4ae59347..653d09000 100644 --- a/bap-trivial-condition-form.opam +++ b/bap-trivial-condition-form.opam @@ -9,8 +9,8 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "bap-std" {= version} "odoc" {with-doc} diff --git a/bap-warn-unused.opam b/bap-warn-unused.opam index 0bb27692c..ee2adfb07 100644 --- a/bap-warn-unused.opam +++ b/bap-warn-unused.opam @@ -9,8 +9,8 @@ tags: ["bap" "bap-plugin"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "bap-std" {= version} "odoc" {with-doc} diff --git a/bap-x86.opam b/bap-x86.opam index 4305b3a1a..7745cfb57 100644 --- a/bap-x86.opam +++ b/bap-x86.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-plugin" "bap-library" "x86" "x86-64"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-abi" {= version} "bap-api" {= version} "bap-common" {= version} @@ -23,7 +23,7 @@ depends: [ "bap-primus" {= version} "bap-std" {= version} "bitvec" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ogre" {= version} "ppx_bap" {= version} "regular" {= version} diff --git a/bap.opam b/bap.opam index c55fb23e2..af65bb6f6 100644 --- a/bap.opam +++ b/bap.opam @@ -9,7 +9,7 @@ tags: ["bap" "meta"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-core" {= version} "bap-beagle" {= version} "bap-beagle-strings" {= version} diff --git a/bare.opam b/bare.opam index 3cd1fc74d..01836e872 100644 --- a/bare.opam +++ b/bare.opam @@ -11,10 +11,10 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} - "parsexp" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} + "parsexp" {>= "v0.17" & < "v0.18"} "odoc" {with-doc} ] build: [ diff --git a/bitvec-binprot.opam b/bitvec-binprot.opam index 3d7b3f5fa..f077606b3 100644 --- a/bitvec-binprot.opam +++ b/bitvec-binprot.opam @@ -9,8 +9,8 @@ tags: ["bap"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "bin_prot" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "bin_prot" {>= "v0.17" & < "v0.18"} "bitvec" {= version} "ppx_bap" {= version} "odoc" {with-doc} diff --git a/bitvec-order.opam b/bitvec-order.opam index a600fc070..fdc69b90d 100644 --- a/bitvec-order.opam +++ b/bitvec-order.opam @@ -9,8 +9,8 @@ tags: ["bap"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "base" {>= "v0.14"} + "dune" {>= "3.8"} + "base" {>= "v0.16"} "bitvec-sexp" {= version} "bitvec" {= version} "odoc" {with-doc} diff --git a/bitvec-sexp.opam b/bitvec-sexp.opam index d8259050c..bf3499749 100644 --- a/bitvec-sexp.opam +++ b/bitvec-sexp.opam @@ -9,8 +9,8 @@ tags: ["bap" "sexp"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} - "sexplib0" {>= "v0.14"} + "dune" {>= "3.8"} + "sexplib0" {>= "v0.16"} "bitvec" {= version} "odoc" {with-doc} ] diff --git a/bitvec.opam b/bitvec.opam index 1e4555cad..82e278e7b 100644 --- a/bitvec.opam +++ b/bitvec.opam @@ -9,7 +9,7 @@ tags: ["bap" "bap-library"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "zarith" {>= "1.4"} "odoc" {with-doc} ] diff --git a/dune b/dune index 7aba364fb..47ff7c955 100644 --- a/dune +++ b/dune @@ -3,6 +3,8 @@ (flags (:standard -warn-error -A -w -6-9-27-32..34-37-50-58)) + (ocamlopt_flags (:standard -O3))) + (release (ocamlopt_flags (:standard -O3)))) diff --git a/dune-project b/dune-project index 52e68ced4..3cece679b 100644 --- a/dune-project +++ b/dune-project @@ -1,4 +1,4 @@ -(lang dune 3.1) +(lang dune 3.8) (cram enable) (using dune_site 0.1) @@ -136,12 +136,12 @@ (share signatures) (share site_lisp)) (depends - (base (and (>= v0.14) (< v0.16))) + (base (and (>= v0.17) (< v0.18))) dune dune-configurator dune-site - (ocaml (> 4.08.0)) - (stdio (and (>= v0.14) (< v0.16))))) + (ocaml (>= 5.1.0)) + (stdio (and (>= v0.17) (< v0.18))))) (package (name bap-primus-support) @@ -176,7 +176,7 @@ (depends (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)) (regular (= :version)))) @@ -191,7 +191,7 @@ (bap-main (= :version)) (bap-std (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (linenoise (and (>= 1.1.0) (< 2.0.0))) (monads (= :version)) (bap-common (= :version)) @@ -204,7 +204,7 @@ (depends (bap-common (= :version)) (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) fileutils (ppx_bap (= :version)) (regular (= :version)))) @@ -225,7 +225,7 @@ (bap-traces (= :version)) (bitvec-order (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (bap-common (= :version)) (ogre (= :version)) @@ -243,7 +243,7 @@ (bap-primus (= :version)) (bap-std (= :version)) (bap-strings (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (bap-common (= :version)) (ppx_bap (= :version)) @@ -261,7 +261,7 @@ (bap-std (= :version)) (bitvec-order (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (bap-common (= :version)) (ogre (= :version)) @@ -273,7 +273,7 @@ (tags (bap bap-library)) (depends (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)))) @@ -285,7 +285,7 @@ (bap-signatures (= :version)) (bap-std (= :version)) (camlzip (and (>= 1.0) (< 2.0))) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)) (regular (= :version)) @@ -299,7 +299,7 @@ (bap-byteweight (= :version)) (bap-std (= :version)) (cmdliner (and (>= 1.0) (< 2.0))) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) fileutils (bap-common (= :version)) (ocurl (>= 0.9.0)) @@ -311,7 +311,7 @@ (synopsis "BAP Build Tool (ocamlbuild+bap)") (tags (bap bap-tool ocamlbuild)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) ocamlbuild ocamlfind @@ -323,7 +323,7 @@ (tags (bap bap-tool)) (depends (camlzip (and (>= 1.0) (< 2.0))) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) fileutils (bap-common (= :version)) (ppx_bap (= :version)) @@ -339,7 +339,7 @@ (bap-core-theory (= :version)) (bap-knowledge (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)))) @@ -350,7 +350,7 @@ (depends (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) fileutils mmap (bap-common (= :version)) @@ -365,7 +365,7 @@ (depends (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (graphlib (= :version)) (bap-common (= :version)) (ppx_bap (= :version)) @@ -378,7 +378,7 @@ (tags (bap bap-plugin bap-pass)) (depends (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)))) (package @@ -398,7 +398,7 @@ details of the program behavior.") (bitvec-binprot (= :version)) (bitvec-order (= :version)) (bitvec-sexp (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)))) @@ -409,7 +409,7 @@ details of the program behavior.") (depends (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)))) (package @@ -420,7 +420,7 @@ details of the program behavior.") (bap-demangle (= :version)) (bap-std (= :version)) (conf-binutils (>= 0.3)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)))) (package @@ -431,7 +431,7 @@ details of the program behavior.") (bap-core-theory (= :version)) (bap-knowledge (= :version)) (bap-main (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)))) (package @@ -441,7 +441,7 @@ details of the program behavior.") (depends (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ogre (= :version)) (ppx_bap (= :version)) @@ -461,7 +461,7 @@ details of the program behavior.") (bitvec-order (= :version)) (bitvec-sexp (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (bap-common (= :version)) (ogre (= :version)) @@ -474,7 +474,7 @@ details of the program behavior.") (tags (bap bap-plugin)) (depends (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (graphlib (= :version)) (bap-common (= :version)) (ppx_bap (= :version)) @@ -486,7 +486,7 @@ details of the program behavior.") (tags (bap bap-library dwarf)) (depends (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)) (regular (= :version)))) @@ -501,7 +501,7 @@ details of the program behavior.") (bap-knowledge (= :version)) (bap-std (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-elf) @@ -510,10 +510,10 @@ details of the program behavior.") (depends (bap-dwarf (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)) - (ppx_bitstring (and (>= 4.0.0) (< 5.0.0))) + (ppx_bitstring (>= 4.0.0)) (regular (= :version)))) (package @@ -522,7 +522,7 @@ details of the program behavior.") (tags (bap bap-plugin)) (depends (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)))) (package @@ -534,7 +534,7 @@ details of the program behavior.") (bap-knowledge (= :version)) (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) ocamlfind (regular (= :version)))) @@ -546,7 +546,7 @@ details of the program behavior.") (depends (bap-c (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (FrontC (>= 4.1.0)) (bap-common (= :version)))) @@ -558,7 +558,7 @@ A library for reasoning about state based dynamic systems. This can \ be seen as a common denominator between Lwt and Async libraries.") (tags (bap future)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (bap-common (= :version)))) @@ -568,7 +568,7 @@ be seen as a common denominator between Lwt and Async libraries.") (tags (bap ghidra disassembler)) (allow_empty) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ppx_bap (= :version)) (bap-common (= :version)) (bap-std (= :version)) @@ -583,7 +583,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-c (= :version)) (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ogre (= :version)))) @@ -591,7 +591,7 @@ be seen as a common denominator between Lwt and Async libraries.") (synopsis "BAP IDA Pro integration") (tags (bap bap-library ida-pro)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (regular (= :version)) fileutils (bap-common (= :version)) @@ -604,7 +604,7 @@ be seen as a common denominator between Lwt and Async libraries.") (tags (bap bap-plugin bap-ida ida-pro)) (depends (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)) (regular (= :version)))) @@ -614,7 +614,7 @@ be seen as a common denominator between Lwt and Async libraries.") (synopsis "Knowledge Reasoning and Representation Framework") (tags (bap bap-library knowledge)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ppx_bap (= :version)) (bap-common (= :version)) (monads (= :version)))) @@ -626,7 +626,7 @@ be seen as a common denominator between Lwt and Async libraries.") (depends (bap-std (= :version)) (conf-bap-llvm (>= 1.8)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) mmap (monads (= :version)) (bap-common (= :version)) @@ -642,10 +642,10 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-future (= :version)) (bap-plugins (= :version)) (bap-recipe (= :version)) - (base (and (>= v0.14) (< v0.16))) + (base (and (>= v0.17) (< v0.18))) (cmdliner (and (>= 1.0) (< 2.0))) (bap-common (= :version)) - (stdio (and (>= v0.14) (< v0.16))))) + (stdio (and (>= v0.17) (< v0.18))))) (package (name bap-mc) @@ -657,7 +657,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-main (= :version)) (bap-std (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ogre (= :version)) (ppx_bap (= :version)) @@ -669,7 +669,7 @@ be seen as a common denominator between Lwt and Async libraries.") (tags (bap bap-plugin)) (depends (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (bap-common (= :version)) (ppx_bap (= :version)))) @@ -686,7 +686,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-knowledge (= :version)) (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ogre (= :version)) (ppx_bap (= :version)) @@ -707,7 +707,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bitvec-sexp (= :version)) (bitvec (= :version)) (conf-binutils (>= 0.3)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)) (re (and (>= 1.0) (< 2.0))))) @@ -717,7 +717,7 @@ be seen as a common denominator between Lwt and Async libraries.") (synopsis "A BAP IR optimization pass") (tags (bap bap-plugin bap-pass)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)) (bap-std (= :version)) @@ -739,7 +739,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bitvec-order (= :version)) (bitvec-sexp (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) fileutils (bap-common (= :version)) (ppx_bap (= :version)) @@ -754,24 +754,13 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-std (= :version)) cmdliner - (cmdliner (and (>= 1.0) (< 2.0))) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) ezjsonm (graphlib (= :version)) (ppx_bap (= :version)) (regular (= :version)) (text-tags (= :version)))) -(package - (name bap-piqi) - (synopsis "Serializes BAP Project in various formats using piqi") - (tags (bap bap-plugin)) - (depends - (bap-common (= :version)) - (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) - (piqi (>= 0.7.8)))) - (package (name bap-plugins) (synopsis "BAP Plugin management library") @@ -780,7 +769,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-bundle (= :version)) (bap-future (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) fileutils ocamlfind (ppx_bap (= :version)) @@ -799,7 +788,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-knowledge (= :version)) (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (ogre (= :version)) (ppx_bap (= :version)) @@ -821,10 +810,10 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-strings (= :version)) (bitvec-binprot (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (graphlib (= :version)) (monads (= :version)) - (parsexp (and (>= v0.14) (< v0.16))) + (parsexp (and (>= v0.17) (< v0.18))) (ppx_bap (= :version)) (regular (= :version)) (uuidm (>= 0.9.7)))) @@ -838,7 +827,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-core-theory (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-primus-exploring-scheduler) @@ -848,7 +837,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)))) (package @@ -859,7 +848,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)))) (package @@ -870,7 +859,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-primus-lisp) @@ -884,7 +873,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-primus (= :version)) (bap-std (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (regular (= :version)))) @@ -896,7 +885,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ogre (= :version)))) (package @@ -908,7 +897,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-primus-track-visited (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-primus-powerpc) @@ -918,7 +907,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-primus-print) @@ -931,7 +920,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-primus (= :version)) (bap-std (= :version)) (bare (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)))) (package @@ -942,7 +931,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)))) (package @@ -954,7 +943,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-primus (= :version)) (bap-std (= :version)) (bap-taint (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)))) (package @@ -968,7 +957,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-std (= :version)) (bitvec-sexp (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) zarith)) @@ -980,7 +969,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)))) (package @@ -991,7 +980,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)))) (package @@ -1005,7 +994,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-primus-track-visited (= :version)) (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (regular (= :version)) (bitvec (= :version)) @@ -1022,7 +1011,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-main (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)))) (package @@ -1033,7 +1022,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-taint (= :version)))) (package @@ -1044,7 +1033,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-primus-track-visited) @@ -1054,7 +1043,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-primus-wandering-scheduler) @@ -1064,7 +1053,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)))) (package @@ -1075,7 +1064,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-common (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-x86 (= :version)))) (package @@ -1087,7 +1076,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-demangle (= :version)) (bap-knowledge (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (graphlib (= :version)) (ogre (= :version)) (ppx_bap (= :version)) @@ -1112,7 +1101,7 @@ be seen as a common denominator between Lwt and Async libraries.") (bap-std (= :version)) (bitvec (= :version)) conf-radare2 - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ogre (= :version)) (ppx_bap (= :version)) (re (and (>= 1.0) (< 2.0))) @@ -1124,7 +1113,7 @@ be seen as a common denominator between Lwt and Async libraries.") (synopsis "BAP raw files loader") (tags (bap bap-plugin)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)) (bap-std (= :version)) @@ -1140,8 +1129,8 @@ and support files if necessary.") (tags (bap bap-tool command-line)) (depends (bap-common (= :version)) - (parsexp (and (>= v0.14) (< v0.16))) - (stdio (and (>= v0.14) (< v0.16))) + (parsexp (and (>= v0.17) (< v0.18))) + (stdio (and (>= v0.17) (< v0.18))) stdlib-shims (uuidm (>= 0.9.7)))) @@ -1153,7 +1142,7 @@ and support files if necessary.") (bap-common (= :version)) (bap-main (= :version)) (bap-recipe (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-relation) @@ -1184,7 +1173,7 @@ between the sets.") (bitvec-order (= :version)) (bitvec-sexp (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (ogre (= :version)) (ppx_bap (= :version)))) @@ -1194,7 +1183,7 @@ between the sets.") (synopsis "BAP plugin for reporting progress bars and statuses") (tags (bap bap-plugin)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (bap-std (= :version)))) @@ -1210,7 +1199,7 @@ between the sets.") (bap-c (= :version)) (bap-knowledge (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (ogre (= :version)) (ppx_bap (= :version)))) @@ -1225,7 +1214,7 @@ between the sets.") (bap-knowledge (= :version)) (bap-primus (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (graphlib (= :version)) (monads (= :version)) (regular (= :version)))) @@ -1238,7 +1227,7 @@ between the sets.") (bap-common (= :version)) (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ogre (= :version)))) (package @@ -1248,7 +1237,7 @@ between the sets.") (depends (bap-common (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-std) @@ -1268,12 +1257,12 @@ between the sets.") (bitvec (= :version)) (camlzip (and (>= 1.07) (< 2.0))) cmdliner - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) fileutils (graphlib (= :version)) mmap (monads (= :version)) - (ocamlfind (and (>= 1.5.6) (< 2.0.0))) + (ocamlfind (and (>= 1.9.0) (< 2.0.0))) (ogre (= :version)) ounit (ppx_bap (= :version)) @@ -1301,7 +1290,7 @@ The library provides several algorithms: - Scanner - a generic algorithm for finding strings of characters (a library variant of strings tool)") (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)))) @@ -1310,7 +1299,7 @@ The library provides several algorithms: (synopsis "Finds strings in binaries using microexecution") (tags (bap bap-plugin)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (bap-beagle (= :version)) (ppx_bap (= :version)) @@ -1332,7 +1321,7 @@ The library provides several algorithms: (bitvec-order (= :version)) (bitvec-sexp (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ogre (= :version)) (ppx_bap (= :version)))) @@ -1347,7 +1336,7 @@ The library provides several algorithms: (bap-main (= :version)) (bap-relation (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))))) (package (name bap-systemz) @@ -1360,7 +1349,7 @@ The library provides several algorithms: (bap-main (= :version)) (bap-std (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ogre (= :version)) (ppx_bap (= :version)))) @@ -1373,7 +1362,7 @@ The library provides several algorithms: (bap-primus (= :version)) (bap-std (= :version)) (bap-strings (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (monads (= :version)) (ppx_bap (= :version)) (regular (= :version)))) @@ -1386,7 +1375,7 @@ The library provides several algorithms: (bap-common (= :version)) (bap-core-theory (= :version)) (bap-microx (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (graphlib (= :version)) (monads (= :version)) (regular (= :version)))) @@ -1400,7 +1389,7 @@ The library provides several algorithms: (bap-common (= :version)) (bap-main (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ppx_bap (= :version)) (regular (= :version)))) @@ -1416,7 +1405,7 @@ The library provides several algorithms: (bap-main (= :version)) (bap-std (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ogre (= :version)) (ppx_bap (= :version)))) @@ -1432,7 +1421,7 @@ as the interpreter for your BAP scripts, e.g., `baptop myprog.ml`") (depends (bap-common (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) ocamlfind)) (package @@ -1445,7 +1434,7 @@ as the interpreter for your BAP scripts, e.g., `baptop myprog.ml`") (bap-plugins (= :version)) (bap-std (= :version)) (bap-traces (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ppx_bap (= :version)) (regular (= :version)) uri)) @@ -1457,7 +1446,7 @@ as the interpreter for your BAP scripts, e.g., `baptop myprog.ml`") (depends (bap-common (= :version)) (bap-std (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ppx_bap (= :version)) (regular (= :version)) (uri (>= 1.9.0)) @@ -1468,7 +1457,7 @@ as the interpreter for your BAP scripts, e.g., `baptop myprog.ml`") (synopsis "Eliminates complex branch conditions") (tags (bap bap-plugin)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (bap-std (= :version)))) @@ -1477,7 +1466,7 @@ as the interpreter for your BAP scripts, e.g., `baptop myprog.ml`") (synopsis "Warns if an unused argument may cause an issue") (tags (bap bap-plugin)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (bap-std (= :version)))) @@ -1500,7 +1489,7 @@ as the interpreter for your BAP scripts, e.g., `baptop myprog.ml`") (bap-primus (= :version)) (bap-std (= :version)) (bitvec (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ogre (= :version)) (ppx_bap (= :version)) (regular (= :version)) @@ -1515,8 +1504,8 @@ of facts that are represented as s-expressions.") (tags (bap bap-library)) (depends (bap-common (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) - (parsexp (and (>= v0.14) (< v0.16))))) + (core_kernel (and (>= v0.17) (< v0.18))) + (parsexp (and (>= v0.17) (< v0.18))))) (package (name bitvec) @@ -1529,7 +1518,7 @@ of facts that are represented as s-expressions.") (synopsis "Janestreet's Binprot serialization for Bitvec") (tags (bap)) (depends - (bin_prot (and (>= v0.14) (< v0.16))) + (bin_prot (and (>= v0.17) (< v0.18))) (bitvec (= :version)) (ppx_bap (= :version)))) @@ -1538,7 +1527,7 @@ of facts that are represented as s-expressions.") (synopsis "The Base-compatible comparators and orders for Bitvec ") (tags (bap)) (depends - (base (>= v0.14)) + (base (>= v0.16)) (bitvec-sexp (= :version)) (bitvec (= :version)))) @@ -1547,7 +1536,7 @@ of facts that are represented as s-expressions.") (synopsis "Sexp serializers for Bitvec") (tags (bap sexp)) (depends - (sexplib0 (>= v0.14)) + (sexplib0 (>= v0.16)) (bitvec (= :version)))) (package @@ -1564,7 +1553,7 @@ these functors, any algorithm written for OCamlGraph can be used on \ (tags (bap graph)) (depends (bap-common (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) ocamlgraph (ppx_bap (= :version)) (regular (= :version)))) @@ -1576,7 +1565,7 @@ these functors, any algorithm written for OCamlGraph can be used on \ (tags (bap monad)) (depends (bap-common (= :version)) - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (ppx_bap (= :version)))) (package @@ -1588,7 +1577,7 @@ representation and provides a type safe monadic interface for quering \ and updating documents") (tags (bap sexp)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (monads (= :version)))) @@ -1597,22 +1586,22 @@ and updating documents") (synopsis "BAP-blessed ppx rewriters") (tags (bap ppx)) (depends - (ppx_assert (and (>= v0.14) (< v0.16))) - (ppx_bench (and (>= v0.14) (< v0.16))) - (ppx_bin_prot (and (>= v0.14) (< v0.16))) - (ppx_cold (and (>= v0.14) (< v0.16))) - (ppx_compare (and (>= v0.14) (< v0.16))) - (ppx_enumerate (and (>= v0.14) (< v0.16))) - (ppx_fields_conv (and (>= v0.14) (< v0.16))) - (ppx_hash (and (>= v0.14) (< v0.16))) - (ppx_here (and (>= v0.14) (< v0.16))) - (ppxlib (>= 0.15.0)) - (ppx_optcomp (and (>= v0.14) (< v0.16))) - (ppx_expect (and (>= v0.14) (< v0.16))) - (ppx_inline_test (and (>= v0.14) (< v0.16))) - (ppx_sexp_conv (and (>= v0.14) (< v0.16))) - (ppx_sexp_value (and (>= v0.14) (< v0.16))) - (ppx_variants_conv (and (>= v0.14) (< v0.16))))) + (ppx_assert (and (>= v0.17) (< v0.18))) + (ppx_bench (and (>= v0.17) (< v0.18))) + (ppx_bin_prot (and (>= v0.17) (< v0.18))) + (ppx_cold (and (>= v0.17) (< v0.18))) + (ppx_compare (and (>= v0.17) (< v0.18))) + (ppx_enumerate (and (>= v0.17) (< v0.18))) + (ppx_fields_conv (and (>= v0.17) (< v0.18))) + (ppx_hash (and (>= v0.17) (< v0.18))) + (ppx_here (and (>= v0.17) (< v0.18))) + (ppxlib (>= 0.32.0)) + (ppx_optcomp (and (>= v0.17) (< v0.18))) + (ppx_expect (and (>= v0.17) (< v0.18))) + (ppx_inline_test (and (>= v0.17) (< v0.18))) + (ppx_sexp_conv (and (>= v0.17) (< v0.18))) + (ppx_sexp_value (and (>= v0.17) (< v0.18))) + (ppx_variants_conv (and (>= v0.17) (< v0.18))))) (package (name regular) @@ -1631,7 +1620,7 @@ In particular, the library includes: \ - module Seq that extends Core_kernel's sequence module \ - module Bytes that provides a rich core-like interface for Bytes data type.") (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)) (ppx_bap (= :version)))) @@ -1640,7 +1629,7 @@ In particular, the library includes: \ (synopsis "A library for rich formatting using semantic tags") (tags (bap)) (depends - (core_kernel (and (>= v0.14) (< v0.16))) + (core_kernel (and (>= v0.17) (< v0.18))) (bap-common (= :version)))) (generate_opam_files true) diff --git a/flake.lock b/flake.lock new file mode 100644 index 000000000..886d2d96b --- /dev/null +++ b/flake.lock @@ -0,0 +1,27 @@ +{ + "nodes": { + "nixpkgs": { + "locked": { + "lastModified": 1792502884, + "narHash": "sha256-IoNisKcGbUjdd45qCqywGMCYmZ5EnkxezvLII0FWwNA=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "02c087f3fe673c9e317f206a627cb6b910336dbe", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "nixpkgs": "nixpkgs" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 000000000..205c6a402 --- /dev/null +++ b/flake.nix @@ -0,0 +1,27 @@ +{ + description = "BAP (Angs12 fork) as a standalone Nix package"; + + inputs.nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable"; + + outputs = { self, nixpkgs }: + let + systems = [ "x86_64-linux" ]; + forAllSystems = f: + nixpkgs.lib.genAttrs systems + (system: f nixpkgs.legacyPackages.${system} system); + in + { + packages = forAllSystems (pkgs: _: + let + bap = pkgs.callPackage ./nix/package.nix { + ocamlPackages = pkgs.ocaml-ng.ocamlPackages_5_3; + llvmPackages = pkgs.llvmPackages_19; + src = ./.; + }; + in + { + inherit bap; + default = bap; + }); + }; +} diff --git a/graphlib.opam b/graphlib.opam index db28362d1..daa2b8c92 100644 --- a/graphlib.opam +++ b/graphlib.opam @@ -11,9 +11,9 @@ tags: ["bap" "graph"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ocamlgraph" "ppx_bap" {= version} "regular" {= version} diff --git a/lib/arm/arm_lifter.ml b/lib/arm/arm_lifter.ml index 38f242c85..94602a56a 100644 --- a/lib/arm/arm_lifter.ml +++ b/lib/arm/arm_lifter.ml @@ -1060,7 +1060,7 @@ module CPU = struct let sp = sp - let regs = Var.Set.of_list [ + let regs = Set.of_list (module Var) [ r0; r1; r2; r3; r4; r5; r6; r7; r8; r9; r10; r11; r12; @@ -1069,17 +1069,17 @@ module CPU = struct ] (* although PC is stricly speaking is GPR we will rule it out *) - let non_gpr = Var.Set.of_list [ + let non_gpr = Set.of_list (module Var) [ pc; spsr; cpsr; itstate; ] - let gpr = Var.Set.diff regs non_gpr + let gpr = Set.diff regs non_gpr - let perms = Var.Set.of_list [ + let perms = Set.of_list (module Var) [ r4; r5; r6; r7; r8; r9; r10; r11; ] - let flags = Var.Set.of_list @@ [ + let flags = Set.of_list (module Var) @@ [ nf; zf; cf; qf; vf; ] @ Array.to_list ge diff --git a/lib/arm/arm_target.ml b/lib/arm/arm_target.ml index 1c2f793f8..32e00d92a 100644 --- a/lib/arm/arm_target.ml +++ b/lib/arm/arm_target.ml @@ -643,7 +643,7 @@ module Encodings = struct module Lambda = Primus.Lisp module Sigma = Lambda.Semantics - let empty = Map.empty (module Bitvec_order) + let empty = (Map.empty (module Bitvec_order)) let lsb x = Int64.(x land 1L) let is_thumb x = Int64.equal (lsb x) 1L diff --git a/lib/bap/bap.mli b/lib/bap/bap.mli index f9d94dbc2..8ef953369 100644 --- a/lib/bap/bap.mli +++ b/lib/bap/bap.mli @@ -164,7 +164,7 @@ module Std : sig contains all functions and types related to type [exp]. For example, to create a hashtable of statements, just type: - [let table = Exp.Table.create ()] + [let table = Hashtbl.create (module Exp) ()] If a type is a variant type (i.e., it defines constructors) then for each constructor named [Name], there exists a corresponding @@ -2062,6 +2062,9 @@ module Std : sig @since 2.3.0 *) val code : (Theory.program, stmt list) KB.slot + (** RIP-relative addressing is used in the semantics. *) + val rip_relative : (Theory.Program.Semantics.cls, bool) Knowledge.slot + (** [printf "%a" pp_binop op] prints a binary operation [op]. *) val pp_binop : Format.formatter -> binop -> unit @@ -6949,6 +6952,14 @@ module Std : sig ?brancher:brancher -> ?rooter:rooter -> arch -> mem -> t Or_error.t + (** [run_in_scope ?brancher ?rooter arch mem] is [run] as a + knowledge computation: the scan runs in the caller's machine, + so dynamic scopes the caller establishes (the current + theory, in particular) hold while the instructions reify. *) + val run_in_scope : + ?brancher:brancher -> + ?rooter:rooter -> arch -> mem -> t Or_error.t knowledge + (** [cfg t] returns a control flow graph, representing the code in the input region of memory. Note, this is not a subroutine CFG, is is a whole segment graph. *) @@ -6958,6 +6969,13 @@ module Std : sig happened during the disassembly (e.g., unknown opcodes and unlifted instructions. *) val errors : t -> error list + + (** [global_cfg state] reconstructs the whole-program CFG from a + grown driver [state] — the same CFG the [run] entry points + produce, for callers that drive [Driver.scan] themselves (a + re-decode loop that feeds the scanner discovered roots and + destinations). *) + val global_cfg : Bap_disasm_driver.state -> cfg knowledge end end @@ -7643,6 +7661,8 @@ module Std : sig *) val scan : mem -> state -> state knowledge + val resume : ?record:bool -> Set.M(Addr).t -> mem -> state -> state knowledge + (** [explore ~block ~node ~edge ~init state] builds a control-flow graph from the [state]. @@ -8982,6 +9002,11 @@ module Std : sig (** updates the right hand side of a definition *) val with_rhs : t -> exp -> t + (** [with_value def v] replaces the RHS with a Core Theory value [v], + preserving the BIL expression inside. Useful for attaching KB + properties to the def's value. *) + val with_value : t -> unit Theory.value -> t + (** [map_exp def f] applies [f] to a [rhs] of [def] and returns an updated definition. *) val map_exp : t -> f:(exp -> exp) -> t @@ -9001,6 +9026,11 @@ module Std : sig include Regular.S with type t := t end + (** [rip_relative_addr] marks a Core Theory value as a RIP-relative + address. Set on the RHS value of defs whose assigned address is + RIP-relative (e.g., Load/Store from RIP-relative instructions). *) + val rip_relative_addr : (Theory.Value.cls, bool) Knowledge.slot + (** A control transfer operation. *) module Jmp : sig (** Jmp is the only way to transfer control from block to block. diff --git a/lib/bap/bap_project.ml b/lib/bap/bap_project.ml index 8327749ff..29e445d4f 100644 --- a/lib/bap/bap_project.ml +++ b/lib/bap/bap_project.ml @@ -13,7 +13,7 @@ open Format module Driver = Bap_disasm_driver -module Buffer = Caml.Buffer +module Buffer = Stdlib.Buffer include Bap_self.Create() let query doc attr = @@ -232,7 +232,7 @@ module Input = struct spec; } |> List.return - let loaders = String.Table.create () + let loaders = Hashtbl.create (module String) let register_loader name loader = Hashtbl.set loaders ~key:name ~data:loader @@ -263,7 +263,7 @@ module Input = struct let dedup xs = List.rev @@ fst @@ - List.fold xs ~init:([], String.Set.empty) ~f:(fun (xs, mems) x -> + List.fold xs ~init:([], Set.empty (module String)) ~f:(fun (xs, mems) x -> if Set.mem mems x then (xs, mems) else (x :: xs, Set.add mems x)) @@ -713,7 +713,7 @@ module Pass = struct let fail = function | Unsat_dep _ as err -> raise (Failed err) | Runtime_error (pass,exn) -> - let backtrace = Caml.Printexc.get_backtrace () in + let backtrace = Stdlib.Printexc.get_backtrace () in raise (Failed (Runtime_error (pass, Exn.Reraised (backtrace, exn)))) let is_evaled pass proj = diff --git a/lib/bap/bap_self.ml b/lib/bap/bap_self.ml index f972f2dd4..a4a129ffb 100644 --- a/lib/bap/bap_self.ml +++ b/lib/bap/bap_self.ml @@ -6,8 +6,8 @@ open Format open Cmdliner module Event = Bap_main_event -module Buffer = Caml.Buffer -module Sys = Caml.Sys +module Buffer = Stdlib.Buffer +module Sys = Stdlib.Sys module Create() = struct let main = @@ -50,7 +50,7 @@ module Create() = struct else filter_args name let has_var v = match Sys.getenv ("BAP_" ^ String.uppercase v) with - | exception Caml.Not_found -> false + | exception Stdlib.Not_found -> false | "false" | "0" -> false | _ -> true @@ -123,7 +123,7 @@ module Create() = struct try Ok (f {get = fun x -> Future.peek_exn x}) with | Invalid_argument s -> Error (Error.Invalid s) | exn -> - let backtrace = Caml.Printexc.get_backtrace () in + let backtrace = Stdlib.Printexc.get_backtrace () in Error (Error.Bug (exn,backtrace)) let when_ready f = declare_extension f diff --git a/lib/bap_bml/bap_bml.ml b/lib/bap_bml/bap_bml.ml index 1a3469811..f1756b59d 100644 --- a/lib/bap_bml/bap_bml.ml +++ b/lib/bap_bml/bap_bml.ml @@ -14,7 +14,7 @@ end module Registry(T : T) = struct type t = T.t - let registered : t String.Table.t = String.Table.create () + let registered : t String.Table.t = Hashtbl.create (module String) let register name v = Hashtbl.set registered ~key:name ~data:v let find = Hashtbl.find registered let list () = Hashtbl.to_alist registered diff --git a/lib/bap_bundle/bap_bundle.ml b/lib/bap_bundle/bap_bundle.ml index 28d092dbf..7a2558d4a 100644 --- a/lib/bap_bundle/bap_bundle.ml +++ b/lib/bap_bundle/bap_bundle.ml @@ -1,14 +1,14 @@ open Core_kernel[@@warning "-D"] -module Filename = Caml.Filename -module Sys = Caml.Sys +module Filename = Stdlib.Filename +module Sys = Stdlib.Sys module Std = struct exception Not_a_bundle module Manifest = struct - let getenv key = try Sys.getenv key with Caml.Not_found -> "unknown" + let getenv key = try Sys.getenv key with Stdlib.Not_found -> "unknown" type t = { name : string; @@ -165,12 +165,12 @@ module Std = struct let name = Option.value name ~default:path in Zip.copy_entry_to_file zip entry name; Some (Uri.of_string name) - with Caml.Not_found -> None + with Stdlib.Not_found -> None let get_data b name = b >>> fun zip -> try Some Zip.(read_entry zip (find_entry zip name)) - with Caml.Not_found -> None + with Stdlib.Not_found -> None let list b = b >>> fun zip -> @@ -210,10 +210,10 @@ module Std = struct Zip.close_out zout let update bundle ~f = - transform (String.Table.create ()) bundle ~f + transform (Hashtbl.create (module String)) bundle ~f let insert bundle files = - let files = String.Table.of_alist_exn files in + let files = Hashtbl.of_alist_exn (module String) files in transform files bundle ~f:(fun _ -> `Copy) let insert_files bundle files = diff --git a/lib/bap_byteweight/bap_byteweight.ml b/lib/bap_byteweight/bap_byteweight.ml index 3fc8e609d..1faa5a90a 100644 --- a/lib/bap_byteweight/bap_byteweight.ml +++ b/lib/bap_byteweight/bap_byteweight.ml @@ -117,9 +117,9 @@ module Bytes = struct let t = Bap_byteweight_signatures.Data.declare "bytes" ~load:(fun bytes -> Binable.of_string (module Self) - (Caml.Bytes.unsafe_to_string bytes)) + (Stdlib.Bytes.unsafe_to_string bytes)) ~save:(fun data -> - Caml.Bytes.unsafe_of_string @@ + Stdlib.Bytes.unsafe_of_string @@ Binable.to_string (module Self) data) include Self diff --git a/lib/bap_byteweight/bap_byteweight_signatures.ml b/lib/bap_byteweight/bap_byteweight_signatures.ml index 0ecc78596..581fb4092 100644 --- a/lib/bap_byteweight/bap_byteweight_signatures.ml +++ b/lib/bap_byteweight/bap_byteweight_signatures.ml @@ -1,7 +1,7 @@ open Core_kernel[@@warning "-D"] open Bap_core_theory open Bap.Std -module Sys = Caml.Sys +module Sys = Stdlib.Sys module Config = Bap_main.Extension.Configuration @@ -122,7 +122,7 @@ let copy input output = loop () let temporary_copy file = - let tmp,output = Caml.Filename.open_temp_file "byteweight" "copy" in + let tmp,output = Stdlib.Filename.open_temp_file "byteweight" "copy" in In_channel.with_file file ~f:(fun input -> copy input output); Out_channel.close output; tmp @@ -169,8 +169,8 @@ let load_exn ?comp ?path ~mode arch = let entry_path = entry ?comp ~mode arch in let r = try let entry = Zip.find_entry zip entry_path in - Ok (Zip.read_entry zip entry |> Caml.Bytes.unsafe_of_string) - with Caml.Not_found -> fail (`No_entry entry_path) + Ok (Zip.read_entry zip entry |> Stdlib.Bytes.unsafe_of_string) + with Stdlib.Not_found -> fail (`No_entry entry_path) | Zip.Error (_,ent,err) -> zip_error ent err in Zip.close_in zip; r diff --git a/lib/bap_c/bap_c_abi.ml b/lib/bap_c/bap_c_abi.ml index c9740b134..6383fe2e9 100644 --- a/lib/bap_c/bap_c_abi.ml +++ b/lib/bap_c/bap_c_abi.ml @@ -299,7 +299,7 @@ let create_api_processor size abi : Bap_api.t = let language = "c" type t = Term.mapper let parse_exn get_api intfs : t = - let gamma = String.Table.create () in + let gamma = Hashtbl.create (module String) in List.iter intfs ~f:(fun api -> match get_api api with | None -> fail (`Unknown_interface api) @@ -400,7 +400,7 @@ module Arg = struct | None -> None | Some sp -> Some { base = Var.reify sp; - data = Map.empty (module Int); + data = (Map.empty (module Int)); align; } @@ -442,7 +442,7 @@ module Arg = struct let bits self = self.bits - let deplet self = {self with args = Map.empty (module Int)} + let deplet self = {self with args = (Map.empty (module Int))} let pop self = match Map.min_elt self.args with | None -> None @@ -471,7 +471,7 @@ module Arg = struct let of_list = List.foldi ~f:(fun pos regs reg -> Map.add_exn regs pos reg) - ~init:Int.Map.empty + ~init:(Map.empty (module Int)) let of_exps args = { @@ -783,7 +783,7 @@ module Arg = struct let init = { stack = Stack.create ruler target; ruler; - files = Map.empty (module Int); + files = (Map.empty (module Int)); where = `Inputs; return = None; inputs = []; diff --git a/lib/bap_core_theory/bap_core_theory.ml b/lib/bap_core_theory/bap_core_theory.ml index 54cc3740f..4c64a1b6b 100644 --- a/lib/bap_core_theory/bap_core_theory.ml +++ b/lib/bap_core_theory/bap_core_theory.ml @@ -45,9 +45,9 @@ module Theory = struct type filetype = Filetype.t type 'a value = 'a Value.t - type 'a effect = 'a Effect.t + type 'a eff0 = 'a Effect.t type 'a pure = 'a value knowledge - type 'a eff = 'a effect knowledge + type 'a eff = 'a eff0 knowledge type bool = Bool.t pure diff --git a/lib/bap_core_theory/bap_core_theory.mli b/lib/bap_core_theory/bap_core_theory.mli index d0968f920..dfec50db4 100644 --- a/lib/bap_core_theory/bap_core_theory.mli +++ b/lib/bap_core_theory/bap_core_theory.mli @@ -364,7 +364,7 @@ *) open Core_kernel[@@warning "-D"] -open Caml.Format +open Stdlib.Format open Bap_knowledge @@ -774,7 +774,7 @@ module Theory : sig This module enables construction of complex data structures on sorts, like maps, sets, etc, e.g., - [let sorts = Set.empty (module Value.Sort.Top)] + [let sorts = (Set.empty (module Value.Sort.Top))] Since such structures are required to be monomorphic, the sort type index should be removed using the [forget] function, @@ -953,7 +953,7 @@ module Theory : sig end type 'a value = 'a Value.t - type 'a effect = 'a Effect.t + type 'a eff0 = 'a Effect.t (** The sort for boolean values. @@ -1074,7 +1074,7 @@ module Theory : sig end type 'a pure = 'a value knowledge - type 'a eff = 'a effect knowledge + type 'a eff = 'a eff0 knowledge type ('r,'s) format = ('r,'s) Float.format @@ -1194,7 +1194,7 @@ module Theory : sig (** Variables with erased sort index. This module enables construction of complex data structures on - variables, e.g., [Set.empty (module Theory.Var.Top)]. + variables, e.g., [(Set.empty (module Theory.Var.Top))]. The variables are ordered by their identifiers so that two variables with the same name but different sorts are compared @@ -1987,6 +1987,9 @@ module Theory : sig (** a link is subroutine if it is an entry point to a subroutine. *) val is_subroutine : (program, bool option) KB.slot + (** the instruction uses RIP-relative addressing. *) + val is_rip_relative : (program, bool option) KB.slot + (** [fresh] a fresh label (a shortcut for [KB.create cls]). diff --git a/lib/bap_core_theory/bap_core_theory_basic.ml b/lib/bap_core_theory/bap_core_theory_basic.ml index cffaa99bd..773292ac8 100644 --- a/lib/bap_core_theory/bap_core_theory_basic.ml +++ b/lib/bap_core_theory/bap_core_theory_basic.ml @@ -102,8 +102,8 @@ module Make(L : Minimal) = struct let needed = size data_t and chunk_len = size chunks in let nth stored = let shift_amount = ite dir - (small data_t stored) - (small data_t (needed - stored)) in + (small data_t (needed - chunk_len - stored)) + (small data_t stored) in cast chunks b0 (shiftr b0 !!data shift_amount) in let rec loop key stored mem = if stored < needed then diff --git a/lib/bap_core_theory/bap_core_theory_definition.ml b/lib/bap_core_theory/bap_core_theory_definition.ml index a4cc37ea3..7f8904e80 100644 --- a/lib/bap_core_theory/bap_core_theory_definition.ml +++ b/lib/bap_core_theory/bap_core_theory_definition.ml @@ -9,12 +9,12 @@ module Program = Bap_core_theory_program module Label = Program.Label type 'a value = 'a Value.t -type 'a effect = 'a Effect.t +type 'a eff0 = 'a Effect.t type program = Program.cls type 'a pure = 'a value knowledge -type 'a eff = 'a effect knowledge +type 'a eff = 'a eff0 knowledge type bool = Bool.t pure type 'a bitv = 'a Bitv.t pure diff --git a/lib/bap_core_theory/bap_core_theory_manager.ml b/lib/bap_core_theory/bap_core_theory_manager.ml index 58f2abcbe..565fc8e56 100644 --- a/lib/bap_core_theory/bap_core_theory_manager.ml +++ b/lib/bap_core_theory/bap_core_theory_manager.ml @@ -323,7 +323,7 @@ let theories () = KB.Context.get theories >>= function | Some theories -> !!theories | None -> - let init = Map.empty (module Theory) in + let init = (Map.empty (module Theory)) in Hashtbl.to_alist known_theories |> Knowledge.List.fold ~init ~f:(fun theories (name,def) -> Knowledge.Symbol.intern (Name.unqualified name) theory @@ -385,7 +385,7 @@ let is_instantiated id = thus it will drop it from the final structure. [1]: Leroy, Xavier."A proposal for recursive modules in Objective - Caml." Available from the author’s website (2003). + Stdlib." Available from the author’s website (2003). *) let instantiate t = theory_for_id t.id >>= fun id -> diff --git a/lib/bap_core_theory/bap_core_theory_program.ml b/lib/bap_core_theory/bap_core_theory_program.ml index 46131b593..8d37ce078 100644 --- a/lib/bap_core_theory/bap_core_theory_program.ml +++ b/lib/bap_core_theory/bap_core_theory_program.ml @@ -101,7 +101,7 @@ module Compiler = struct let create ?(specs=[]) ?(version=[]) ?(options=[]) name = { name; version; options; - specs = String.Map.of_alist_exn specs; + specs = Map.of_alist_exn (module String) specs; } let pp ppf x = Sexp.pp_hum ppf (sexp_of_t x) @@ -211,6 +211,8 @@ module Label = struct "is the program valid or not" let is_subroutine = attr "is-subroutine" "is the program a subroutine entry point" + let is_rip_relative = attr "is-rip-relative" + "the instruction uses RIP-relative addressing" let encoding = Knowledge.Class.property ~package cls "encoding" Language.domain diff --git a/lib/bap_core_theory/bap_core_theory_program.mli b/lib/bap_core_theory/bap_core_theory_program.mli index 6dc903969..350bcb4ba 100644 --- a/lib/bap_core_theory/bap_core_theory_program.mli +++ b/lib/bap_core_theory/bap_core_theory_program.mli @@ -95,6 +95,7 @@ module Label : sig val possible_name : (program, string option opinions) slot val is_valid : (program, bool option) slot val is_subroutine : (program, bool option) slot + val is_rip_relative : (program, bool option) slot val fresh : t knowledge val null : t val for_addr : ?package:string -> Bitvec.t -> t knowledge diff --git a/lib/bap_core_theory/bap_core_theory_target.ml b/lib/bap_core_theory/bap_core_theory_target.ml index 7cd8b60c4..092d6961c 100644 --- a/lib/bap_core_theory/bap_core_theory_target.ml +++ b/lib/bap_core_theory/bap_core_theory_target.ml @@ -172,11 +172,11 @@ let unknown = { alignment = {code=8; data=8}; data = pack@@mem "mem" 32 8; code = pack@@mem "mem" 32 8; - vars = Set.empty (module Var.Top); - regs = Map.empty (module Role); + vars = (Set.empty (module Var.Top)); + regs = (Map.empty (module Role)); aliasing = { - subs = Map.empty (module Var.Top); - sups = Map.empty (module Var.Top); + subs = (Map.empty (module Var.Top)); + sups = (Map.empty (module Var.Top)); }; endianness = Endianness.eb; system = System.unknown; @@ -184,7 +184,7 @@ let unknown = { fabi = Fabi.unknown; filetype = Filetype.unknown; options = Options.empty; - names = String.Caseless.Set.empty; + names = (Set.empty (module String.Caseless)); } let targets = Hashtbl.of_alist_exn (module Self) [ @@ -219,8 +219,8 @@ module Alias = struct | None -> assert false let init = { - sups = Map.empty (module Var.Top); - subs = Map.empty (module Var.Top); + sups = (Map.empty (module Var.Top)); + subs = (Map.empty (module Var.Top)); } let is_solved {subs; sups} v = (Map.mem subs v || Map.mem sups v) @@ -307,7 +307,7 @@ module Alias = struct let solve regs spec = let aliases = match Map.find regs Role.Register.alias with - | None -> Set.empty (module Var.Top) + | None -> (Set.empty (module Var.Top)) | Some vars -> vars in let is_alias = Set.mem aliases in let is_base = Fn.non is_alias in @@ -453,7 +453,7 @@ let extend parent }; names = Option.value_map nicknames ~default:parent.names - ~f:String.Caseless.Set.of_list; + ~f:(Set.of_list (module String.Caseless)); } let declare @@ -632,7 +632,7 @@ let family t = sort_family_by_order let partition xs = - let families = Map.empty (module Self) in + let families = (Map.empty (module Self)) in let universe = Set.of_list (module Self) xs in let rec grandest t = let p = parent t in diff --git a/lib/bap_core_theory/bap_core_theory_value.ml b/lib/bap_core_theory/bap_core_theory_value.ml index 648626d6e..5fd7484cf 100644 --- a/lib/bap_core_theory/bap_core_theory_value.ml +++ b/lib/bap_core_theory/bap_core_theory_value.ml @@ -1,5 +1,5 @@ open Core_kernel[@@warning "-D"] -open Caml.Format +open Stdlib.Format open Bap_knowledge module KB = Knowledge @@ -158,7 +158,7 @@ end let of_sexpable x = x end) - include Binable.Of_binable(Exp)(struct + include Binable.Of_binable_without_uuid(Exp)(struct type t = top let to_binable x = x let of_binable x = x diff --git a/lib/bap_core_theory/bap_core_theory_value.mli b/lib/bap_core_theory/bap_core_theory_value.mli index f05a8da58..680bcddbf 100644 --- a/lib/bap_core_theory/bap_core_theory_value.mli +++ b/lib/bap_core_theory/bap_core_theory_value.mli @@ -1,5 +1,5 @@ open Core_kernel[@@warning "-D"] -open Caml.Format +open Stdlib.Format open Bap_knowledge module KB = Knowledge diff --git a/lib/bap_core_theory/bap_core_theory_var.ml b/lib/bap_core_theory/bap_core_theory_var.ml index 0b89dc7ef..d77d6c2d0 100644 --- a/lib/bap_core_theory/bap_core_theory_var.ml +++ b/lib/bap_core_theory/bap_core_theory_var.ml @@ -1,6 +1,6 @@ open Core_kernel[@@warning "-D"] -open Caml.Format +open Stdlib.Format open Bap_knowledge open Bap_core_theory_value open Knowledge.Syntax diff --git a/lib/bap_disasm/bap_disasm_basic.ml b/lib/bap_disasm/bap_disasm_basic.ml index 5d5344f5c..e23eee519 100644 --- a/lib/bap_disasm/bap_disasm_basic.ml +++ b/lib/bap_disasm/bap_disasm_basic.ml @@ -90,11 +90,11 @@ module Table = struct let create data = { data; size = Bigstring.length data; - cache = Int.Table.create (); + cache = Hashtbl.create (module Int); } let lookup t pos = - Int.Table.find_or_add t.cache pos ~default:(fun () -> + Hashtbl.find_or_add t.cache pos ~default:(fun () -> if pos < 0 || pos >= t.size then "ERROR" else match Bigstring.find ~pos '\x00' t.data with | None -> "ERROR" @@ -427,9 +427,13 @@ let compare_full_insn i1 i2 = type (+'a,+'k) insns = (mem * ('a,'k) insn option) list -module Pred = Comparable.Make(struct +module Pred = struct + type t = pred + module T = struct type t = pred [@@deriving compare, sexp] - end) + end + include Comparable.Make(T) +end module Preds = Pred.Set type preds = Preds.t [@@deriving compare, sexp] @@ -464,7 +468,7 @@ let create_state ?(backlog=0) ?(stop_on=[]) ?stopped ?invalid ?hit dis mem ~return = { backlog; dis; return; hit; - current = {mem; off=0; preds = Preds.of_list stop_on}; + current = {mem; off=0; preds = Set.of_list (module Pred) stop_on}; stopped; invalid; history = []; @@ -500,14 +504,14 @@ let push_pred s p = let reset_predicates s ps = C.predicates_clear !!(s.dis); - Preds.iter ps ~f:(push_pred s); + Set.iter ps ~f:(push_pred s); C.predicates_push !!(s.dis) Is_invalid let with_preds s (ps : pred list) = - let ps = Preds.of_list ps in - let drop = Preds.diff s.current.preds ps in - if Preds.is_empty drop - then Preds.iter (Preds.diff ps s.current.preds) ~f:(push_pred s) + let ps = Set.of_list (module Pred) ps in + let drop = Set.diff s.current.preds ps in + if Set.is_empty drop + then Set.iter (Set.diff ps s.current.preds) ~f:(push_pred s) else reset_predicates s ps; {s with current = {s.current with preds = ps}} @@ -519,7 +523,7 @@ let last s n = let n = min n m in List.init n ~f:(fun i -> s.insns.(m - i - 1)) -let preds s = Preds.to_list s.current.preds +let preds s = Set.to_list s.current.preds let addr s = Addr.(Mem.min_addr s.current.mem ++ s.current.off) diff --git a/lib/bap_disasm/bap_disasm_brancher.ml b/lib/bap_disasm/bap_disasm_brancher.ml index c3d4b7f1a..9d37d2134 100644 --- a/lib/bap_disasm/bap_disasm_brancher.ml +++ b/lib/bap_disasm/bap_disasm_brancher.ml @@ -40,7 +40,7 @@ module Rel_info = struct open Fact.Syntax let of_aseq s = - Seq.fold s ~init:Addr.Map.empty ~f:(fun m (key,data) -> + Seq.fold s ~init:(Map.empty (module Addr)) ~f:(fun m (key,data) -> Map.set m ~key ~data) let arch_width = @@ -58,13 +58,13 @@ module Rel_info = struct Fact.collect Ogre.Query.( select (from external_reference)) >>= fun s -> Fact.return - (Seq.fold s ~init:Addr.Set.empty ~f:(fun addrs (addr, _) -> + (Seq.fold s ~init:(Set.empty (module Addr)) ~f:(fun addrs (addr, _) -> Set.add addrs (Addr.of_int64 ~width addr))) end let relocations = Fact.eval Request.relocations let external_symbols = Fact.eval Request.external_symbols - let empty = {rels = Addr.Map.empty; exts = Addr.Set.empty} + let empty = {rels = (Map.empty (module Addr)); exts = (Set.empty (module Addr))} let of_spec spec = match relocations spec, external_symbols spec with @@ -173,7 +173,7 @@ let (>>=?) x f = x >>= function | Some x -> f x let provide_brancher brancher label = - let init = Set.empty (module Theory.Label) in + let init = (Set.empty (module Theory.Label)) in KB.collect Memory.slot label >>=? fun mem -> KB.collect Dis.Insn.slot label >>=? fun insn -> Context.for_label label >>= fun ctxt -> diff --git a/lib/bap_disasm/bap_disasm_calls.ml b/lib/bap_disasm/bap_disasm_calls.ml index 9fb64d0dd..0f31f6a17 100644 --- a/lib/bap_disasm/bap_disasm_calls.ml +++ b/lib/bap_disasm/bap_disasm_calls.ml @@ -61,7 +61,7 @@ end *) module Parent = struct type t = Top | Set of Word.Set.t [@@deriving compare, bin_io] - let none = Set Word.Set.empty + let none = Set (Set.empty (module Word)) let unknown = Top let equal x y = match x,y with | Top,Top -> true @@ -93,7 +93,7 @@ end module Parents = struct type t = (word,Parent.t) Solution.t - include Binable.Of_binable(struct + include Binable.Of_binable_without_uuid(struct type t = (word * Parent.t) Seq.t [@@deriving bin_io] end)(struct type t = (word,Parent.t) Solution.t @@ -150,7 +150,7 @@ let empty = let root = Map.singleton (module Addr) Callgraph.entry Parent.none in { parents = Solution.create root Parent.unknown; - entries = Set.empty (module Addr); + entries = (Set.empty (module Addr)); } let belongs {parents} ~entry:parent addr = @@ -179,7 +179,7 @@ let siblings {parents} x y = not @@ Set.is_empty (Set.inter p1 p2) let entries graph parents = - let init = Set.empty (module Addr) in + let init = (Set.empty (module Addr)) in Callgraph.nodes graph |> Seq.fold ~init ~f:(fun entries n -> if Word.equal n Callgraph.entry then entries else match Solution.get parents n with diff --git a/lib/bap_disasm/bap_disasm_driver.ml b/lib/bap_disasm/bap_disasm_driver.ml index 80ba17393..51f678830 100644 --- a/lib/bap_disasm/bap_disasm_driver.ml +++ b/lib/bap_disasm/bap_disasm_driver.ml @@ -203,7 +203,7 @@ end = struct let rec step s = match s.work with | [] when Set.is_empty s.usat -> { s with stop = true; - code = Map.empty (module Addr); + code = (Map.empty (module Addr)); } | [] -> restart s | Dest {dst=next; encoding} as curr :: work @@ -356,10 +356,10 @@ end = struct debt = []; curr = Dest {dst = start; parent = None; encoding=unknown}; stop = false; - dels = Set.empty (module Addr); - begs = Map.empty (module Addr); - jmps = Map.empty (module Addr); - code = Map.empty (module Addr); + dels = (Set.empty (module Addr)); + begs = (Map.empty (module Addr)); + jmps = (Map.empty (module Addr)); + code = (Map.empty (module Addr)); } mem end @@ -392,8 +392,8 @@ let collect_dests source code = call = Insn.(is call insn); barrier = Insn.(is barrier insn); indirect = false; - resolved = Set.empty (module Addr); - unresolved = Set.empty (module Theory.Label); + resolved = (Set.empty (module Addr)); + unresolved = (Set.empty (module Theory.Label)); } in KB.Value.get Insn.Slot.dests insn |> function | None -> KB.return {init with encoding = source} @@ -439,7 +439,7 @@ let unit_for_mem mem = KB.collect Theory.Label.unit label let classify mem = - let empty = Set.empty (module Addr) in + let empty = (Set.empty (module Addr)) in let base = Memory.min_addr mem in unit_for_mem mem >>= fun unit -> Seq.range 0 (Memory.length mem) |> @@ -551,13 +551,13 @@ type state = { } [@@deriving bin_io] let init = { - funs = Set.empty (module Addr); - begs = Set.empty (module Addr); - jmps = Map.empty (module Addr); - data = Set.empty (module Addr); + funs = (Set.empty (module Addr)); + begs = (Set.empty (module Addr)); + jmps = (Map.empty (module Addr)); + data = (Set.empty (module Addr)); mems = []; debt = []; - exts = Set.empty (module Theory.Label); + exts = (Set.empty (module Theory.Label)); } let forget_debt s = {s with debt=[]} @@ -593,7 +593,7 @@ let fold_calls field ~f ~init jmps = let commit_calls = fold_calls resolved - ~init:Addr.Set.empty + ~init:(Set.empty (module Addr)) ~f:(fun calls addr -> Theory.Label.for_addr (Word.to_bitvec addr) >>= fun dst -> KB.provide Theory.Label.is_valid dst (Some true) >>= fun () -> @@ -613,7 +613,7 @@ let owns mem s = | Machine.Dest {dst} -> Memory.contains mem dst | _ -> false) -let empty = Addr.Set.empty +let empty = (Set.empty (module Addr)) let merge_dests d1 d2 = { encoding = d1.encoding; @@ -633,7 +633,7 @@ let valid_dsts data dsts = then None else Some {dsts with resolved} -let scan_step ?(code=empty) ?(data=empty) ?(funs=empty) s mem = +let scan_step ?(record=true) ?(code=empty) ?(data=empty) ?(funs=empty) s mem = disassemble ~code ~data ~funs s.debt mem >>= fun {Machine.begs; jmps; data; debt; dels} -> let data = Set.union s.data data in @@ -644,8 +644,12 @@ let scan_step ?(code=empty) ?(data=empty) ?(funs=empty) s mem = | `Left dsts -> valid_dsts data dsts | `Right dsts -> Some dsts | `Both (d1,d2) -> valid_dsts data (merge_dests d1 d2)) in - let begs = Set.of_map_keys begs -- data in - let funs = s.funs ++ funs ++ funs' -- data -- dels in + let begs = + if record then Set.of_map_keys begs -- data + else Set.of_map_keys begs -- data -- funs in + let funs = + if record then s.funs ++ funs ++ funs' -- data -- dels + else s.funs ++ funs' -- data -- dels in let begs = Set.union s.begs begs -- dels in {funs; begs; data; jmps; mems = s.mems; debt; exts = s.exts ++ exts} @@ -668,6 +672,9 @@ let scan mem s = ~init:{s with mems = mem :: s.mems} +let resume ?(record=false) starts mem s = + scan_step ~record ~data:s.data ~funs:starts s mem + let merge t1 t2 = { funs = Set.union t1.funs t2.funs; exts = Set.union t1.exts t2.exts; @@ -768,7 +775,7 @@ let explore | Some beg,None -> Seq.singleton beg | None, Some begs -> begs | Some beg, Some begs -> Seq.cons beg begs in - let empty = Map.empty (module Addr) in + let empty = (Map.empty (module Addr)) in KB.Seq.fold entries ~init:(empty,init) ~f:(fun (blocks,cfg) beg -> build blocks cfg beg >>| fun (blocks,cfg,_) -> blocks,cfg) >>| snd diff --git a/lib/bap_disasm/bap_disasm_driver.mli b/lib/bap_disasm/bap_disasm_driver.mli index 1480d3f8f..c06fb6cd3 100644 --- a/lib/bap_disasm/bap_disasm_driver.mli +++ b/lib/bap_disasm/bap_disasm_driver.mli @@ -13,6 +13,7 @@ type jump val init : state val equal : state -> state -> bool val scan : mem -> state -> state knowledge +val resume : ?record:bool -> Set.M(Addr).t -> mem -> state -> state knowledge val merge : state -> state -> state val subroutines : state -> Set.M(Addr).t diff --git a/lib/bap_disasm/bap_disasm_insn.ml b/lib/bap_disasm/bap_disasm_insn.ml index 7606a217a..11770a489 100644 --- a/lib/bap_disasm/bap_disasm_insn.ml +++ b/lib/bap_disasm/bap_disasm_insn.ml @@ -52,7 +52,7 @@ module Props = struct module T = struct type t = Z.t include Sexpable.Of_stringable(Bits) - include Binable.Of_stringable(Bits) + include Binable.Of_stringable_without_uuid(Bits) [@@warning "-D"] end @@ -63,8 +63,20 @@ module Props = struct List.map !known_properties ~f:(fun p -> name p, has props p) - let domain = KB.Domain.flat "props" - ~empty:Z.one ~equal:Z.equal + let domain_empty = Z.one + let domain = KB.Domain.define "props" + ~empty:domain_empty + ~order:(fun x y : KB.Order.partial -> + if Z.equal x y then EQ + else if Z.equal x domain_empty then LT + else if Z.equal y domain_empty then GT + else if Z.equal (Z.logand x y) x then LT + else if Z.equal (Z.logand x y) y then GT + else NC) + ~join:(fun x y -> + if Z.equal x domain_empty then Ok y + else if Z.equal y domain_empty then Ok x + else Ok (Z.logor x y)) ~inspect:(fun props -> [%sexp_of: (string * bool) list] (assoc_of_props props)) @@ -241,11 +253,11 @@ module Analyzer = struct | _ -> indirect jump jumps method! enter_stmt s (effs,jumps) = match Bil.(decode call s) with | None -> super#enter_stmt s (effs,jumps) - | Some _ -> Effects.add effs `Call, jumps + | Some _ -> Set.add effs `Call, jumps end let run bil = - let cons c = Fn.flip @@ if c then Effects.add else Fn.const in + let cons c = Fn.flip @@ if c then Set.add else Fn.const in let effs,jump = analyzer#run bil (Effects.empty,no_jumps) in if not jump.jump then effs else @@ -260,7 +272,7 @@ let derive_props ?bil insn = | None -> Analyzer.Effects.empty in let is = Insn.is insn in let is_bil = if Option.is_some bil - then Analyzer.Effects.mem bil_effects else is in + then Set.mem bil_effects else is in let is_return = is `Return in let is_call = is_bil `Call || is `Call in let is_conditional_jump = is_bil `Conditional_branch in @@ -288,25 +300,25 @@ let (<--) slot value insn = KB.Value.put slot insn value let write init ops = List.fold ~init ops ~f:(fun init f -> f init) -let set_basic effect insn : t = - write effect Slot.[ +let set_basic eff insn : t = + write eff Slot.[ name <-- Insn.name insn; asm <-- Insn.asm insn; ops <-- Some (Insn.ops insn); ] let of_basic ?bil insn : t = - let effect = + let eff = KB.Value.put Bil.slot (KB.Value.empty Theory.Semantics.cls) (Option.value bil ~default:[]) in - write (set_basic effect insn) Slot.[ + write (set_basic eff insn) Slot.[ Props.slot <-- derive_props ?bil insn; ] -let with_basic effect insn : t = - let bil = KB.Value.get Bil.slot effect in - write (set_basic effect insn) Slot.[ +let with_basic eff insn : t = + let bil = KB.Value.get Bil.slot eff in + write (set_basic eff insn) Slot.[ Props.slot <-- derive_props ~bil insn ] diff --git a/lib/bap_disasm/bap_disasm_rec.ml b/lib/bap_disasm/bap_disasm_rec.ml index 68a83ccff..ee484c6fa 100644 --- a/lib/bap_disasm/bap_disasm_rec.ml +++ b/lib/bap_disasm/bap_disasm_rec.ml @@ -135,6 +135,12 @@ let run ?backend:_ ?(brancher=Brancher.empty) ?(rooter=Rooter.empty) arch mem = with_unit arch mem @@ fun () -> Driver.scan mem Driver.init >>= global_cfg +let run_in_scope ?(brancher=Brancher.empty) ?(rooter=Rooter.empty) arch mem = + Brancher.providing brancher @@ fun () -> + Rooter.providing rooter @@ fun () -> + with_unit arch mem @@ fun () -> + Driver.scan mem Driver.init >>= global_cfg >>| Result.return + let cfg = Fn.id let errors _ = [] let create = KB.return diff --git a/lib/bap_disasm/bap_disasm_rec.mli b/lib/bap_disasm/bap_disasm_rec.mli index 1ad0fb924..cd11e11d8 100644 --- a/lib/bap_disasm/bap_disasm_rec.mli +++ b/lib/bap_disasm/bap_disasm_rec.mli @@ -32,6 +32,14 @@ val run : ?brancher:brancher -> ?rooter:rooter -> arch -> mem -> t Or_error.t +(** [run_in_scope ?brancher ?rooter arch mem] is [run] as a knowledge + computation: the scan runs in the caller's machine, so dynamic + scopes the caller establishes (the current theory, in particular) + hold while the instructions reify. *) +val run_in_scope : + ?brancher:brancher -> + ?rooter:rooter -> arch -> mem -> t Or_error.t knowledge + val cfg : t -> Cfg.t val errors : t -> error list diff --git a/lib/bap_disasm/bap_disasm_reconstructor.ml b/lib/bap_disasm/bap_disasm_reconstructor.ml index 93e1c4778..7045ab7fb 100644 --- a/lib/bap_disasm/bap_disasm_reconstructor.ml +++ b/lib/bap_disasm/bap_disasm_reconstructor.ml @@ -51,8 +51,8 @@ let is_call b = Insn.(is call) (Block.terminator b) let entries_of_block cfg roots blk = let entries = - if is_start roots cfg blk then Block.Set.singleton blk - else Block.Set.empty in + if is_start roots cfg blk then Set.singleton (module Block) blk + else (Set.empty (module Block)) in if is_call blk then Seq.fold ~init:entries (Cfg.Node.outputs blk cfg) ~f:(fun entries e -> @@ -79,7 +79,7 @@ let add_unresolved syms name cfg blk = else syms let collect name cfg roots = - Seq.fold (Cfg.nodes cfg) ~init:(Block.Set.empty, Symtab.empty) + Seq.fold (Cfg.nodes cfg) ~init:(Set.empty (module Block), Symtab.empty) ~f:(fun (entries, syms) blk -> let entries' = entries_of_block cfg roots blk in Set.union entries entries', add_unresolved syms name cfg blk) @@ -91,12 +91,12 @@ let reachable cfg from = ~f:(fun nodes edge -> if Set.mem nodes ( Cfg.Edge.dst edge) then nodes else loop nodes (Cfg.Edge.dst edge)) in - loop Block.Set.empty from + loop (Set.empty (module Block)) from let sub roots prog start = let is_call e = Set.mem roots (Cfg.Edge.dst e) in let update_inputs node init = - Seq.fold ~init (Cfg.Node.inputs node prog) ~f:Set.add in + Seq.fold ~init (Cfg.Node.inputs node prog) ~f:(fun s x -> Set.add s x) in let rec loop cfg inputs node = Seq.fold (Cfg.Node.outputs node prog) ~init:(cfg, update_inputs node inputs) @@ -107,9 +107,9 @@ let sub roots prog start = if Cfg.Node.mem (Cfg.Edge.dst edge) cfg then cfg',inputs else loop cfg' inputs (Cfg.Edge.dst edge)) in let cfg = Cfg.Node.insert start Cfg.empty in - loop cfg Cfg.Edge.Set.empty start + loop cfg (Set.empty (module Cfg.Edge)) start -let edges_of_seq s = Seq.fold s ~init:Cfg.Edge.Set.empty ~f:Set.add +let edges_of_seq s = Seq.fold s ~init:(Set.empty (module Cfg.Edge)) ~f:(fun s x -> Set.add s x) let reconstruct name initial_roots prog = let (--) = Set.diff in @@ -125,7 +125,7 @@ let reconstruct name initial_roots prog = let cfg = Set.fold reachable ~init:cfg ~f:remove_node in remove_node cfg from in let collect_destinations edges = - Set.fold edges ~init:Block.Set.empty ~f:(fun bs e -> + Set.fold edges ~init:(Set.empty (module Block)) ~f:(fun bs e -> Set.add bs (Cfg.Edge.dst e)) in let rec loop known_roots syms = function | [] -> syms,known_roots @@ -139,14 +139,14 @@ let reconstruct name initial_roots prog = let syms = update_symtab syms cfg root self_inputs in let syms,known = loop known syms (Set.to_list calls) in loop known syms roots in - let initial_roots = Addr.Set.of_list initial_roots in + let initial_roots = Set.of_list (module Addr) initial_roots in let roots,syms = collect name prog initial_roots in fst @@ loop roots syms (Set.to_list roots) let of_blocks syms = let reconstruct (cfg : cfg) = - let blocks = Addr.Table.create () in - let symtab = String.Table.create () in + let blocks = Hashtbl.create (module Addr) in + let symtab = Hashtbl.create (module String) in Seq.iter (Cfg.nodes cfg) ~f:(fun blk -> Hashtbl.set blocks ~key:(Block.addr blk) ~data:blk); Seq.iter syms ~f:(fun (name,b,_) -> match Hashtbl.find blocks b with diff --git a/lib/bap_disasm/bap_disasm_rooter.ml b/lib/bap_disasm/bap_disasm_rooter.ml index 1447e1b50..c7abe90d1 100644 --- a/lib/bap_disasm/bap_disasm_rooter.ml +++ b/lib/bap_disasm/bap_disasm_rooter.ml @@ -47,7 +47,7 @@ let of_image img = { } let of_blocks blocks = - let roots = String.Table.create () in + let roots = Hashtbl.create (module String) in Seq.iter blocks ~f:(fun (name,sa,_) -> Hashtbl.change roots name (function | Some a when Addr.(a < sa) -> Some a @@ -55,10 +55,10 @@ let of_blocks blocks = create (Hashtbl.data roots |> Seq.of_list) let make_provider rooter = - let init = Set.empty (module Word) in + let init = (Set.empty (module Word)) in let roots = roots rooter |> - Seq.fold ~init ~f:Set.add in + Seq.fold ~init ~f:(fun s x -> Set.add s x) in fun label -> KB.collect Theory.Label.addr label >>=? fun addr -> Context.for_label label >>| fun ctxt -> diff --git a/lib/bap_disasm/bap_disasm_symbolizer.ml b/lib/bap_disasm/bap_disasm_symbolizer.ml index 35ba9c187..c3870693c 100644 --- a/lib/bap_disasm/bap_disasm_symbolizer.ml +++ b/lib/bap_disasm/bap_disasm_symbolizer.ml @@ -63,7 +63,7 @@ let report_broken = function let of_image img = let symtab = Image.symbols img in - let names = Addr.Table.create () in + let names = Hashtbl.create (module Addr) in let init = Bap_relation.empty Addr.compare String.compare in Table.foldi symtab ~init ~f:(fun mem sym rels -> let name = Image.Symbol.name sym @@ -79,14 +79,14 @@ let of_image img = let of_blocks seq = let names = let empty_rel = Bap_relation.empty Addr.compare String.compare in - Seq.fold seq ~init:String.Map.empty ~f:(fun addrs (name,addr,_) -> + Seq.fold seq ~init:(Map.empty (module String)) ~f:(fun addrs (name,addr,_) -> Map.update addrs name (function | Some addr' -> Addr.min addr addr' | None -> addr)) |> Map.to_sequence |> Seq.fold ~init:empty_rel ~f:(fun rels (name,entry) -> Bap_relation.add rels entry name) |> fun rels -> - Bap_relation.matching rels Addr.Map.empty + Bap_relation.matching rels (Map.empty (module Addr)) ~saturated:(fun addr name names -> Map.add_exn names addr name) ~unmatched:(fun reason names -> report_broken reason; names) in create @@ Map.find names diff --git a/lib/bap_disasm/bap_disasm_symtab.ml b/lib/bap_disasm/bap_disasm_symtab.ml index a13ffa1e0..4e85a8f60 100644 --- a/lib/bap_disasm/bap_disasm_symtab.ml +++ b/lib/bap_disasm/bap_disasm_symtab.ml @@ -27,10 +27,14 @@ type fn = string * block * cfg [@@deriving compare] let sexp_of_fn (name,block,_cfg) = Sexp.List [sexp_of_string name; sexp_of_addr (Block.addr block)] -module Fn = Opaque.Make(struct - type t = fn [@@deriving compare] - let hash x = String.hash (fst3 x) - end) +module Fn = struct + type t = fn [@@deriving compare] + let hash x = String.hash (fst3 x) + include Opaque.Make(struct + type nonrec t = t [@@deriving compare] + let hash x = String.hash (fst3 x) + end) +end type t = { @@ -44,7 +48,7 @@ type t = { let compare t1 t2 = - Addr.Map.compare Fn.compare t1.addrs t2.addrs + Base.Map.compare_direct Poly.compare t1.addrs t2.addrs type symtab = t [@@deriving compare, sexp_of] @@ -53,12 +57,12 @@ let span ((_name,_entry,cfg) as fn) = Memmap.add map (Block.memory blk) fn) let empty = { - addrs = Addr.Map.empty; - names = String.Map.empty; + addrs = (Map.empty (module Addr)); + names = (Map.empty (module String)); memory = Memmap.empty; - ecalls = Map.empty (module Addr); - icalls = Map.empty (module Addr); - extern = Map.empty (module Theory.Label); + ecalls = (Map.empty (module Addr)); + icalls = (Map.empty (module Addr)); + extern = (Map.empty (module Theory.Label)); } let merge m1 m2 = @@ -98,7 +102,7 @@ let find_by_start tab = Map.find tab.addrs let find_by_name tab = Map.find tab.names let fns_of_seq seq = - Seq.map seq ~f:snd |> Seq.to_list |> Fn.Set.of_list |> + Seq.map seq ~f:snd |> Seq.to_list |> Set.of_list (module Fn) |> Set.to_list let owners t addr = Memmap.lookup t.memory addr |> fns_of_seq diff --git a/lib/bap_disasm/bap_disasm_target_factory.ml b/lib/bap_disasm/bap_disasm_target_factory.ml index a5e27ca69..00f929fa4 100644 --- a/lib/bap_disasm/bap_disasm_target_factory.ml +++ b/lib/bap_disasm/bap_disasm_target_factory.ml @@ -9,7 +9,7 @@ let create_stub_target arch = let addr_size = Arch.addr_size arch module CPU = struct - let gpr = Var.Set.empty + let gpr = (Set.empty (module Var)) let nil = Var.create "nil" (Type.imm (Size.in_bits addr_size)) let mem = Var.create "mem" (Type.mem addr_size `r8) let pc = nil @@ -35,7 +35,7 @@ let create_stub_target arch = end in (module Lifter : Target) -let targets = Arch.Table.create () +let targets = Hashtbl.create (module Arch) let target_of_arch = let get arch = match Hashtbl.find targets arch with diff --git a/lib/bap_dwarf/dwarf_data.ml b/lib/bap_dwarf/dwarf_data.ml index b11d32162..da75bac7b 100644 --- a/lib/bap_dwarf/dwarf_data.ml +++ b/lib/bap_dwarf/dwarf_data.ml @@ -35,12 +35,12 @@ type 'a t = { let create endian ss : 'a t Or_error.t = let open Or_error.Monad_infix in - Section.Map.of_alist_or_error ss >>| + Map.of_alist_or_error (module Section) ss >>| fun sections -> {sections; endian} let section t section = - match Section.Map.find t.sections section with + match Map.find t.sections section with | Some buf -> Ok buf | None -> Or_error.errorf "section %s is not available" @@ diff --git a/lib/bap_dwarf/dwarf_fbi.ml b/lib/bap_dwarf/dwarf_fbi.ml index 0bf00e12d..e47789956 100644 --- a/lib/bap_dwarf/dwarf_fbi.ml +++ b/lib/bap_dwarf/dwarf_fbi.ml @@ -140,7 +140,7 @@ let read_scheme s str_sec action str ~pos_ref = loop [] let create_table s str_sec str ~pos_ref = - let abbrs : table = Table.create () in + let abbrs : table = Hashtbl.create (module Int) in let rec fill () = Input.code str ~pos_ref >>= function | 0 -> return () @@ -152,15 +152,13 @@ let create_table s str_sec str ~pos_ref = | Subprogram | Entry_point | Inlined_subroutine -> Input.take | _ -> Input.drop in read_scheme s str_sec action str ~pos_ref - >>= fun scheme -> match Table.add abbrs ~key:code ~data:scheme with - | `Ok -> fill () - | `Duplicate -> errorf "Duplicate entry code: %d" code in + >>= fun scheme -> Hashtbl.set abbrs ~key:code ~data:scheme; fill () in fill () >>| fun () -> abbrs let lookup table code = let error = Error.create "unknown code" code sexp_of_int in - Result.of_option ~error @@ Table.find table code + Result.of_option ~error @@ Hashtbl.find table code let run_scheme scheme str ~pos_ref : value list Or_error.t = @@ -173,12 +171,12 @@ let read_function cu_end abbrs str ~pos_ref = let open Sequence.Step in if pos_ref.contents < cu_end then Input.code str ~pos_ref >>= function - | 0 -> return @@ Skip () + | 0 -> return @@ Skip {state=()} | code -> lookup abbrs code >>= fun scheme -> run_scheme scheme str ~pos_ref >>| fun vs -> match fn_of_values vs with - | Ok fn -> Yield (fn, ()) - | Error _ -> Skip () + | Ok fn -> Yield {value=fn; state=()} + | Error _ -> Skip {state=()} else return Done let create data : t Or_error.t = @@ -213,14 +211,14 @@ let create data : t Or_error.t = abbr_pos := Buffer.pos abbr_sec; if info_pos.contents < String.length info then match read_header () with - | Ok abbrs -> Skip abbrs + | Ok abbrs -> Skip {state=abbrs} | Error err -> eprintf "Failed to move to a next CU: %s" @@ (Error.to_string_hum err); Done else Done - | Ok (Yield (fn,())) -> Yield (fn,(abbrs,cu_end)) - | Ok (Skip ()) -> Skip (abbrs,cu_end) + | Ok (Yield {value=fn;state=()}) -> Yield {value=fn; state=(abbrs,cu_end)} + | Ok (Skip {state=()}) -> Skip {state=(abbrs,cu_end)} | Error err -> eprintf "Warning: Dwarf parser stopped prematurely: %s\n\ diff --git a/lib/bap_elf/elf_parse.ml b/lib/bap_elf/elf_parse.ml index 9d4ec35c6..b1dd761ae 100644 --- a/lib/bap_elf/elf_parse.ml +++ b/lib/bap_elf/elf_parse.ml @@ -34,7 +34,7 @@ open Bitstring open Elf_types open Elf_internal_utils -module Char = Caml.Char +module Char = Stdlib.Char let elf_max_header_size = 64 (* no magick! *) diff --git a/lib/bap_future/bap_future.ml b/lib/bap_future/bap_future.ml index 4e9915883..d092f32fb 100644 --- a/lib/bap_future/bap_future.ml +++ b/lib/bap_future/bap_future.ml @@ -232,7 +232,7 @@ module Std = struct let create () = let stream = { - subs = Id.Table.create (); + subs = Hashtbl.create (module Id); last_id = Id.zero; on_subs = []; on_unsubs = []; diff --git a/lib/bap_image/bap_image.ml b/lib/bap_image/bap_image.ml index 6598dfd53..8dc590f84 100644 --- a/lib/bap_image/bap_image.ml +++ b/lib/bap_image/bap_image.ml @@ -6,7 +6,7 @@ open Bap_types.Std open Monads.Std open Format open Image_internal_std -module Sys = Caml.Sys +module Sys = Stdlib.Sys module Fact = Ogre.Make(Monad.Ident) module Result = Monad.Result.Error @@ -21,7 +21,7 @@ end type loader = (module Loader) let backends : loader String.Table.t = - String.Table.create () + Hashtbl.create (module String) module KB = struct module type Loader = sig @@ -373,15 +373,15 @@ let create_words secs = { let available_backends () = Hashtbl.keys backends let create_segment_of_symbol_table syms secs = - let tab = Symbol.Table.create () + let tab = Hashtbl.create (module Symbol) ~growth_allowed:false ~size:(Table.length syms) in Table.iteri syms ~f:(fun mem sym -> match Table.find_addr secs (Memory.min_addr mem) with | None -> () | Some (_,sec) -> - Symbol.Table.add_exn tab ~key:sym ~data:sec); - Symbol.Table.find_exn tab + Hashtbl.add_exn tab ~key:sym ~data:sec); + Hashtbl.find_exn tab let from_spec query base doc = Fact.eval query doc >>= function diff --git a/lib/bap_image/bap_memory.ml b/lib/bap_image/bap_memory.ml index 4e3c705c2..91bcbf584 100644 --- a/lib/bap_image/bap_memory.ml +++ b/lib/bap_image/bap_memory.ml @@ -32,7 +32,7 @@ module Repr = struct } [@@deriving bin_io] end -include Binable.Of_binable(Repr)(struct +include Binable.Of_binable_without_uuid(Repr)(struct type nonrec t = t let to_binable {endian; addr; data; off; size} : Repr.t = { endian; diff --git a/lib/bap_image/bap_table.ml b/lib/bap_image/bap_table.ml index bcdd768d9..78427a6a2 100644 --- a/lib/bap_image/bap_table.ml +++ b/lib/bap_image/bap_table.ml @@ -68,12 +68,12 @@ type 'a ranged -> 'a let empty = { - map = Map.empty; + map = (Base.Map.empty (module Mem)); bound = Bound.empty; } let singleton k v = { - map = Map.singleton k v; + map = Base.Map.singleton (module Mem) k v; bound = Bound.(update empty k); } @@ -84,12 +84,12 @@ let pp_elt f fmt = function (** @pre [x <= y] *) let intersects x y = Addr.(Mem.max_addr x >= Mem.min_addr y) -let prev_key map key = Map.closest_key map `Less_than key -let next_key map key = Map.closest_key map `Greater_than key +let prev_key map key = Base.Map.closest_key map `Less_than key +let next_key map key = Base.Map.closest_key map `Greater_than key let has_intersections tab (x : mem) : bool = Bound.is_bound tab.bound x && - match Map.find tab.map x with + match Base.Map.find tab.map x with | Some _ -> true | None -> match prev_key tab.map x with | Some (p,_) when intersects p x -> true @@ -117,7 +117,7 @@ let left_bound tab x = | _ -> p in if has_intersections tab x then match prev_key tab.map x with | Some (p,_) when intersects p x -> Some (search_left p) - | _ when Map.mem tab.map x -> Some x (* see note above*) + | _ when Base.Map.mem tab.map x -> Some x (* see note above*) | _ -> next_key tab.map x |> Option.map ~f:fst else None @@ -129,7 +129,7 @@ let fold_intersections tab x ~init ~f = | _ -> init in match left_bound tab x with | None -> init - | Some p -> match Map.find tab.map p with + | Some p -> match Base.Map.find tab.map p with | Some d -> loop (p,d) init | None -> assert false @@ -146,16 +146,16 @@ let change tab mem ~f = | `ignore -> tab | `update _ | `rebind _ | `remove as cmd -> let map = - Seq.fold ins ~init:tab.map ~f:(fun m (k,_) -> Map.remove m k) in + Seq.fold ins ~init:tab.map ~f:(fun m (k,_) -> Base.Map.remove m k) in let map, bound = match cmd with | `remove -> map, tab.bound | `update f -> Seq.fold ins ~init:(map, tab.bound) ~f:(fun (map,bnd) (mem,x) -> - Map.set map ~key:mem ~data:(f (mem,x)), + Base.Map.set map ~key:mem ~data:(f (mem,x)), Bound.update bnd mem) | `rebind (mem,data) -> - Map.set map ~key:mem ~data, + Base.Map.set map ~key:mem ~data, Bound.update tab.bound mem in { map; bound } @@ -163,28 +163,28 @@ let add tab mem x = if has_intersections tab mem then error "memory has intersections" mem sexp_of_mem else Ok { - map = Mem.Map.set tab.map ~key:mem ~data:x; + map = Base.Map.set tab.map ~key:mem ~data:x; bound = Bound.update tab.bound mem; } let remove tab x = (* we shouldn't invalidate our cache if nothing changes *) - if Map.mem tab.map x + if Base.Map.mem tab.map x then { tab with - map = Map.remove tab.map x; + map = Base.Map.remove tab.map x; } else tab -let length tab = Map.length tab.map +let length tab = Base.Map.length tab.map -let find tab mem = Map.find tab.map mem -let mem tab mem = Map.mem tab.map mem +let find tab mem = Base.Map.find tab.map mem +let mem tab mem = Base.Map.mem tab.map mem let next tab = next_key tab.map let prev tab = prev_key tab.map -let min tab = Map.min_elt tab.map -let max tab = Map.max_elt tab.map +let min tab = Base.Map.min_elt tab.map +let max tab = Base.Map.max_elt tab.map let first_some user our = Option.first_some user (Option.map ~f:fst our) @@ -192,19 +192,19 @@ let first_some user our = let foldi ?start ?until (tab : 'a t) ~(init : 'b) ~f : 'b = let f_labeled = fun ~key ~data s -> f key data s in if Option.is_none start && Option.is_none until - then Map.fold tab.map ~init:init ~f:f_labeled + then Base.Map.fold tab.map ~init:init ~f:f_labeled else - let from = first_some start (Map.min_elt tab.map) in - let last = first_some until (Map.max_elt tab.map) in + let from = first_some start (Base.Map.min_elt tab.map) in + let last = first_some until (Base.Map.max_elt tab.map) in match from,last with | Some from, Some last -> if Mem.(from <= last) - then Map.fold_range_inclusive tab.map + then Base.Map.fold_range_inclusive tab.map ~init ~min:from ~max:last ~f:f_labeled else let last,from = from,last in let seq = - Map.to_sequence tab.map + Base.Map.to_sequence tab.map ~order:`Decreasing_key ~keys_less_or_equal_to:from |> Seq.take_while ~f:(fun (m,_) -> Mem.(m >= last)) in @@ -283,14 +283,14 @@ let make_map map add ?start ?until tab ~f = map = map tab.map ~f:(fun ~key ~data -> f key data); } else let map,bound = - foldi ?start ?until tab ~init:(Map.empty,Bound.empty) + foldi ?start ?until tab ~init:((Base.Map.empty (module Mem)),Bound.empty) ~f:(fun addr x (map,bound) -> add map ~key:addr ~data:(f addr x), Bound.update bound addr) in { map; bound} let mapi ?start ?until tab ~f = - make_map Map.mapi Map.set ?start ?until tab ~f + make_map Base.Map.mapi Base.Map.set ?start ?until tab ~f let map ?start ?until tab ~f = mapi ?start ?until tab ~f:(fun _ x -> f x) @@ -298,8 +298,8 @@ let map ?start ?until tab ~f = let filter_mapi ?start ?until tab ~f = let add map ~key ~data = match data with | None -> map - | Some data -> Map.set map ~key ~data in - make_map Map.filter_mapi add ?start ?until tab ~f + | Some data -> Base.Map.set map ~key ~data in + make_map Base.Map.filter_mapi add ?start ?until tab ~f let filter_map ?start ?until tab ~f = filter_mapi ?start ?until tab ~f:(fun _ v -> f v) @@ -312,16 +312,16 @@ let filter ?start ?until tab ~f = filteri ?start ?until tab ~f:(fun _ x -> f x) let make_mapping t map = - let size = Map.length map in + let size = Base.Map.length map in let table = Hashtbl.Using_hashable.create ~growth_allowed:false ~size ~hashable:t () in - Map.iteri map ~f:(fun ~key:_ ~data:(v1,v2) -> + Base.Map.iteri map ~f:(fun ~key:_ ~data:(v1,v2) -> Hashtbl.add_exn table ~key:v1 ~data:v2); table let link_maybe_one t (t1 : 'a t) (t2 : 'b t) : 'a -> 'b option = let mapping = - Map.merge t1.map t2.map ~f:(fun ~key -> function + Base.Map.merge t1.map t2.map ~f:(fun ~key -> function | `Both (v1,v2) -> Some (v1,v2) | `Left _ | `Right _ -> None) |> make_mapping t in @@ -339,10 +339,10 @@ let link_one t t1 t2 = Error.raise err let link_many t t1 t2 = - let size = Map.length t1.map in + let size = Base.Map.length t1.map in let table = Hashtbl.Using_hashable.create ~growth_allowed:false ~size ~hashable:t () in - Map.iteri t1.map ~f:(fun ~key:mem ~data:x -> + Base.Map.iteri t1.map ~f:(fun ~key:mem ~data:x -> let data = intersections t2 mem |> Seq.map ~f:snd in Hashtbl.add_exn table ~key:x ~data); fun x -> match Hashtbl.find table x with @@ -383,10 +383,10 @@ let link : type b c . one_to:((b,c) r) -> (* reverse injective mapping *) let make_rev_map add find t tab = - let size = Map.length tab.map in + let size = Base.Map.length tab.map in let table = Hashtbl.Using_hashable.create ~growth_allowed:false ~hashable:t ~size () in - Map.iteri tab.map ~f:(fun ~key:mem ~data:x -> + Base.Map.iteri tab.map ~f:(fun ~key:mem ~data:x -> add t table ~key:x ~data:mem); find t table diff --git a/lib/bap_llvm/bap_llvm_loader.ml b/lib/bap_llvm/bap_llvm_loader.ml index b3db45b4b..9fc583f30 100644 --- a/lib/bap_llvm/bap_llvm_loader.ml +++ b/lib/bap_llvm/bap_llvm_loader.ml @@ -7,7 +7,7 @@ open Or_error include Self() -module Sys = Caml.Sys +module Sys = Stdlib.Sys module Unix = Caml_unix module Ogre = struct @@ -122,7 +122,7 @@ module LLVM = struct (scheme name $ addr $ size) Tuple.T3.create end -module Filename = Caml.Filename +module Filename = Stdlib.Filename open Image.Scheme open Ogre.Syntax diff --git a/lib/bap_llvm/config/llvm_configurator.ml b/lib/bap_llvm/config/llvm_configurator.ml index 961feabd3..56ee5e65f 100644 --- a/lib/bap_llvm/config/llvm_configurator.ml +++ b/lib/bap_llvm/config/llvm_configurator.ml @@ -2,9 +2,9 @@ open Base open Stdio module C = Configurator.V1 -module Buf = Caml.Buffer -module Arg = Caml.Arg -module Filename = Caml.Filename +module Buf = Stdlib.Buffer +module Arg = Stdlib.Arg +module Filename = Stdlib.Filename open Llvm_config let llvm_components = [ @@ -47,7 +47,7 @@ let () = C.main ~args ~name:"bap-llvm" @@ fun self -> String.strip @@ C.Process.run_capture_exn self llvm_config ["--version"] in let src = !filename in - let dst = Caml.Filename.chop_extension src in + let dst = Stdlib.Filename.chop_extension src in In_channel.with_file src ~f:(fun input -> Out_channel.with_file dst ~f:(fun output -> In_channel.iter_lines input ~f:(fun line -> diff --git a/lib/bap_llvm/llvm_elf_loader.hpp b/lib/bap_llvm/llvm_elf_loader.hpp index 12bf80bc7..417918c0c 100644 --- a/lib/bap_llvm/llvm_elf_loader.hpp +++ b/lib/bap_llvm/llvm_elf_loader.hpp @@ -115,6 +115,7 @@ void emit_program_headers(const ELFObjectFile &obj, ogre_doc &s) { auto filesz = it->p_filesz; auto name = name_of_index(it - hdrs.begin()); s.entry("llvm:elf-program-header") << name << off << filesz; + s.entry("llvm:elf-program-header-type") << name << it->p_type << it->p_align; s.entry("llvm:elf-virtual-program-header") << name << it->p_vaddr << it->p_memsz; s.entry("llvm:elf-program-header-flags") << name << ld << r << w << x; } @@ -254,7 +255,12 @@ void emit_relocations(const ELFObjectFile &obj, ogre_doc &s) { } } else { auto typ = prim::relocation_type(rel); - if (typ == rel_reloc) s.entry("llvm:relative-relocation") << raddr; + if (typ == rel_reloc) { + s.entry("llvm:relative-relocation") << raddr; + if (auto addend = ELFRelocationRef(rel).getAddend()) + s.entry("llvm:relative-relocation-addend") << raddr + << *addend; + } } } } diff --git a/lib/bap_llvm/llvm_loader.hpp b/lib/bap_llvm/llvm_loader.hpp index 5fa00604b..47e0aed57 100644 --- a/lib/bap_llvm/llvm_loader.hpp +++ b/lib/bap_llvm/llvm_loader.hpp @@ -25,9 +25,11 @@ static std::string scheme = "(declare llvm:macho-symbol (name str) (value int))\n" "(declare llvm:elf-program-header-flags (name str) (ld bool) (r bool) (w bool) (x bool))\n" "(declare llvm:elf-program-header (name str) (off int) (size int))\n" + "(declare llvm:elf-program-header-type (name str) (type int) (align int))\n" "(declare llvm:name-reference (at int) (name str))\n" "(declare llvm:relocation (at int) (addr int))\n" "(declare llvm:relative-relocation (at int))\n" + "(declare llvm:relative-relocation-addend (at int) (addend int))\n" "(declare llvm:section-entry (name str) (addr int) (size int) (off int))\n" "(declare llvm:section-flags (name str) (r bool) (w bool) (x bool))\n" "(declare llvm:segment-command-flags (name str) (r bool) (w bool) (x bool))\n" diff --git a/lib/bap_main/bap_main.ml b/lib/bap_main/bap_main.ml index 726d4c802..8c5c1ce02 100644 --- a/lib/bap_main/bap_main.ml +++ b/lib/bap_main/bap_main.ml @@ -258,9 +258,9 @@ module Error = struct type t += Exit_requested of int type t += Bad_recipe of Bap_recipe.error - let register_printer = Caml.Printexc.register_printer + let register_printer = Stdlib.Printexc.register_printer let pp ppf e = - Format.pp_print_string ppf (Caml.Printexc.to_string e) + Format.pp_print_string ppf (Stdlib.Printexc.to_string e) let str fmt = Format.kasprintf Option.some fmt @@ -433,8 +433,8 @@ module Context = struct let command_descriptions = Hashtbl.create (module String) let builder = ref @@ Building { - env = Map.empty (module String); - plugins = Map.empty (module String); + env = (Map.empty (module String)); + plugins = (Map.empty (module String)); } let update f = match builder.contents with @@ -464,7 +464,7 @@ module Context = struct env = Map.filter ctxt.env ~f:(fun {scope} -> not (Set.mem disabled scope)); plugins = - let init = Map.empty (module String) in + let init = (Map.empty (module String)) in List.fold ~init plugins ~f:(fun plugins (name,{tags}) -> if Set.mem disabled name then plugins else @@ -531,7 +531,7 @@ module Context = struct Map.iteri ctxt.env ~f:(fun ~key ~data:{digest} -> Format.fprintf ppf "%s = %s@\n" key digest); Format.pp_print_flush ppf (); - Caml.Digest.string @@ + Stdlib.Digest.string @@ Buffer.contents buffer (* the info interface *) @@ -923,8 +923,8 @@ end = struct let get_from_env name = let name = env_var_for_option name in - try Some (Caml.Sys.getenv name) - with Caml.Not_found -> None + try Some (Stdlib.Sys.getenv name) + with Stdlib.Not_found -> None let get_from_config ctxt name = List.Assoc.find ~equal:String.equal ctxt.config name @@ -1002,7 +1002,7 @@ end = struct t1 >>> t2) let progname = - Caml.Filename.basename (Caml.Sys.executable_name) + Stdlib.Filename.basename (Stdlib.Sys.executable_name) let with_context name ~f = @@ -1011,7 +1011,7 @@ end = struct let try_eval f x = try f x with | Invalid_argument s -> Error (Error.Invalid s) | exn -> - let backtrace = Caml.Printexc.get_backtrace () in + let backtrace = Stdlib.Printexc.get_backtrace () in Error (Error.Bug (exn,backtrace)) @@ -1178,7 +1178,7 @@ module Extension = struct try Ok (f ctxt) with | Invalid_argument s -> Error (Error.Invalid s) | exn -> - let backtrace = Caml.Printexc.get_backtrace () in + let backtrace = Stdlib.Printexc.get_backtrace () in Error (Error.Bug (exn,backtrace)) let doc_enum = Arg.doc_alts_enum diff --git a/lib/bap_main/bap_main_event.ml b/lib/bap_main/bap_main_event.ml index cb65bf743..3be986aa5 100644 --- a/lib/bap_main/bap_main_event.ml +++ b/lib/bap_main/bap_main_event.ml @@ -4,8 +4,8 @@ open Bap_plugins.Std open Bap_bundle.Std open Format -module Buffer = Caml.Buffer -module Sys = Caml.Sys +module Buffer = Stdlib.Buffer +module Sys = Stdlib.Sys (* we're reusing [exn] type only because we want to use Printexc magic printer. It is not visible from outside, @@ -16,10 +16,10 @@ module Sys = Caml.Sys type t = exn = .. type event = t = .. -let register_printer = Caml.Printexc.register_printer +let register_printer = Stdlib.Printexc.register_printer let stream,new_event = Stream.create () let send (ev : t) = Signal.send new_event ev -let string_of_event = Caml.Printexc.to_string +let string_of_event = Stdlib.Printexc.to_string let pp ppf e = pp_print_string ppf (string_of_event e) @@ -98,7 +98,7 @@ module Log = struct progress ?note ?stage ?total task let has_var v = match Sys.getenv ("BAP_" ^ String.uppercase v) with - | exception Caml.Not_found -> false + | exception Stdlib.Not_found -> false | "false" | "0" -> false | _ -> true diff --git a/lib/bap_main/bap_main_log.ml b/lib/bap_main/bap_main_log.ml index ca4256b27..f9e2c9090 100644 --- a/lib/bap_main/bap_main_log.ml +++ b/lib/bap_main/bap_main_log.ml @@ -4,12 +4,12 @@ open Bap_plugins.Std open Format module Event = Bap_main_event -module Filename = Caml.Filename -module Sys = Caml.Sys +module Filename = Stdlib.Filename +module Sys = Stdlib.Sys module Unix = Caml_unix let perm = 0o770 -let getenv opt = try Some (Sys.getenv opt) with Caml.Not_found -> None +let getenv opt = try Some (Sys.getenv opt) with Stdlib.Not_found -> None let rec mkdir path = let par = Filename.dirname path in diff --git a/lib/bap_piqi/bil_piqi.ml b/lib/bap_piqi/bil_piqi.ml deleted file mode 100644 index c54ecd0d5..000000000 --- a/lib/bap_piqi/bil_piqi.ml +++ /dev/null @@ -1,261 +0,0 @@ -open Core_kernel[@@warning "-D"] -open Bap.Std -open Bil.Types - -module P = Stmt_piqi -open Type - -let casttype_to_piqi = function - | UNSIGNED -> `cast_unsigned - | SIGNED -> `cast_signed - | HIGH -> `cast_high - | LOW -> `cast_low - -let casttype_of_piqi = function - | `cast_unsigned -> UNSIGNED - | `cast_signed -> SIGNED - | `cast_high -> HIGH - | `cast_low -> LOW - -let unop_to_piqi : 'a -> Stmt_piqi.unop_type = function - | NEG -> `uneg - | NOT -> `unot - -let unop_of_piqi = function - | `uneg -> NEG - | `unot -> NOT - -let binop_to_piqi : 'a -> Stmt_piqi.binop_type = function - | PLUS -> `plus - | MINUS -> `minus - | TIMES -> `times - | DIVIDE -> `divide - | SDIVIDE -> `sdivide - | MOD -> `modbop - | SMOD -> `smod - | LSHIFT -> `lshift - | RSHIFT -> `rshift - | ARSHIFT -> `arshift - | AND -> `andbop - | OR -> `orbop - | XOR -> `x_or - | EQ -> `eq - | NEQ -> `neq - | LT -> `lt - | LE -> `le - | SLT -> `slt - | SLE -> `sle - -let binop_of_piqi = function - | `plus -> PLUS - | `minus -> MINUS - | `times -> TIMES - | `divide -> DIVIDE - | `sdivide -> SDIVIDE - | `modbop -> MOD - | `smod -> SMOD - | `lshift -> LSHIFT - | `rshift -> RSHIFT - | `arshift -> ARSHIFT - | `andbop -> AND - | `orbop -> OR - | `x_or -> XOR - | `eq -> EQ - | `neq -> NEQ - | `lt -> LT - | `le -> LE - | `slt -> SLT - | `sle -> SLE - -let type_to_piqi : typ -> Stmt_piqi.typ = function - | Imm s -> `imm s - | Mem (t, t') -> `mem {Stmt_piqi.Mem.index_type = t; element_type = t';} - | Unk -> `unk - -let type_of_piqi = function - | `imm n -> Imm n - | `mem {P.Mem.index_type; element_type} -> Mem (index_type, element_type) - | `unk -> Type.Unk - -let var_to_piqi v = - let module P = Stmt_piqi in { - P.Var.name = Var.name v; - P.Var.id = Var.index v; - P.Var.typ = type_to_piqi (Var.typ v); - P.Var.tmp = Var.is_virtual v; - } - -let var_of_piqi { P.Var.name; id; typ; tmp} = - let module P = Stmt_piqi in - let v = Var.create ~is_virtual:tmp name (type_of_piqi typ) in - Var.with_index v id - -let endianness_to_piqi : endian -> Stmt_piqi.endian = function - | LittleEndian -> `little_endian - | BigEndian -> `big_endian - -let endianness_of_piqi = function - | `little_endian -> LittleEndian - | `big_endian -> BigEndian - -let rec exp_to_piqi : exp -> Stmt_piqi.expr = - function - | Load (m, i, e, s) -> - let m = exp_to_piqi m in - let i = exp_to_piqi i in - let e = endianness_to_piqi e in - `load {P.Load.memory=m; address=i; endian=e; size=s;} - | Store (m, i, v, e, size) -> - let m = exp_to_piqi m in - let i = exp_to_piqi i in - let v = exp_to_piqi v in - let e = endianness_to_piqi e in - `store {P.Store.memory=m; address=i; value=v; endian=e; size;} - | BinOp (bop, e1, e2) -> - let bop = binop_to_piqi bop in - let e1 = exp_to_piqi e1 in - let e2 = exp_to_piqi e2 in - `binop {P.Binop.op=bop; lexp=e1; rexp=e2;} - | UnOp (uop, e) -> - let uop = unop_to_piqi uop in - let e = exp_to_piqi e in - `unop {P.Unop.op=uop; exp=e} - | Var v -> - `var (var_to_piqi v) - | Int v -> - `inte {P.Inte.int = Bitvector.to_string v;} - | Cast (ct, size, e) -> - let ct = casttype_to_piqi ct in - let e = exp_to_piqi e in - `cast {P.Cast.cast_type=ct; size; exp=e} - | Let (v, e, e') -> - let v = var_to_piqi v in - let e = exp_to_piqi e in - let e' = exp_to_piqi e' in - `let_exp {P.Let_exp.bound_var=v; definition=e; open_exp=e'} - | Unknown (s, t) -> - let t = type_to_piqi t in - `unknown {P.Unknown.descr=s; typ=t} - | Ite (e, te, fe) -> - let e = exp_to_piqi e in - let te = exp_to_piqi te in - let fe = exp_to_piqi fe in - `ite {P.Ite.condition=e; iftrue=te; iffalse=fe} - | Extract (h, l, e) -> - let e = exp_to_piqi e in - `extract {P.Extract.hbit=h; lbit=l; exp=e} - | Concat (e1, e2) -> - let e1 = exp_to_piqi e1 in - let e2 = exp_to_piqi e2 in - `concat {P.Concat.lexp=e1; rexp=e2} - -let rec exp_of_piqi = function - | `load {P.Load.memory; address; endian; size} -> - let m = exp_of_piqi memory in - let i = exp_of_piqi address in - let e = endianness_of_piqi endian in - Load (m, i, e, size) - | `store {P.Store.memory; address; value; endian; size} -> - let m = exp_of_piqi memory in - let i = exp_of_piqi address in - let v = exp_of_piqi value in - let e = endianness_of_piqi endian in - Store (m, i, v, e, size) - | `binop {P.Binop.op; lexp; rexp} -> - let bop = binop_of_piqi op in - let e1 = exp_of_piqi lexp in - let e2 = exp_of_piqi rexp in - BinOp (bop, e1, e2) - | `unop {P.Unop.op; exp} -> - let uop = unop_of_piqi op in - let e = exp_of_piqi exp in - UnOp (uop, e) - | `var v -> - Var (var_of_piqi v) - | `inte {P.Inte.int=s} -> - Int (Bitvector.of_string s) - | `cast {P.Cast.cast_type; size; exp} -> - let ct = casttype_of_piqi cast_type in - let e = exp_of_piqi exp in - Cast (ct, size, e) - | `let_exp {P.Let_exp.bound_var; definition; open_exp} -> - let v = var_of_piqi bound_var in - let d = exp_of_piqi definition in - let e = exp_of_piqi open_exp in - Let (v, d, e) - | `unknown {P.Unknown.descr; typ} -> - let t = type_of_piqi typ in - Unknown (descr, t) - | `ite {P.Ite.condition; iftrue; iffalse} -> - let cond = exp_of_piqi condition in - let te = exp_of_piqi iftrue in - let fe = exp_of_piqi iffalse in - Ite (cond, te, fe) - | `extract {P.Extract.hbit; lbit; exp} -> - let e = exp_of_piqi exp in - Extract (hbit, lbit, e) - | `concat {P.Concat.lexp; rexp} -> - let e1 = exp_of_piqi lexp in - let e2 = exp_of_piqi rexp in - Concat (e1, e2) - -let rec stmt_to_piqi : stmt -> Stmt_piqi.stmt = function - | Move (v, e) -> - let v = var_to_piqi v in - let e = exp_to_piqi e in - `move {P.Move.lvar=v; rexp=e} - | Jmp targ -> - let targ = exp_to_piqi targ in - `jmp {P.Jmp.target=targ} - | Special s -> `special s - | While (e, stmts) -> - let e = exp_to_piqi e in - let stmts = stmts_to_piqi stmts in - `while_stmt {P.While_stmt.cond=e; loop_body=stmts} - | If (e, then_branch, else_branch) -> - let e = exp_to_piqi e in - let then_branch = stmts_to_piqi then_branch in - let else_branch = stmts_to_piqi else_branch in - `if_stmt {P.If_stmt.cond=e; true_branch=then_branch; false_branch=else_branch} - | CpuExn n -> `cpuexn {P.Cpuexn.errnum=n} - -and stmts_to_piqi l = List.map ~f:stmt_to_piqi l - -let rec stmt_of_piqi = function - | `move {P.Move.lvar; rexp} -> - let v = var_of_piqi lvar in - let e = exp_of_piqi rexp in - Move (v, e) - | `jmp {P.Jmp.target} -> - let t = exp_of_piqi target in - Jmp t - | `special s -> Special s - | `while_stmt {P.While_stmt.cond; loop_body} -> - let e = exp_of_piqi cond in - let b = stmts_of_piqi loop_body in - While (e, b) - | `if_stmt {P.If_stmt.cond; true_branch; false_branch} -> - let e = exp_of_piqi cond in - let then_branch = stmts_of_piqi true_branch in - let else_branch = stmts_of_piqi false_branch in - If (e, then_branch, else_branch) - | `cpuexn {P.Cpuexn.errnum} -> CpuExn errnum - -and stmts_of_piqi l = List.map ~f:stmt_of_piqi l - -open Stmt_piqi_ext - -type fmt = [ `json | `pb | `piq | `pib | `xml ] [@@deriving sexp, enumerate] -type out_fmt = [fmt | `json_pretty | `xml_pretty] - -let loads f g fmt s = f (g s fmt) -let dumps g f fmt x = f (g x) (fmt : fmt :> out_fmt) - -let bil_of_string = loads stmts_of_piqi parse_stmt_list -let stmt_of_string = loads stmt_of_piqi parse_stmt -let exp_of_string = loads exp_of_piqi parse_expr -let string_of_bil = dumps stmts_to_piqi gen_stmt_list -let string_of_stmt = dumps stmt_to_piqi gen_stmt -let string_of_exp = dumps exp_to_piqi gen_expr -let piqi_of_exp = exp_to_piqi -let piqi_of_var = var_to_piqi diff --git a/lib/bap_piqi/bil_piqi.mli b/lib/bap_piqi/bil_piqi.mli deleted file mode 100644 index 05e52f2b6..000000000 --- a/lib/bap_piqi/bil_piqi.mli +++ /dev/null @@ -1,18 +0,0 @@ -open Bap.Std - -type fmt = [ `json | `pb | `piq | `pib | `xml ] -[@@deriving sexp, enumerate] - -val bil_of_string : fmt -> string -> bil -val string_of_bil : fmt -> bil -> string - -val stmt_of_string : fmt -> string -> stmt -val string_of_stmt : fmt -> stmt -> string - -val exp_of_string : fmt -> string -> exp -val string_of_exp : fmt -> exp -> string - -val exp_of_piqi : Stmt_piqi.expr -> exp -val var_of_piqi : Stmt_piqi.var -> var -val piqi_of_exp : exp -> Stmt_piqi.expr -val piqi_of_var : var -> Stmt_piqi.var diff --git a/lib/bap_piqi/bir_piqi.ml b/lib/bap_piqi/bir_piqi.ml deleted file mode 100644 index 65743811c..000000000 --- a/lib/bap_piqi/bir_piqi.ml +++ /dev/null @@ -1,160 +0,0 @@ -open Core_kernel[@@warning "-D"] -open Bap.Std - -open Option.Monad_infix - -module R = Ir_piqi - - -module Get = struct - let tid = Tid.from_string_exn - let exp = Bil_piqi.exp_of_piqi - let var = Bil_piqi.var_of_piqi - - let label = function - | `direct t -> Direct (tid t) - | `indirect e -> Indirect (exp e) - - let intent = function - | `in_ -> In - | `out -> Out - | `both -> Both - - let jump = function - | `goto dst -> Goto (label dst) - | `ret dst -> Ret (label dst) - | `exn {R.Exn.number; return=r} -> Int (number, tid r) - | `call {R.Call.target=t; return=r} -> - Call - (Call.create ?return:(r >>| label) ~target:(label t) ()) - - let arg {R.Arg.tid=t; lhs=v; rhs=e; intent=i} = - Arg.create ~tid:(tid t) ?intent:(i >>| intent) (var v) (exp e) - - let def {R.Def.tid=t; lhs; rhs} = - Def.create ~tid:(tid t) (var lhs) (exp rhs) - - let phi {R.Phi.tid=t; lhs; values} = - values |> - List.map ~f:(fun {R.Tid_exp_pair.tid=t;exp=e} -> tid t, exp e) |> - Phi.of_list ~tid:(tid t) (var lhs) - - let jmp {R.Jmp.tid=t; cond=c; jump=j} = - Jmp.create ~tid:(tid t) ~cond:(exp c) (jump j) - - let blk {R.Blk.tid=t; phis; defs; jmps} = - let b = Blk.Builder.create ~tid:(tid t) () in - List.iter phis ~f:(fun p -> Blk.Builder.add_phi b (phi p)); - List.iter defs ~f:(fun p -> Blk.Builder.add_def b (def p)); - List.iter jmps ~f:(fun p -> Blk.Builder.add_jmp b (jmp p)); - Blk.Builder.result b - - let sub {R.Sub.tid=t; args; blks; name} = - let b = Sub.Builder.create ~tid:(tid t) ~name () in - List.iter args ~f:(fun x -> Sub.Builder.add_arg b (arg x)); - List.iter blks ~f:(fun x -> Sub.Builder.add_blk b (blk x)); - Sub.Builder.result b - - let program {R.Program.tid=t; subs} = - let b = Program.Builder.create ~tid:(tid t) () in - List.iter subs ~f:(fun x -> Program.Builder.add_sub b (sub x)); - Program.Builder.result b -end - -module Put = struct - let tid = Tid.to_string - let exp = Bil_piqi.piqi_of_exp - let var = Bil_piqi.piqi_of_var - - let label = function - | Direct t -> `direct (tid t) - | Indirect e -> `indirect (exp e) - - let intent = function - | In -> `in_ - | Out -> `out - | Both -> `both - - let jump = function - | Goto d -> `goto (label d) - | Ret d -> `ret (label d) - | Int (n,r) -> `exn R.Exn.{number=n; return=(tid r)} - | Call c -> `call R.Call.{ - target = label (Call.target c); - return = Call.return c >>| label; - } - - let arg a = R.Arg.{ - tid = tid (Term.tid a); - lhs = var (Arg.lhs a); - rhs = exp (Arg.rhs a); - intent = Arg.intent a >>| intent; - } - - let def d = R.Def.{ - tid = tid (Term.tid d); - lhs = var (Def.lhs d); - rhs = exp (Def.rhs d); - } - - let pair (t,e) = R.Tid_exp_pair.{tid = tid t; exp = exp e} - - let phi t = R.Phi.{ - tid = tid (Term.tid t); - lhs = var (Phi.lhs t); - values = Phi.values t |> Seq.map ~f:pair |> Seq.to_list - } - - let jmp t = R.Jmp.{ - tid = tid (Term.tid t); - cond = exp (Jmp.cond t); - jump = jump (Jmp.kind t); - } - - let list t f term = - Term.enum t term |> Seq.map ~f |> Seq.to_list - - let blk t = R.Blk.{ - tid = tid (Term.tid t); - phis = list phi_t phi t; - defs = list def_t def t; - jmps = list jmp_t jmp t; - } - - let sub t = R.Sub.{ - tid = tid (Term.tid t); - name = Sub.name t; - args = list arg_t arg t; - blks = list blk_t blk t; - } - - let program t = R.Program.{ - tid = tid (Term.tid t); - subs = list sub_t sub t; - } -end - - -type fmt = [ `json | `pb | `piq | `pib | `xml ] -type out_fmt = [fmt | `json_pretty | `xml_pretty] - -let loads f g fmt s = f (g s fmt) -let dumps g f fmt x = f (g x) (fmt : fmt :> out_fmt) - -open Ir_piqi_ext - -let program_of_string = loads Get.program parse_program -let sub_of_string = loads Get.sub parse_sub -let blk_of_string = loads Get.blk parse_blk -let arg_of_string = loads Get.arg parse_arg -let phi_of_string = loads Get.phi parse_phi -let def_of_string = loads Get.def parse_def -let tid_of_string = loads Get.tid parse_tid - -let string_of_program = dumps Put.program gen_program -let string_of_sub = dumps Put.sub gen_sub -let string_of_blk = dumps Put.blk gen_blk -let string_of_arg = dumps Put.arg gen_arg -let string_of_phi = dumps Put.phi gen_phi -let string_of_def = dumps Put.def gen_def -let string_of_tid = dumps Put.tid gen_tid diff --git a/lib/bap_piqi/bir_piqi.mli b/lib/bap_piqi/bir_piqi.mli deleted file mode 100644 index d16b41106..000000000 --- a/lib/bap_piqi/bir_piqi.mli +++ /dev/null @@ -1,18 +0,0 @@ -open Bap.Std - -type fmt = [ `json | `pb | `piq | `pib | `xml ] - - -val program_of_string : fmt -> string -> program term -val sub_of_string : fmt -> string -> sub term -val blk_of_string : fmt -> string -> blk term -val arg_of_string : fmt -> string -> arg term -val phi_of_string : fmt -> string -> phi term -val def_of_string : fmt -> string -> def term - -val string_of_program : fmt -> program term -> string -val string_of_sub : fmt -> sub term -> string -val string_of_blk : fmt -> blk term -> string -val string_of_arg : fmt -> arg term -> string -val string_of_phi : fmt -> phi term -> string -val string_of_def : fmt -> def term -> string diff --git a/lib/bap_piqi/dune b/lib/bap_piqi/dune deleted file mode 100644 index a2d231e8b..000000000 --- a/lib/bap_piqi/dune +++ /dev/null @@ -1,27 +0,0 @@ -(library - (name bap_piqi) - (public_name bap-piqi) - (wrapped false) - (preprocess (pps ppx_bap)) - (libraries bap piqirun.pb piqirun.ext) - (private_modules stmt_piqi stmt_piqi_ext ir_piqi ir_piqi_ext)) - -(rule - (targets type__piqi.ml type__piqi_ext.ml) - (deps type.piqi) - (action (run piqic-ocaml --multi-format %{deps}))) - -(rule - (targets stmt_piqi.ml stmt_piqi_ext.ml) - (deps stmt.piqi) - (action (run piqic-ocaml --multi-format %{deps}))) - -(rule - (targets exp_piqi.ml exp_piqi_ext.ml) - (deps exp.piqi) - (action (run piqic-ocaml --multi-format %{deps}))) - -(rule - (targets ir_piqi.ml ir_piqi_ext.ml) - (deps ir.piqi) - (action (run piqic-ocaml --multi-format %{deps}))) diff --git a/lib/bap_piqi/exp.piqi b/lib/bap_piqi/exp.piqi deleted file mode 100644 index eda947fab..000000000 --- a/lib/bap_piqi/exp.piqi +++ /dev/null @@ -1,193 +0,0 @@ -.include [ - .module type -] - -.enum [ - .name endian - .option [.name little-endian] - .option [.name big-endian] -] - -.variant [ - .name expr - .option [.type var ] - .option [.type inte ] - .option [.type load ] - .option [.type store ] - .option [.type binop ] - .option [.type unop ] - .option [.type cast ] - .option [.type let-exp] - .option [.type unknown] - .option [.type ite ] - .option [.type extract] - .option [.type concat ] -] - -.record [ - .name load - .field [ - .name memory - .type expr - ] - .field [ - .name address - .type expr - ] - .field [ - .name endian - .type endian - ] - .field [ - .name size - .type size - ] -] - -.record [ - .name store - .field [ - .name memory - .type expr - ] - .field [ - .name address - .type expr - ] - .field [ - .name value - .type expr - ] - .field [ - .name endian - .type endian - ] - .field [ - .name size - .type size - ] -] - -.record [ - .name binop - .field [ - .name op - .type binop-type - ] - .field [ - .name lexp - .type expr - ] - .field [ - .name rexp - .type expr - ] -] - -.record [ - .name unop - .field [ - .name op - .type unop-type - ] - .field [ - .name exp - .type expr - ] -] - -.record [ - .name inte - .field [ - .name int - .type bitvector - ] -] - -.record [ - .name cast - .field [ - .name cast-type - .type cast-type - ] - .field [ - .name size - .type int - ] - .field [ - .name exp - .type expr - ] -] - -.record [ - .name let-exp - .field [ - .name bound-var - .type var - ] - .field [ - .name definition - .type expr - ] - .field [ - .name open-exp - .type expr - ] -] - -.record [ - .name unknown - .field [ - .name descr - .type string - ] - .field [ - .name typ - .type typ - ] -] - -.record [ - .name ite - .field [ - .name condition - .type expr - ] - .field [ - .name iftrue - .type expr - ] - .field [ - .name iffalse - .type expr - ] -] - -.record [ - .name extract - .field [ - .name hbit - .type int - ] - .field [ - .name lbit - .type int - ] - .field [ - .name exp - .type expr - ] -] - -.record [ - .name concat - .field [ - .name lexp - .type expr - ] - .field [ - .name rexp - .type expr - ] -] diff --git a/lib/bap_piqi/ir.piqi b/lib/bap_piqi/ir.piqi deleted file mode 100644 index 9da78bac9..000000000 --- a/lib/bap_piqi/ir.piqi +++ /dev/null @@ -1,97 +0,0 @@ -.import [ - .module stmt -] - -.record [ - .name program - .field [.name tid .type tid] - .field [.name subs .type sub .repeated] -] - -.record [ - .name sub - .field [ .name tid .type tid] - .field [ .name name .type string ] - .field [ .name args .type arg .repeated ] - .field [ .name blks .type blk .repeated ] -] - -.record [ - .name arg - .field [.name tid .type tid] - .field [ .name lhs .type stmt/var ] - .field [ .name rhs .type stmt/expr ] - .field [ .name intent .type intent .optional] -] - -.record [ - .name blk - .field [.name tid .type tid] - .field [ .name phis .type phi .repeated] - .field [ .name defs .type def .repeated] - .field [ .name jmps .type jmp .repeated] -] - -.record [ - .name phi - .field [.name tid .type tid] - .field [.name lhs .type stmt/var] - .field [.name values .type tid-exp-pair .repeated] -] - -.record [ - .name def - .field [.name tid .type tid] - .field [.name lhs .type stmt/var] - .field [.name rhs .type stmt/expr] -] - - -.record [ - .name jmp - .field [.name tid .type tid] - .field [.name cond .type stmt/expr] - .field [.name jump .type jump] -] - -.alias [.name tid .type string] - -.record [ - .name tid-exp-pair - .field [.name tid .type tid] - .field [.name exp .type stmt/expr] -] - -.variant [ - .name jump - .option [.type call] - .option [.name goto .type label] - .option [.name ret .type label] - .option [.type exn] -] - -.variant [ - .name label - .option [.name direct .type tid] - .option [.name indirect .type stmt/expr] -] - -.enum [ - .name intent - .option [.name in] - .option [.name out] - .option [.name both] -] - - -.record [ - .name call - .field [.name target .type label] - .field [.name return .type label .optional] -] - -.record [ - .name exn - .field [.name number .type int] - .field [.name return .type tid] -] \ No newline at end of file diff --git a/lib/bap_piqi/stmt.piqi b/lib/bap_piqi/stmt.piqi deleted file mode 100644 index 7277085a7..000000000 --- a/lib/bap_piqi/stmt.piqi +++ /dev/null @@ -1,79 +0,0 @@ -.include [ - .module exp -] - -.variant [ - .name stmt - .option [.type move ] - .option [.type jmp ] - .option [.type special] - .option [.type while-stmt] - .option [.type if-stmt] - .option [.type cpuexn] -] - -.list [ - .name stmt-list - .type stmt -] - -.record [ - .name move - .field [ - .name lvar - .type var - ] - .field [ - .name rexp - .type expr - ] -] - -.record [ - .name jmp - .field [ - .name target - .type expr - ] -] - -.alias [ - .name special - .type string -] - -.record [ - .name while-stmt - .field [ - .name cond - .type expr - ] - .field [ - .name loop-body - .type stmt-list - ] -] - -.record [ - .name if-stmt - .field [ - .name cond - .type expr - ] - .field [ - .name true-branch - .type stmt-list - ] - .field [ - .name false-branch - .type stmt-list - ] -] - -.record [ - .name cpuexn - .field [ - .name errnum - .type int - ] -] diff --git a/lib/bap_piqi/test/run_piqi_tests.ml b/lib/bap_piqi/test/run_piqi_tests.ml deleted file mode 100644 index 696fe9a7e..000000000 --- a/lib/bap_piqi/test/run_piqi_tests.ml +++ /dev/null @@ -1,100 +0,0 @@ -open OUnit2 -open Core_kernel[@@warning "-D"] -open Bap.Std - -module Example = struct - let entry = Blk.create () - let b1 = Blk.create () - let b2 = Blk.create () - let b3 = Blk.create () - let b4 = Blk.create () - let b5 = Blk.create () - let b6 = Blk.create () - let exit = Blk.create () - - let i = Var.create "i" reg32_t - let j = Var.create "j" reg32_t - let k = Var.create "k" bool_t - - let _1 = Bil.int (Word.one 32) - let _2 = Bil.int (Word.of_int32 2l) - let _F = Bil.int Word.b0 - let _T = Bil.int Word.b1 - - let def var exp b = Term.append def_t b @@ Def.create var exp - let cond blk cond t f = - let jt = Jmp.create_goto ~cond (Label.direct (Term.tid t)) in - let jf = Jmp.create_goto (Label.direct (Term.tid f)) in - let blk = Term.append jmp_t blk jt in - Term.append jmp_t blk jf - let goto dst src = Term.append jmp_t src @@ - Jmp.create_goto (Label.direct (Term.tid dst)) - - let entry = entry |> - goto b1 - - let b1 = b1 |> - def k _F |> - def i _1 |> - def j _2 |> - goto b2 - - let b2 = cond b2 Bil.(var i <= var j) b3 b4 - - let b3 = b3 |> - def j Bil.(var j * _2) |> - def k _T |> - def i Bil.(var i + _1) |> - goto b2 - - let b3_without_jumps = Term.filter jmp_t ~f:(fun _ -> false) b3 - - let b4 = cond b4 Bil.(var k) b5 b6 - - let b5 = - let call = Call.create () - ~return:(Label.direct (Term.tid exit)) - ~target:(Label.indirect (Bil.var j)) in - let use = Jmp.create_call call in - Term.append jmp_t b5 use - - let b3_with_jump_to_b5 = Term.map jmp_t ~f:(fun _ -> - Jmp.create_goto (Label.direct (Term.tid b5))) b3 - - - - let b6 = def i Bil.(var i + _1) b6 |> goto exit - - let sub_of_blk blks = - let sub = Sub.create ~name:"example" () in - List.fold blks ~init:sub ~f:(Term.append blk_t) - - let blks = [entry; b1; b2; b3; b4; b5; b6; exit] - let sub = sub_of_blk blks - let program = - Term.append sub_t (Program.create ()) sub -end - -let test fmt ctxt = - let prog = Example.program |> - Bir_piqi.string_of_program fmt |> - Bir_piqi.program_of_string fmt in - let cmp = Program.equal in - let printer = Program.to_string in - assert_equal ~ctxt ~cmp ~printer Example.program prog - - - -let suite = - let open Bil.Types in - "bir" >::: - [ - "json" >:: test `json; - "pb" >:: test `pb; - "piq" >:: test `piq; - "pib" >:: test `pib; - "xml" >:: test `xml; - ] - - -let () = run_test_tt_main suite diff --git a/lib/bap_piqi/type.piqi b/lib/bap_piqi/type.piqi deleted file mode 100644 index 1296e8517..000000000 --- a/lib/bap_piqi/type.piqi +++ /dev/null @@ -1,110 +0,0 @@ -.variant [ - .name typ - .option [.type imm] - .option [.type mem] - .option [.name unk] -] - -.variant [ - .name addr-size - .option [.name r32] - .option [.name r64] -] - -.variant [ - .name size - .option [.name r8] - .option [.name r16] - .option [.name r32] - .option [.name r64] - .option [.name r128] - .option [.name r256] -] - -.alias [ - .name imm - .type int -] - -.record [ - .name mem - .field [ - .name index-type - .type addr-size - ] - .field [ - .name element-type - .type size - ] -] - -.enum [ - .name cast-type - .option [.name cast-unsigned] - .option [.name cast-signed] - .option [.name cast-high] - .option [.name cast-low] -] - -.enum [ - .name binop-type - .option [.name plus ] - .option [.name minus ] - .option [.name times ] - .option [.name divide ] - .option [.name sdivide] - .option [.name modbop ] - .option [.name smod ] - .option [.name lshift ] - .option [.name rshift ] - .option [.name arshift] - .option [.name andbop ] - .option [.name orbop ] - .option [.name x-or ] - .option [.name eq ] - .option [.name neq ] - .option [.name lt ] - .option [.name le ] - .option [.name slt ] - .option [.name sle ] -] - -.enum [ - .name unop-type - .option [.name uneg] - .option [.name unot] -] - -.record [ - .name var - .field [ - .name name - .type string - ] - .field [ - .name id - .type int - ] - .field [ - .name typ - .type typ - ] - - .field [ - .name tmp - .type bool - ] - -] - -% bitvectors -.alias [ - .name bitvector - .type string -] - -% an address is now a bitvector -.alias [ - .name address - .type bitvector -] diff --git a/lib/bap_plugins/bap_common.ml b/lib/bap_plugins/bap_common.ml index 0a513eeb1..f4f390f49 100644 --- a/lib/bap_plugins/bap_common.ml +++ b/lib/bap_plugins/bap_common.ml @@ -1,8 +1,8 @@ open Base open Stdio -open Caml.Scanf -module Sys = Caml.Sys +open Stdlib.Scanf +module Sys = Stdlib.Sys module Package = Bap_plugins_package module Config = Bap_plugins_config module Units = Bap_plugins_units.Make() diff --git a/lib/bap_plugins/bap_plugins.ml b/lib/bap_plugins/bap_plugins.ml index dc20b7efa..7fc429736 100644 --- a/lib/bap_plugins/bap_plugins.ml +++ b/lib/bap_plugins/bap_plugins.ml @@ -5,8 +5,8 @@ open Or_error.Monad_infix module Units = Bap_plugins_units.Make() module Package = Bap_plugins_package -module Filename = Caml.Filename -module Sys = Caml.Sys +module Filename = Stdlib.Filename +module Sys = Stdlib.Sys module Plugin = struct @@ -92,7 +92,7 @@ module Plugin = struct let is_debugging () = - try String.(Sys.getenv "BAP_DEBUG" <> "0") with Caml.Not_found -> false + try String.(Sys.getenv "BAP_DEBUG" <> "0") with Stdlib.Not_found -> false let bundle = function {body=Bundle {bundle}} -> bundle | _ -> assert false @@ -254,7 +254,7 @@ end module Plugins = struct let paths_of_env () = try Sys.getenv "BAP_PLUGIN_PATH" |> String.split ~on:':' - with Caml.Not_found -> [] + with Stdlib.Not_found -> [] let path = Bap_plugins_config.plugindir @@ -338,7 +338,7 @@ module Plugins = struct implementation. The implementation is digested as the md5 sum of files comprising the plugin folder. *) let deduplicate names = - let init = Map.empty (module String) in + let init = (Map.empty (module String)) in List.fold names ~init ~f:(fun plugins name -> Map.update plugins name ~f:(function | None -> digests name diff --git a/lib/bap_plugins/bap_plugins_units.ml b/lib/bap_plugins/bap_plugins_units.ml index 21aac8dd0..f78a1f6f5 100644 --- a/lib/bap_plugins/bap_plugins_units.ml +++ b/lib/bap_plugins/bap_plugins_units.ml @@ -4,7 +4,7 @@ open Bap_plugins_units_intf module Findlib = struct let name = "findlib" - let units : reason String.Table.t = String.Table.create () + let units : reason String.Table.t = Hashtbl.create (module String) let has_meta_information pkg = try ignore (Findlib.package_meta_file pkg : string); true @@ -67,7 +67,7 @@ end module Dynlink = struct let name = "dynlink" - let units : reason String.Table.t = String.Table.create () + let units : reason String.Table.t = Hashtbl.create (module String) (* see https://github.com/ocaml/ocaml/issues/9338 this ugly clutch could only be removed after we phase out @@ -99,7 +99,7 @@ module Dynlink = struct end -let is_toplevel = Caml.Sys.interactive.contents +let is_toplevel = Stdlib.Sys.interactive.contents module Make() = (val if is_toplevel diff --git a/lib/bap_primus/bap_primus.mli b/lib/bap_primus/bap_primus.mli index 3bdab0a97..5696dde69 100644 --- a/lib/bap_primus/bap_primus.mli +++ b/lib/bap_primus/bap_primus.mli @@ -189,7 +189,7 @@ module Std : sig Machine run. That type is left abstract, and has no operations, as its purpose is to disallow running machine directly with a properly initialized system. *) - type 'a effect + type 'a eff (** value generator *) type generator @@ -575,7 +575,7 @@ module Std : sig ?boot:unit t -> ?init:unit t -> ?fini:unit t -> - (exit_status * project) m effect + (exit_status * project) m eff (** Local state of the machine. *) module Local : State with type 'a m := 'a t diff --git a/lib/bap_primus/bap_primus_env.ml b/lib/bap_primus/bap_primus_env.ml index 3b1bfbae8..8e7d85781 100644 --- a/lib/bap_primus/bap_primus_env.ml +++ b/lib/bap_primus/bap_primus_env.ml @@ -57,15 +57,15 @@ let state = Bap_primus_machine.State.declare ~inspect:sexp_of_env ~uuid:"44b24ea4-48fa-47e8-927e-f7ba65202743" ~name:"environment" (fun _ -> { - values = Var.Map.empty; - random = Var.Map.empty; + values = (Map.empty (module Var)); + random = (Map.empty (module Var)); }) let inspect_environment {values;random} = let keys = Set.union - (Var.Set.of_list (Map.keys values)) - (Var.Set.of_list (Map.keys random)) in + (Set.of_list (module Var) (Map.keys values)) + (Set.of_list (module Var) (Map.keys random)) in let sexp_of_var sexp_of_value var value = Sexp.(List [ Atom (Var.name var); sexp_of_value value; diff --git a/lib/bap_primus/bap_primus_exn.ml b/lib/bap_primus/bap_primus_exn.ml index e9ba04dd9..66c74fd0d 100644 --- a/lib/bap_primus/bap_primus_exn.ml +++ b/lib/bap_primus/bap_primus_exn.ml @@ -1,5 +1,5 @@ open Core_kernel[@@warning "-D"] type t = exn = .. -let to_string err = Caml.Printexc.to_string err -let add_printer pr = Caml.Printexc.register_printer pr +let to_string err = Stdlib.Printexc.to_string err +let add_printer pr = Stdlib.Printexc.register_printer pr diff --git a/lib/bap_primus/bap_primus_generator.ml b/lib/bap_primus/bap_primus_generator.ml index 364c6014e..d2dd6b6a6 100644 --- a/lib/bap_primus/bap_primus_generator.ml +++ b/lib/bap_primus/bap_primus_generator.ml @@ -24,7 +24,7 @@ type iterators = { let iterators = Bap_primus_machine.State.declare ~name:"iterators" ~uuid:"9927004d-fe57-4de9-8705-c3d6862238cf" @@ fun _ -> { - iterators = Int.Map.empty; + iterators = (Map.empty (module Int)); salt = 1; } diff --git a/lib/bap_primus/bap_primus_interpreter.ml b/lib/bap_primus/bap_primus_interpreter.ml index 1ac76a3f9..1555b408c 100644 --- a/lib/bap_primus/bap_primus_interpreter.ml +++ b/lib/bap_primus/bap_primus_interpreter.ml @@ -285,7 +285,7 @@ let null proj = let empty_scope = { stack = []; - bound = Var.Map.empty; + bound = (Map.empty (module Var)); } let state = Primus.Machine.State.declare @@ -965,7 +965,7 @@ module LinkBinaryProgram(Machine : Machine) = struct Machine.get () >>= fun proj -> let prog = Project.program proj in info "Linking binary program%!"; - collector#run prog !!Tid.Set.empty >>= fun linked -> + collector#run prog !!(Set.empty (module Tid)) >>= fun linked -> (linker linked)#run prog !!() >>| fun () -> info "Finished linking binary program%!" end diff --git a/lib/bap_primus/bap_primus_linker.ml b/lib/bap_primus/bap_primus_linker.ml index 1052708b9..c24c1150d 100644 --- a/lib/bap_primus/bap_primus_linker.ml +++ b/lib/bap_primus/bap_primus_linker.ml @@ -36,11 +36,11 @@ type t = { } let empty = { - codes = Int.Map.empty; - terms = Tid.Map.empty; - names = String.Map.empty; - addrs = Addr.Map.empty; - alias = Int.Map.empty; + codes = (Map.empty (module Int)); + terms = (Map.empty (module Tid)); + names = (Map.empty (module String)); + addrs = (Map.empty (module Addr)); + alias = (Map.empty (module Int)); } diff --git a/lib/bap_primus/bap_primus_lisp.ml b/lib/bap_primus/bap_primus_lisp.ml index 3ff7918ba..d165e0f90 100644 --- a/lib/bap_primus/bap_primus_lisp.ml +++ b/lib/bap_primus/bap_primus_lisp.ml @@ -62,14 +62,14 @@ let state = Bap_primus_state.declare ~inspect (fun proj -> { env = { stack = []; - vars = Var.Map.empty; + vars = (Map.empty (module Var)); }; cur = Id.null; program = Lisp.Program.empty; typeenv = Lisp.Program.Type.empty; - advices = Map.empty (module KB.Name); - places = Map.empty (module KB.Name); - signals = Map.empty (module KB.Name); + advices = (Map.empty (module KB.Name)); + places = (Map.empty (module KB.Name)); + signals = (Map.empty (module KB.Name)); width = width_of_ctxt proj; }) @@ -81,7 +81,7 @@ let lisp_primitive,primitive_called = Bap_primus_observation.provide let show = KB.Name.show let make_advisors cmethod name = - let empty = Set.empty (module KB.Name) in + let empty = (Set.empty (module KB.Name)) in let names = Set.add empty name in match cmethod with | Advice.Before -> {before = names; after = empty} @@ -599,7 +599,7 @@ module Make(Machine : Machine) = struct let collect_program_vars prog = (object inherit [Var.Set.t] Term.visitor method! enter_var v vs = Set.add vs v - end)#run prog Var.Set.empty |> Set.to_sequence + end)#run prog (Set.empty (module Var)) |> Set.to_sequence let add_places = diff --git a/lib/bap_primus/bap_primus_lisp_attribute.ml b/lib/bap_primus/bap_primus_lisp_attribute.ml index 9d744239f..4c23c8cbe 100644 --- a/lib/bap_primus/bap_primus_lisp_attribute.ml +++ b/lib/bap_primus/bap_primus_lisp_attribute.ml @@ -100,9 +100,9 @@ module Set = struct end -let () = Caml.Printexc.register_printer (function +let () = Stdlib.Printexc.register_printer (function | Failure (error,_) -> let msg = Format.asprintf "Attribute parse error: %s" - (Caml.Printexc.to_string error) in + (Stdlib.Printexc.to_string error) in Some msg | _ -> None) diff --git a/lib/bap_primus/bap_primus_lisp_attributes.ml b/lib/bap_primus/bap_primus_lisp_attributes.ml index 5ddd88019..e20348232 100644 --- a/lib/bap_primus/bap_primus_lisp_attributes.ml +++ b/lib/bap_primus/bap_primus_lisp_attributes.ml @@ -28,7 +28,7 @@ module Variables = struct | Error err -> fail (Var_error err) [t] let parse ~package xs = List.map xs ~f:(var package) |> - Var.Set.of_list + Set.of_list (module Var) let global = Attribute.declare "global" ~package @@ -63,7 +63,7 @@ module External = struct let domain = KB.Domain.powerset (module String) "names" let parse ~package:_ xs = List.map xs ~f:parse_name |> - String.Set.of_list + Set.of_list (module String) let t = Attribute.declare "external" ~package @@ -137,13 +137,13 @@ module Advice = struct let domain = KB.Domain.define "methods" ~join ~order ~empty - let methods = String.Map.of_alist_exn [ + let methods = Map.of_alist_exn (module String) [ ":before", Before; ":after", After; ] let targets {methods} m = match Map.find methods m with - | None -> Set.empty (module KB.Name) + | None -> (Set.empty (module KB.Name)) | Some targets -> targets diff --git a/lib/bap_primus/bap_primus_lisp_context.ml b/lib/bap_primus/bap_primus_lisp_context.ml index 94cd0c5dd..24516022d 100644 --- a/lib/bap_primus/bap_primus_lisp_context.ml +++ b/lib/bap_primus/bap_primus_lisp_context.ml @@ -10,7 +10,7 @@ module Feature = String module Name = String type t = Feature.Set.t Name.Map.t [@@deriving bin_io, compare, equal, sexp] -let empty = Name.Map.empty +let empty = (Map.empty (module Name)) type Attribute.error += Unterminated_quote @@ -29,7 +29,7 @@ let endian proj = Project.arch proj |> Arch.endian |> function | LittleEndian -> "little" | BigEndian -> "big" -let features = Feature.Set.of_list +let features = Set.of_list (module Feature) let enum (type t) (module E : KB.Enum.S with type t = t) v = KB.Name.unqualified (E.name v) @@ -41,7 +41,7 @@ let of_project proj = List.concat_map ~f:(fun t -> KB.Name.unqualified (Theory.Target.name t) :: Set.to_list (Theory.Target.nicknames t)) in - Name.Map.of_alist_exn [ + Map.of_alist_exn (module Name) [ "arch", features @@ [ Arch.to_string (Project.arch proj); ] @ attr proj Bap_abi.name; @@ -72,7 +72,7 @@ let of_project proj = let create descs = List.map descs ~f:(fun (name,xs) -> name,features xs) |> - Name.Map.of_alist_reduce ~f:Set.union + Map.of_alist_reduce (module Name) ~f:Set.union let sexp_of_context (name,values) = Sexp.List (List.map (name :: Set.to_list values) @@ -100,7 +100,7 @@ let parse_name = function let context_of_tree = function | {data=List (x :: xs)} -> - parse_name x, Feature.Set.of_list (List.map xs ~f:parse_name) + parse_name x, Set.of_list (module Feature) (List.map xs ~f:parse_name) | s -> expect_list s @@ -111,7 +111,7 @@ let push cs name vs = let parse ~package:_ : tree list -> t = - List.fold ~init:Name.Map.empty ~f:(fun cs tree -> + List.fold ~init:(Map.empty (module Name)) ~f:(fun cs tree -> let (name,vs) = context_of_tree tree in push cs name vs) @@ -149,7 +149,7 @@ let pp ppf ctxt = let (<=) xs ys = Map.fold_symmetric_diff xs ys - ~data_equal:String.Set.equal + ~data_equal:Set.equal ~init:true ~f:(fun matches (_,diff) -> matches && match diff with | `Left xs -> Set.is_empty xs @@ -166,7 +166,7 @@ let order c1 c2 : KB.Order.partial = let merge xs ys : t = Map.merge xs ys ~f:(fun ~key:_ -> function | `Left v | `Right v -> Some v - | `Both (x,y) -> Some (Feature.Set.union x y) ) + | `Both (x,y) -> Some (Set.union x y) ) let join xs ys = Ok (merge xs ys) diff --git a/lib/bap_primus/bap_primus_lisp_def.ml b/lib/bap_primus/bap_primus_lisp_def.ml index 1f086cd7d..41f5e8281 100644 --- a/lib/bap_primus/bap_primus_lisp_def.ml +++ b/lib/bap_primus/bap_primus_lisp_def.ml @@ -121,7 +121,7 @@ module Sema = struct meta = { name = KB.Name.show name; docs; - attrs=Attribute.Set.empty}; + attrs=(Attribute.Set.empty)}; code = {apply; types}; }; id = Source.Id.null; @@ -140,7 +140,7 @@ module Signal = struct meta = { name; docs; - attrs=Attribute.Set.empty}; + attrs=(Attribute.Set.empty)}; code = types; }; id = Source.Id.null; @@ -245,7 +245,7 @@ module Primitive = struct meta = { name = KB.Name.show@@KB.Name.read ?package name; docs; - attrs = Attribute.Set.empty + attrs = (Attribute.Set.empty) }; code; }; @@ -263,7 +263,7 @@ module Place = struct meta = { name = KB.Name.show@@KB.Name.read ?package name; docs = ""; - attrs = Attribute.Set.empty; + attrs = (Attribute.Set.empty); }; code = Theory.Var.forget var; }; @@ -292,7 +292,7 @@ module Closure = struct meta = { name = KB.Name.show@@KB.Name.read ~package name; docs; - attrs=Attribute.Set.empty}; + attrs=(Attribute.Set.empty)}; code = { types; lambda; diff --git a/lib/bap_primus/bap_primus_lisp_parse.ml b/lib/bap_primus/bap_primus_lisp_parse.ml index b2084b50c..d433d46c7 100644 --- a/lib/bap_primus/bap_primus_lisp_parse.ml +++ b/lib/bap_primus/bap_primus_lisp_parse.ml @@ -3,7 +3,7 @@ open Bap.Std open Format open Bap_core_theory -module Sys = Caml.Sys +module Sys = Stdlib.Sys open Bap_primus_lisp_types @@ -368,7 +368,7 @@ module Parse = struct Program.update_package_documentation prog name (unquote docs) | s -> fail (Bad_def Defpkg) s) - let toplevels = String.Set.of_list [ + let toplevels = Set.of_list (module String) [ "declare"; "defconstant"; "defparameter"; @@ -649,7 +649,7 @@ module Load = struct | _ -> None let required paths p = - Source.fold p ~init:String.Map.empty ~f:(fun _ trees required -> + Source.fold p ~init:(Map.empty (module String)) ~f:(fun _ trees required -> List.fold trees ~init:required ~f:(fun required tree -> match parse_require tree with | None -> required @@ -671,7 +671,7 @@ module Load = struct fixpoint p let features_of_list = - List.fold ~init:String.Map.empty ~f:(fun fs f -> + List.fold ~init:(Map.empty (module String)) ~f:(fun fs f -> Map.set fs ~key:f ~data:Cmdline) let features ?(paths=[Filename.current_dir_name]) proj fs = diff --git a/lib/bap_primus/bap_primus_lisp_program.ml b/lib/bap_primus/bap_primus_lisp_program.ml index 71f0b1731..6d9a90b2a 100644 --- a/lib/bap_primus/bap_primus_lisp_program.ml +++ b/lib/bap_primus/bap_primus_lisp_program.ml @@ -47,7 +47,7 @@ type program = t let default_package = "user" -let nodefs = Map.empty (module String) +let nodefs = (Map.empty (module String)) let empty_package = { semas = nodefs; codes = nodefs; @@ -65,9 +65,9 @@ let empty = { context = Lisp.Context.empty; sources = Source.empty; package = default_package; - exports = Map.empty (module String); - library = Map.empty (module String); - pkgdocs = Map.empty (module String); + exports = (Map.empty (module String)); + library = (Map.empty (module String)); + pkgdocs = (Map.empty (module String)); } let with_package program package = {program with package} @@ -111,7 +111,7 @@ let get_package ?(public=false) program package = if public then filter_package pkg {visit = is_public} else pkg let targets {exports} package = match Map.find exports package with - | None -> Set.empty (module String) + | None -> (Set.empty (module String)) | Some packs -> packs (* [transitive_closure p] is the set of packages in which @@ -144,7 +144,7 @@ let (++) : 'a defs -> 'a defs -> 'a defs = fun xs ys -> List.fold defs ~init ~f:(fun (set,defs) def -> if is_presented set def then set,defs else remember set def, Map.add_multi defs name def) in - let init = Map.empty (module String),nodefs in + let init = (Map.empty (module String)),nodefs in snd@@Map.fold ys ~f:add ~init:(Map.fold ~init xs ~f:add) let pp_defs ppf = @@ -396,7 +396,7 @@ module Callgraph = struct end) end)(Unit) - let empty = Set.empty (module KB.Name) + let empty = (Set.empty (module KB.Name)) let (++) = Set.union let call = Set.singleton (module KB.Name) let union xs ~f = @@ -413,7 +413,7 @@ module Callgraph = struct (** computes a mapping from name to id of definitions *) let compute_ids (defs : library) = - let init = Map.empty (module KB.Name) in + let init = (Map.empty (module KB.Name)) in fold_library defs ~init ~f:(fun ~package {defs} ids -> fold_multi ~init:ids defs ~f:(fun ids def -> let name = KB.Name.create ~package (Def.name def) in @@ -581,7 +581,7 @@ let pp ppf prog = let pp_ast ppf ast = Ast.pp ppf ast module Use = struct - let empty = Map.empty (module KB.Name) + let empty = (Map.empty (module KB.Name)) let union = union empty let use = Map.singleton (module KB.Name) @@ -613,7 +613,7 @@ module Use = struct | {data=Set (_,x)} -> calls x let collect {defs} = - let init = {calls = Id.Map.empty; vars = Id.Map.empty} in + let init = {calls = (Map.empty (module Id)); vars = (Map.empty (module Id))} in fold_multi ~init defs ~f:(fun s def -> let body = Def.Func.body def in let bound = Def.Func.args def |> @@ -652,26 +652,26 @@ end = struct type 'a m = 'a Monad.State.T1(Source)(Monad.Ident).t let rec ids_of_trees trees = - List.fold trees ~init:Id.Set.empty ~f:(fun xs t -> match t with + List.fold trees ~init:(Set.empty (module Id)) ~f:(fun xs t -> match t with | {data=Atom _; id} -> Set.add xs id | {data=List ts;id} -> Set.union (Set.add xs id) (ids_of_trees ts)) let ids_of_defs defs map reduce = - Id.Set.union_list [ - Id.Set.of_list @@ List.map (items defs) ~f:(fun d -> d.id); + Set.union_list (module Id) [ + Set.of_list (module Id) @@ List.map (items defs) ~f:(fun d -> d.id); map (items defs) ~f:reduce |> ids_of_trees ] let macro_ids prog = fold_library prog ~f:(fun ~package:_ p macros -> - Id.Set.union_list [ + Set.union_list (module Id) [ macros; ids_of_defs p.macros List.map Def.Macro.body; ids_of_defs p.consts List.map Def.Const.value; ids_of_defs p.substs List.concat_map Def.Subst.body; ]) - ~init:Id.Set.empty + ~init:(Set.empty (module Id)) let derive from = State.get () >>= fun src -> @@ -871,9 +871,12 @@ module Typing = struct | Tvar of Id.t [@@deriving compare, sexp_of] - module Tvar = Comparable.Make_plain(struct - type t = tvar [@@deriving compare, sexp_of] - end) + module Tvar = struct + type t = tvar [@@deriving compare, sexp_of] + include Comparable.Make_plain(struct + type nonrec t = t [@@deriving compare, sexp_of] + end) + end (** Typing environment. @@ -990,8 +993,8 @@ module Typing = struct } let empty = { - vars = Id.Map.empty; - vals = Tvar.Map.empty; + vars = (Map.empty (module Id)); + vals = (Map.empty (module Tvar)); } let get g x = match Map.find g.vars x with @@ -1123,7 +1126,7 @@ module Typing = struct | Type n -> constr_grnd id (Grnd n) g let join_vars vars = - let init = Tvar.Map.empty in + let init = (Map.empty (module Tvar)) in Map.fold vars ~init ~f:(fun ~key:x ~data:u joined -> Map.add_multi joined u x) @@ -1131,7 +1134,7 @@ module Typing = struct join_vars vars |> Map.fold ~init:[] ~f:(fun ~key ~data xs -> { var = key; - elements=Id.Set.of_list data; + elements=Set.of_list (module Id) data; values = Map.find vals key; } :: xs) @@ -1390,14 +1393,14 @@ module Typing = struct | None -> gamma | Some f -> let args = Def.Func.args f in - let init = Map.empty (module KB.Name) in + let init = (Map.empty (module KB.Name)) in let vars = List.fold args ~init ~f:push in let gamma = List.fold args ~init:gamma ~f:(fun gamma v -> Gamma.constr v.id v.data.typ gamma) in let gamma = infer_ast glob vars (Def.Func.body f) gamma in gamma - let empty_names = Map.empty (module KB.Name) + let empty_names = (Map.empty (module KB.Name)) let collect_prims program item signature init = @@ -1467,7 +1470,7 @@ module Typing = struct let problem = Unresolved_signal (met.id,name,Some pars) in Gamma.fail met.id problem g | Some g -> - let init = Map.empty (module KB.Name) in + let init = (Map.empty (module KB.Name)) in let vars = List.fold args ~init ~f:push in let g = List.fold args ~init:g ~f:(fun g v -> Gamma.constr v.id v.data.typ g) in @@ -1505,7 +1508,7 @@ module Typing = struct paras = make_paras p; } in let g = Callgraph.build library in - let init = Solution.create Callgraph.Node.Map.empty Gamma.empty in + let init = Solution.create (Map.empty (module Callgraph.Node)) Gamma.empty in let equal = gamma_equal in let fp = Graphlib.fixpoint (module Callgraph) ~rev:true ~start:Exit diff --git a/lib/bap_primus/bap_primus_lisp_resolve.ml b/lib/bap_primus/bap_primus_lisp_resolve.ml index a5b264574..77543a8fc 100644 --- a/lib/bap_primus/bap_primus_lisp_resolve.ml +++ b/lib/bap_primus/bap_primus_lisp_resolve.ml @@ -137,7 +137,7 @@ let overload_primitive s3 = List.map s3 ~f:(fun s -> s,()) let locs prog defs = let src = Program.sources prog in List.map defs ~f:(fun def -> - Source.loc src def.id) |> Loc.Set.of_list + Source.loc src def.id) |> Set.of_list (module Loc) type _ arity = | One : ('a list -> 'a option) arity diff --git a/lib/bap_primus/bap_primus_lisp_semantics.ml b/lib/bap_primus/bap_primus_lisp_semantics.ml index cd67467e9..36f359df7 100644 --- a/lib/bap_primus/bap_primus_lisp_semantics.ml +++ b/lib/bap_primus/bap_primus_lisp_semantics.ml @@ -26,9 +26,9 @@ module State = struct } let empty = { - binds = Map.empty (module Theory.Var.Top); + binds = (Map.empty (module Theory.Var.Top)); arith = (module Bitvec.M32); - scope = Map.empty (module Theory.Var.Top); + scope = (Map.empty (module Theory.Var.Top)); } let var = KB.Context.declare ~package:"bap" "lisp-interpter-state" @@ -42,7 +42,7 @@ end type value = unit Theory.Value.t -type effect = unit Theory.Effect.t +type effect0 = unit Theory.Effect.t type KB.Conflict.t += | Unresolved_definition of string @@ -284,7 +284,7 @@ module Value = struct end module Effect = struct - type t = effect + type t = effect0 let pure x : t = empty.$[Theory.Semantics.value] <- x let return x : t KB.t = KB.return@@pure x end @@ -400,7 +400,7 @@ module Scope = struct let clear = let* s = State.get in let+ () = State.set { - s with scope = Map.empty (module Theory.Var.Top) + s with scope = (Map.empty (module Theory.Var.Top)) } in s.scope @@ -741,7 +741,7 @@ let collect_names kind key prog = let merge_names names = List.reduce names ~f:(Map.merge_skewed ~combine:(fun ~key:_ _ v -> v)) |> - function None -> Map.empty (module KB.Name) + function None -> (Map.empty (module KB.Name)) | Some r -> r @@ -811,8 +811,8 @@ let provide_semantics ?(stdout=Format.std_formatter) () = let* target = KB.collect Theory.Unit.target unit in let bits = Theory.Target.bits target in KB.Context.set State.var State.{ - binds = Map.empty (module Theory.Var.Top); - scope = Map.empty (module Theory.Var.Top); + binds = (Map.empty (module Theory.Var.Top)); + scope = (Map.empty (module Theory.Var.Top)); arith = (module (Bitvec.Make(struct let modulus = Bitvec.modulus bits end))); diff --git a/lib/bap_primus/bap_primus_lisp_source.ml b/lib/bap_primus/bap_primus_lisp_source.ml index 9348466fc..860546e66 100644 --- a/lib/bap_primus/bap_primus_lisp_source.ml +++ b/lib/bap_primus/bap_primus_lisp_source.ml @@ -35,18 +35,18 @@ type t = { let empty = { lastid = Id.null; lasteq = Eq.null; - hashed = Sexp.Map.empty; - equivs = Id.Map.empty; - origin = Id.Map.empty; - ranges = Id.Map.empty; - source = String.Map.empty; - inputs = String.Map.empty; - rclass = Id.Map.empty; + hashed = (Map.empty (module Sexp)); + equivs = (Map.empty (module Id)); + origin = (Map.empty (module Id)); + ranges = (Map.empty (module Id)); + source = (Map.empty (module String)); + inputs = (Map.empty (module String)); + rclass = (Map.empty (module Id)); } let is_empty {lastid} = Id.equal Id.null lastid -let equal_inputs = String.Map.equal String.equal +let equal_inputs = Map.equal String.equal let equal x y = phys_equal x y || equal_inputs x.inputs y.inputs diff --git a/lib/bap_primus/bap_primus_machine.ml b/lib/bap_primus/bap_primus_machine.ml index b56075581..d34493731 100644 --- a/lib/bap_primus/bap_primus_machine.ml +++ b/lib/bap_primus/bap_primus_machine.ml @@ -84,7 +84,7 @@ module Make(M : Monad.S) = struct ?boot:unit t -> ?init:unit t -> ?fini:unit t -> - (exit_status * project) m effect + (exit_status * project) m eff type _ error = exn @@ -429,9 +429,9 @@ module Make(M : Monad.S) = struct args; envp; self = global; - conts = Map.empty (module Id); - local = Map.empty (module Id); - parent = Map.empty (module Id); + conts = (Map.empty (module Id)); + local = (Map.empty (module Id)); + parent = (Map.empty (module Id)); global = State.Bag.empty; observations = Bap_primus_observation.empty; deathrow = []; diff --git a/lib/bap_primus/bap_primus_memory.ml b/lib/bap_primus/bap_primus_memory.ml index ca8de860f..3dd0bda2a 100644 --- a/lib/bap_primus/bap_primus_memory.ml +++ b/lib/bap_primus/bap_primus_memory.ml @@ -135,7 +135,7 @@ let state = Bap_primus_machine.State.declare ~uuid:"4b94186d-3ae9-48e0-8a93-8c83c747bdbb" ~inspect:inspect_memory ~name:"memory" @@ fun p -> { - mems = Descriptor.Map.empty; + mems = (Map.empty (module Descriptor)); curr = virtual_memory (Project.target p); } @@ -153,7 +153,7 @@ let is_mapped addr {layers; values} = Option.is_some @@ find_layer addr layers let empty_state = { - values = Addr.Map.empty; + values = (Map.empty (module Addr)); layers = []; } diff --git a/lib/bap_primus/bap_primus_state.ml b/lib/bap_primus/bap_primus_state.ml index 1e235f67b..03b778606 100644 --- a/lib/bap_primus/bap_primus_state.ml +++ b/lib/bap_primus/bap_primus_state.ml @@ -37,7 +37,7 @@ module Bag = struct let empty = { dict = Dict.empty; - uids = String.Map.empty; + uids = (Map.empty (module String)); } let check_invariant t state = diff --git a/lib/bap_primus/bap_primus_types.ml b/lib/bap_primus/bap_primus_types.ml index 0b566ce47..b3bec2bfd 100644 --- a/lib/bap_primus/bap_primus_types.ml +++ b/lib/bap_primus/bap_primus_types.ml @@ -18,7 +18,7 @@ type exit_status = | Normal | Exn of exn -type 'a effect = +type 'a eff = ?envp:string array -> ?args:string array -> string -> @@ -67,7 +67,7 @@ module type Machine = sig ?boot:unit t -> ?init:unit t -> ?fini:unit t -> - (exit_status * project) m effect + (exit_status * project) m eff module Local : State with type 'a m := 'a t and type 'a t := 'a state diff --git a/lib/bap_primus_machine/bap_primus_machine.ml b/lib/bap_primus_machine/bap_primus_machine.ml index f4b300176..2833d5f0b 100644 --- a/lib/bap_primus_machine/bap_primus_machine.ml +++ b/lib/bap_primus_machine/bap_primus_machine.ml @@ -63,8 +63,8 @@ module Exception : sig end = struct type t = exn = .. - let to_string err = Caml.Printexc.to_string err - let add_printer pr = Caml.Printexc.register_printer pr + let to_string err = Stdlib.Printexc.to_string err + let add_printer pr = Stdlib.Printexc.register_printer pr end @@ -205,7 +205,7 @@ module Primus = struct open Observation let declare = Observation.declare - let empty = Set.empty (module Int) + let empty = (Set.empty (module Int)) let observations {observer} : _ observer list m = lifts @@ SM.gets @@ fun s -> @@ -429,7 +429,7 @@ module Primus = struct global = Univ_map.empty; local = Univ_map.empty; observations = Univ_map.empty; - inspectors = Map.empty (module String); + inspectors = (Map.empty (module String)); key = 0; deathrow = []; } diff --git a/lib/bap_primus_track_visited/bap_primus_track_visited.ml b/lib/bap_primus_track_visited/bap_primus_track_visited.ml index 9e2264aa1..d7ada0bcc 100644 --- a/lib/bap_primus_track_visited/bap_primus_track_visited.ml +++ b/lib/bap_primus_track_visited/bap_primus_track_visited.ml @@ -19,7 +19,7 @@ let init_visited prog = if Term.has_attr blk Term.visited then Set.add visited (Term.tid blk) else visited - end)#run prog Tid.Set.empty + end)#run prog (Set.empty (module Tid)) let state = Primus.Machine.State.declare ~name:"primus-track-visited" diff --git a/lib/bap_recipe/bap_recipe.ml b/lib/bap_recipe/bap_recipe.ml index f3c64cec2..e687c0570 100644 --- a/lib/bap_recipe/bap_recipe.ml +++ b/lib/bap_recipe/bap_recipe.ml @@ -1,7 +1,7 @@ open Base open Stdio open Result.Monad_infix -open Caml.Format +open Stdlib.Format module Filename = Stdlib.Filename module Buffer = Stdlib.Buffer @@ -158,7 +158,7 @@ let apply_subst root pars vars opts = try Ok (apply_subst_exn root pars vars opts) with Bad_substitution s -> Error (Bad_subst s) -let rng = Caml.Random.State.make_self_init () +let rng = Stdlib.Random.State.make_self_init () let mkdtemp ?(mode=0o0700) ?tmp_dir ?(prefix="") ?(suffix="") () = let genname () = Uuidm.v4_gen rng () |> Uuidm.to_string in diff --git a/lib/bap_relation/bap_relation.ml b/lib/bap_relation/bap_relation.ml index d83c15489..3b34f3d1e 100644 --- a/lib/bap_relation/bap_relation.ml +++ b/lib/bap_relation/bap_relation.ml @@ -23,8 +23,8 @@ let empty (type key) (type data) compare_key compare_data = end) end in Rel { - vals = Map.empty (module K); - keys = Map.empty (module D); + vals = (Map.empty (module K)); + keys = (Map.empty (module D)); } let add (Rel {vals; keys}) key value = Rel { diff --git a/lib/bap_sema/bap_sema_free_vars.ml b/lib/bap_sema/bap_sema_free_vars.ml index a391c49fe..fd55d2dfa 100644 --- a/lib/bap_sema/bap_sema_free_vars.ml +++ b/lib/bap_sema/bap_sema_free_vars.ml @@ -10,7 +10,7 @@ let (++) = Set.union and (--) = Set.diff let ssa_free_vars sub = let is_undefined v = Var.index v = 0 in - Term.enum blk_t sub |> Seq.fold ~init:Var.Set.empty ~f:(fun vars blk -> + Term.enum blk_t sub |> Seq.fold ~init:(Set.empty (module Var)) ~f:(fun vars blk -> vars ++ Set.filter (Ir_blk.free_vars blk) ~f:is_undefined) module Live = struct @@ -36,16 +36,16 @@ module Live = struct let blk_defs blk = Term.enum def_t blk |> - Seq.fold ~init:Var.Set.empty ~f:(fun defs def -> + Seq.fold ~init:(Set.empty (module Var)) ~f:(fun defs def -> Set.add defs (Ir_def.lhs def)) let update blk trans ~f = Map.update trans blk ~f:(function - | None -> f {defs=Var.Set.empty; uses=Var.Set.empty} + | None -> f {defs=(Set.empty (module Var)); uses=(Set.empty (module Var))} | Some had -> f had) let block_transitions sub = Term.enum blk_t sub |> - Seq.fold ~init:Tid.Map.empty ~f:(fun fs blk -> + Seq.fold ~init:(Map.empty (module Tid)) ~f:(fun fs blk -> Map.add_exn fs (Term.tid blk) { defs = blk_defs blk; uses = Ir_blk.free_vars blk; @@ -62,7 +62,7 @@ module Live = struct })))) let lookup blks n = match Map.find blks n with - | None -> {defs = Var.Set.empty; uses = Var.Set.empty} + | None -> {defs = (Set.empty (module Var)); uses = (Set.empty (module Var))} | Some t -> t let is_pseudo n = Tid.equal n G.exit || Tid.equal n G.start @@ -71,8 +71,8 @@ module Live = struct if is_pseudo n then vars else apply (lookup blks n) vars - let initialize ?(init=Var.Set.empty) sub = - Tid.Map.singleton G.exit @@ + let initialize ?(init=Set.empty (module Var)) sub = + Map.singleton (module Tid) G.exit @@ Seq.fold (Term.enum arg_t sub) ~init ~f:(fun vars arg -> match Ir_arg.intent arg with | None | Some In -> vars @@ -81,12 +81,12 @@ module Live = struct let compute ?keep:init sub = let g = G.create sub in - let init = Solution.create (initialize ?init sub) Var.Set.empty in + let init = Solution.create (initialize ?init sub) (Set.empty (module Var)) in let blks = block_transitions sub in { blks; outs = Graphlib.fixpoint (module G) ~init ~start:G.exit ~rev:true g ~merge:Set.union - ~equal:Var.Set.equal + ~equal:Set.equal ~f:(transfer blks) } @@ -103,7 +103,7 @@ module Live = struct f init blk (apply trans outs)) let blks live var = - fold live ~init:Tid.Set.empty ~f:(fun blks blk ins -> + fold live ~init:(Set.empty (module Tid)) ~f:(fun blks blk ins -> if Set.mem ins var then Set.add blks blk else blks) diff --git a/lib/bap_sema/bap_sema_lift.ml b/lib/bap_sema/bap_sema_lift.ml index bc5c85ed4..05ddc98a5 100644 --- a/lib/bap_sema/bap_sema_lift.ml +++ b/lib/bap_sema/bap_sema_lift.ml @@ -99,6 +99,19 @@ module IrBuilder = struct let ir_of_insn insn = KB.Value.get Term.slot insn + let mark_rip_relative blks = + let mark_def def = + let v = KB.Value.put rip_relative_addr (Ir_def.value def) true in + Ir_def.with_value def v in + List.map blks ~f:(fun blk -> + Term.map def_t blk ~f:(fun def -> + match Ir_def.rhs def with + | Load _ | Store _ -> mark_def def + | Int _ -> mark_def def (* RIP-relative lea: RAX := 0x404030 *) + | Cast (_, _, (Load _ | Store _)) -> mark_def def + (* RIP-relative movzx/movsx: RDX := pad:64[mem[0x401C, el]:u32] *) + | _ -> def)) + let set_attributes ?addr insn blks = let set_attributes k b = Term.map k b ~f:(fun t -> @@ -113,8 +126,17 @@ module IrBuilder = struct pre: the first block of [blks] is the exit block; post: the first block of [lift_insn insn blks] is the new exit block. *) let lift_insn ?addr insn blks = - append blks @@ - set_attributes ?addr insn (ir_of_insn insn) + let insn_blks = set_attributes ?addr insn (ir_of_insn insn) in + let mark_rip_relative_if_needed insn_blks = + match addr with + | None -> !!insn_blks + | Some addr -> + Theory.Label.for_addr (Word.to_bitvec addr) >>= fun label -> + KB.collect Theory.Label.is_rip_relative label >>= function + | Some true -> KB.return (mark_rip_relative insn_blks) + | _ -> KB.return insn_blks in + mark_rip_relative_if_needed insn_blks >>= fun insn_blks -> + append blks insn_blks let with_first_blk_addressed addr = function | [] -> [] @@ -448,7 +470,7 @@ let fix_names prog = Theory.Label.for_name name >>| Fn.non (Tid.equal tid) in let keep_name tids name tid = Map.set tids ~key:name ~data:tid in Term.enum sub_t prog |> - KB.Seq.fold ~init:String.Map.empty ~f:(fun tids sub -> + KB.Seq.fold ~init:(Map.empty (module String)) ~f:(fun tids sub -> let tid = Term.tid sub in let name = Ir_sub.name sub in match Map.find tids name with diff --git a/lib/bap_sema/bap_sema_ssa.ml b/lib/bap_sema/bap_sema_ssa.ml index e025f6cc0..3876b0309 100644 --- a/lib/bap_sema/bap_sema_ssa.ml +++ b/lib/bap_sema/bap_sema_ssa.ml @@ -48,13 +48,13 @@ let ssa_form = Value.Tag.register [k] is a fixpoint, i.e., such value that [IDF_k = IDF_{k-1}]. See section 8.11 of [1].*) let iterated_frontier f blks = - let df = Set.fold ~init:Tid.Set.empty ~f:(fun dfs b -> - Seq.fold (Frontier.enum f b) ~init:dfs ~f:Set.add) in - let blks = List.fold blks ~init:Tid.Set.empty ~f:Set.add in + let df = Set.fold ~init:(Set.empty (module Tid)) ~f:(fun dfs b -> + Seq.fold (Frontier.enum f b) ~init:dfs ~f:(fun s x -> Set.add s x)) in + let blks = List.fold blks ~init:(Set.empty (module Tid)) ~f:(fun s x -> Set.add s x) in let rec fixpoint idf = let idf' = df (Set.union idf blks) in if Set.equal idf idf' then idf' else fixpoint idf' in - fixpoint Tid.Set.empty + fixpoint (Set.empty (module Tid)) let blk_of_tid sub tid = match Term.find blk_t sub tid with | Some blk -> Some blk @@ -74,7 +74,7 @@ let succs cfg sub tid = variables, that are live across multiple blocks. *) let collect_vars sub = Term.enum blk_t sub |> - Seq.fold ~init:Var.Set.empty ~f:(fun vars blk -> + Seq.fold ~init:(Set.empty (module Var)) ~f:(fun vars blk -> Set.union vars @@ Ir_blk.free_vars blk) (** returns a list of blocks that contains [def] terms with lhs equal @@ -106,8 +106,8 @@ end)#map_exp of a variable. And works well with our API to resolve input/output parameters.*) let rename t = - let vars : var list Var.Table.t = Var.Table.create () in - let nums : int Var.Table.t = Var.Table.create () in + let vars : var list Var.Table.t = Hashtbl.create (module Var) in + let nums : int Var.Table.t = Hashtbl.create (module Var) in let top v = match Hashtbl.find vars v with | None | Some [] -> v | Some (v :: _) -> v in diff --git a/lib/bap_sema/bap_sema_taint.ml b/lib/bap_sema/bap_sema_taint.ml index b393975e7..b5a6c9319 100644 --- a/lib/bap_sema/bap_sema_taint.ml +++ b/lib/bap_sema/bap_sema_taint.ml @@ -78,14 +78,14 @@ let collect_taints = Set.union ts ts') class context = object(self) - val tvs : set values = Values.empty - val tas : set Addr.Map.t = Addr.Map.empty + val tvs : set values = Base.(Map.empty (module Bil.Result.Id)) + val tas : set Addr.Map.t = (Map.empty (module Addr)) method taint_reg r ts = let key = Bil.Result.id r in if Set.is_empty ts - then {< tvs = Values.remove tvs key >} - else {< tvs = Values.set tvs ~key ~data:ts >} + then {< tvs = Base.Map.remove tvs key >} + else {< tvs = Base.Map.set tvs ~key ~data:ts >} method taint_ptr a (s : size) ts = if Set.is_empty ts then self diff --git a/lib/bap_strings/bap_strings_detector.ml b/lib/bap_strings/bap_strings_detector.ml index d769e99e3..693646205 100644 --- a/lib/bap_strings/bap_strings_detector.ml +++ b/lib/bap_strings/bap_strings_detector.ml @@ -112,7 +112,7 @@ let run t = let open Sequence.Step in Sequence.unfold_with ~init:t ~f:(fun t (x,c) -> let t = step t x c in - when_decided t (Skip t) ~f:(fun d -> Yield (d,t))) + when_decided t (Skip {state=t}) ~f:(fun d -> Yield {value=d; state=t})) let rev_zip_skip skip xs ys = diff --git a/lib/bap_strings/bap_strings_index.ml b/lib/bap_strings/bap_strings_index.ml index dcc7cfb0d..bda8828c1 100644 --- a/lib/bap_strings/bap_strings_index.ml +++ b/lib/bap_strings/bap_strings_index.ml @@ -34,7 +34,7 @@ module Persistent = struct let empty = { strings = Index.empty; - keys = String.Map.empty; + keys = (Map.empty (module String)); } let string {strings} key = diff --git a/lib/bap_strings/bap_strings_scanner.ml b/lib/bap_strings/bap_strings_scanner.ml index a35450c15..2836e2f0c 100644 --- a/lib/bap_strings/bap_strings_scanner.ml +++ b/lib/bap_strings/bap_strings_scanner.ml @@ -25,7 +25,7 @@ let run ?is_stop ~read off = let str = next ?is_stop ~read off in let len = String.length str in if len <> 0 - then Seq.Step.Yield ((off,str),(off+len)) + then Seq.Step.Yield {value=(off,str); state=off+len} else match read off with | None -> Seq.Step.Done - | Some _ -> Seq.Step.Skip (off+1)) + | Some _ -> Seq.Step.Skip {state=off+1}) diff --git a/lib/bap_strings/bap_strings_unscrambler.ml b/lib/bap_strings/bap_strings_unscrambler.ml index 5aefed61a..9d00cecc9 100644 --- a/lib/bap_strings/bap_strings_unscrambler.ml +++ b/lib/bap_strings/bap_strings_unscrambler.ml @@ -56,7 +56,7 @@ module Make(Alpha : Alphabet) = struct Array.init Alpha.length ~f:(fun i -> String.count word ~f:(fun c -> Alpha.index c = i)) - let empty = {dict = Int.Map.empty; data=[]} + let empty = {dict = (Map.empty (module Int)); data=[]} let add_word dict word = diff --git a/lib/bap_taint/bap_taint.ml b/lib/bap_taint/bap_taint.ml index 5396b9412..f770771ef 100644 --- a/lib/bap_taint/bap_taint.ml +++ b/lib/bap_taint/bap_taint.ml @@ -36,7 +36,7 @@ type kinds = { let kinds = Primus.Machine.State.declare ~name:"tainter-object-kinds" ~uuid:"a97f9cf6-541a-4127-9eb6-6c24f67ed8b9" - (fun _ -> {objects = Primus.Value.Map.empty}) + (fun _ -> {objects = (Map.empty (module Primus.Value))}) module Object = struct type Primus.exn += Bad_object of Primus.value @@ -130,8 +130,8 @@ type gc_local = { } let empty_tainter = { - direct = Vid.Map.empty; - indirect = Primus.Value.Map.empty; + direct = (Map.empty (module Vid)); + indirect = (Map.empty (module Primus.Value)); } let tainter = Primus.Machine.State.declare @@ -186,7 +186,7 @@ let objects {direct; indirect} : objects = let to_set m : objects = Map.to_sequence m |> Seq.map ~f:snd |> - Seq.fold ~init:Object.Set.empty ~f:Set.union in + Seq.fold ~init:(Set.empty (module Object)) ~f:Set.union in Set.union (to_set direct) (to_set indirect) module Taint = struct @@ -233,7 +233,7 @@ module Taint = struct let lookup v (Rel {field; key}) = Machine.Local.get tainter >>| fun t -> match Map.find (Field.get field t) (key v) with - | None -> Object.Set.empty + | None -> (Set.empty (module Object)) | Some s -> s @@ -248,7 +248,7 @@ module Taint = struct s with direct = Map.update s.direct (Primus.Value.id value) ~f:(function - | None -> Object.Set.singleton taint + | None -> Set.singleton (module Object) taint | Some taints -> Set.add taints taint) }) >>= fun () -> report_attached Rel.direct taint value >>| fun () -> @@ -263,7 +263,7 @@ module Taint = struct Value.nsucc addr off >>= fun addr -> report_attached Rel.indirect taint addr >>| fun () -> Map.update indirect addr ~f:(function - | None -> Object.Set.singleton taint + | None -> Set.singleton (module Object) taint | Some taints -> Set.add taints taint)) >>= fun indirect -> Machine.Local.put tainter {s with indirect} >>| fun () -> taint @@ -303,7 +303,7 @@ module Propagation = struct ~name:"taint-policies" ~uuid:"4c370c33-ef1b-4e10-be27-ee751a4d6cf3" (fun _ -> { - servers = Kind.Map.empty; + servers = (Map.empty (module Kind)); default = None; }) @@ -344,7 +344,7 @@ module Propagation = struct Machine.Global.get kinds >>= fun kinds -> Machine.Local.get policies >>| fun policies -> let filter = select_objects kinds policies ~policy:p in - List.fold srcs ~init:Object.Set.empty ~f:(fun objs src -> + List.fold srcs ~init:(Set.empty (module Object)) ~f:(fun objs src -> match Map.find (Field.get ms.field s) (ms.key src) with | None -> objs | Some objs' -> Set.union (filter objs') objs) @@ -405,7 +405,7 @@ module Gc = struct let collect_direct = Machine.Local.get tainter >>= fun s -> Env.all >>= fun vars -> - Machine.Seq.fold vars ~init:Vid.Set.empty ~f:(fun live var -> + Machine.Seq.fold vars ~init:(Set.empty (module Vid)) ~f:(fun live var -> Env.is_set var >>= function | false -> !!live | true -> diff --git a/lib/bap_traces/bap_trace.ml b/lib/bap_traces/bap_trace.ml index 4e2c76596..a5a2332c9 100644 --- a/lib/bap_traces/bap_trace.ml +++ b/lib/bap_traces/bap_trace.ml @@ -164,8 +164,8 @@ let supports t tag = supports_by_tool t tag && supports_by_proto t tag let read_events t : event seq = let map e = match t.mapper e with - | None -> Seq.Step.Skip () - | Some e -> Seq.Step.Yield (e,()) in + | None -> Seq.Step.Skip {state=()} + | Some e -> Seq.Step.Yield {value=e; state=()} in Seq.unfold_step ~init:() ~f:(fun () -> match t.reader.next () with | None -> Seq.Step.Done @@ -173,8 +173,8 @@ let read_events t : event seq = | Some Error e -> match t.monitor e with | `Stop -> Seq.Step.Done | `Fail -> Error.raise e - | `Skip -> Seq.Step.Skip () - | `Make e -> Seq.Step.Yield (e,())) + | `Skip -> Seq.Step.Skip {state=()} + | `Make e -> Seq.Step.Yield {value=e; state=()}) let read_all t tag = read_events t |> Seq.filter_map ~f:(Value.get tag) diff --git a/lib/bap_traces/bap_trace_id.ml b/lib/bap_traces/bap_trace_id.ml index d66758c21..98de13b55 100644 --- a/lib/bap_traces/bap_trace_id.ml +++ b/lib/bap_traces/bap_trace_id.ml @@ -2,7 +2,7 @@ open Core_kernel[@@warning "-D"] open Regular.Std open Bap.Std -module Bin = Bin_prot.Utils.Make_binable(struct +module Bin = Bin_prot.Utils.Make_binable_without_uuid(struct module Binable = String type t = Uuidm.t let to_binable = Uuidm.to_bytes diff --git a/lib/bap_traces/bap_trace_meta.ml b/lib/bap_traces/bap_trace_meta.ml index eaf58d29e..57759882d 100644 --- a/lib/bap_traces/bap_trace_meta.ml +++ b/lib/bap_traces/bap_trace_meta.ml @@ -39,7 +39,7 @@ let hexstring_of_bytestring str = String.init (String.length str * 2) (fun dstix -> let srcix = dstix / 2 in let is_hi = dstix mod 2 = 0 in - let b = Caml.Char.code (String.get str srcix) in + let b = Stdlib.Char.code (String.get str srcix) in let nib = 0xF land if is_hi then (b lsr 4) else b in String.get byte2hexchar nib) @@ -52,7 +52,7 @@ module Binary = struct @\nmd5sum: %s\ @\n@[<2>\ args: %a@]\ - @\n@[<2>envp:@\n%a@]@]@\n}" t.path (Caml.Digest.to_hex t.md5sum) Args.pp t.args Envp.pp t.envp + @\n@[<2>envp:@\n%a@]@]@\n}" t.path (Stdlib.Digest.to_hex t.md5sum) Args.pp t.args Envp.pp t.envp end let pp_time fmt t = diff --git a/lib/bap_traces/bap_trace_traces.ml b/lib/bap_traces/bap_trace_traces.ml index 78189876f..d4ccea795 100644 --- a/lib/bap_traces/bap_trace_traces.ml +++ b/lib/bap_traces/bap_trace_traces.ml @@ -2,7 +2,7 @@ open Core_kernel[@@warning "-D"] module Trace = Bap_trace -let traces = Trace.Id.Table.create () +let traces = Hashtbl.create (module Trace.Id) let add t = Hashtbl.set traces ~key:(Trace.id t) ~data:t let remove t = Hashtbl.remove traces (Trace.id t) diff --git a/lib/bap_types/bap_bil_optimizations.ml b/lib/bap_types/bap_bil_optimizations.ml index 4adfd1a59..f9f588388 100644 --- a/lib/bap_types/bap_bil_optimizations.ml +++ b/lib/bap_types/bap_bil_optimizations.ml @@ -49,7 +49,7 @@ module Propagate(SM : Monad.State.S2) = struct type ctxt = const Var.Map.t type 'a r = ('a, ctxt) SM.t - let new_ctxt = Var.Map.empty + let new_ctxt = (Map.empty (module Var)) let find = Map.find let update = Map.set @@ -247,4 +247,4 @@ let prune_dead_virtuals bil = ~f:(fun live s -> live ++ Stmt_helpers.free_vars s) in let live = free cond ++ live' in s :: bil, live) in - fst (loop Var.Set.empty bil) + fst (loop (Set.empty (module Var)) bil) diff --git a/lib/bap_types/bap_bil_pass.ml b/lib/bap_types/bap_bil_pass.ml index 6aafb8e3b..b31b6ec1c 100644 --- a/lib/bap_types/bap_bil_pass.ml +++ b/lib/bap_types/bap_bil_pass.ml @@ -9,7 +9,7 @@ type t = { } type pass = t -let passes : t String.Table.t = String.Table.create () +let passes : t String.Table.t = Hashtbl.create (module String) let selected : (bil -> bil) list ref = ref [] let register_pass ?(desc="No description provided") name body = diff --git a/lib/bap_types/bap_bitvector.ml b/lib/bap_types/bap_bitvector.ml index bf6f9f28b..c88aabccc 100644 --- a/lib/bap_types/bap_bitvector.ml +++ b/lib/bap_types/bap_bitvector.ml @@ -135,7 +135,7 @@ end = struct let of_string s = {packed = Z.of_bits s} end - include Binable.Of_stringable(Stringable) [@@warning "-D"] + include Binable.Of_stringable_without_uuid(Stringable) [@@warning "-D"] include Sexpable.Of_stringable(Stringable) end @@ -691,7 +691,7 @@ module V1 = struct end include Z include Sexpable.Of_stringable(Repr) - include Binable.Of_stringable(Repr) [@@warning "-D"] + include Binable.Of_stringable_without_uuid(Repr) [@@warning "-D"] end type t = { @@ -717,7 +717,7 @@ module Stable = struct signed = is_signed x; } - include Binable.Of_binable(V1)(struct + include Binable.Of_binable_without_uuid(V1)(struct type t = Packed.t let to_binable = to_legacy let of_binable = of_legacy diff --git a/lib/bap_types/bap_context.ml b/lib/bap_types/bap_context.ml index 83c4f8bc3..e047eaa94 100644 --- a/lib/bap_types/bap_context.ml +++ b/lib/bap_types/bap_context.ml @@ -6,7 +6,7 @@ open Bap_bil type delta = result Bap_var.Map.t class t = object - val delta : delta = Bap_var.Map.empty + val delta : delta = (Map.empty (module Bap_var)) method lookup = Map.find delta method update key data = {< delta = Map.set delta ~key ~data >} method bindings = Map.to_sequence delta diff --git a/lib/bap_types/bap_helpers.ml b/lib/bap_types/bap_helpers.ml index 0e4a813b7..a6985a949 100644 --- a/lib/bap_types/bap_helpers.ml +++ b/lib/bap_types/bap_helpers.ml @@ -451,7 +451,7 @@ let substitute x y = (new rewriter x y)#run module Trie = struct type normalized_bil = bil - let vars = String.Table.create () + let vars = Hashtbl.create (module String) let pruned ty = Exp.Unknown ("", ty) @@ -460,7 +460,7 @@ module Trie = struct method! map_sym var = let name = Bap_var.name var in let ty = Bap_var.typ var in - String.Table.find_or_add vars name + Hashtbl.find_or_add vars name ~default:(fun () -> Bap_var.create name ty) method! map_int w = let ty = Type.Imm (Word.bitwidth w) in @@ -1002,7 +1002,7 @@ module Exp = struct let normalize = Normalize.normalize_exp let substitute x y = map (new rewriter x y) - let free_vars exp = fst @@ fold ~init:(VS.empty,[]) (object + let free_vars exp = fst @@ fold ~init:((Set.empty (module Bap_var)),[]) (object inherit [VS.t * var list] visitor method! enter_var var (vars,stack) = @@ -1038,19 +1038,19 @@ module Stmt = struct | Stmt.Move (_,e) | Stmt.Jmp e -> Exp.free_vars e | Stmt.While (e,ss) -> - VS.union_list @@ Exp.free_vars e :: List.map ss ~f:free_vars + Set.union_list (module Bap_var) @@ (Exp.free_vars e :: List.map ss ~f:free_vars) | Stmt.If (e,s1,s2) -> - VS.union_list @@ Exp.free_vars e :: List.map (s1@s2) ~f:free_vars + Set.union_list (module Bap_var) @@ (Exp.free_vars e :: List.map (s1@s2) ~f:free_vars) | Stmt.Special _ - | Stmt.CpuExn _ -> VS.empty + | Stmt.CpuExn _ -> (Set.empty (module Bap_var)) let bil_free_vars bil = let update news vars kill = - VS.union vars (VS.diff news kill) in - fst @@ List.fold bil ~init:(VS.empty,VS.empty) + Set.union vars (Set.diff news kill) in + fst @@ List.fold bil ~init:((Set.empty (module Bap_var)),(Set.empty (module Bap_var))) ~f:(fun (vars,kill) -> function | Stmt.Move (v,e) -> - update (Exp.free_vars e) vars kill, VS.add kill v + update (Exp.free_vars e) vars kill, Set.add kill v | stmt -> update (free_vars stmt) vars kill, kill) class constant_folder = Constant_folder.main diff --git a/lib/bap_types/bap_ir.ml b/lib/bap_types/bap_ir.ml index d17fbb7ba..3017777e6 100644 --- a/lib/bap_types/bap_ir.ml +++ b/lib/bap_types/bap_ir.ml @@ -200,9 +200,17 @@ end = struct include (val KB.Value.derive cls) end - let to_var v = Theory.Var.create (Var.sort v) (Var.ident v) +let rip_relative_addr = + let bool_domain = Knowledge.Domain.flat ~inspect:Bool.sexp_of_t + ~equal:Bool.equal ~empty:false "bool" in + Knowledge.Class.property ~package + Theory.Value.cls "rip-relative-addr" bool_domain + ~public:true + ~desc:"this value is a RIP-relative address" + + module Def : sig type t = { var : unit Theory.var; @@ -307,7 +315,7 @@ end = struct paths : path Tid.Table.t; } [@@deriving bin_io, fields, sexp] - let empty () = {subs = [| |] ; paths = Tid.Table.create () } + let empty () = {subs = [| |] ; paths = Hashtbl.create (module Tid) } let update p subs = { p with subs } @@ -453,7 +461,7 @@ let nil_def : def term = empty Def.{ let nil_phi : phi term = empty Phi.{ var = undefined_variable; - map = Map.empty (module Tid); + map = (Map.empty (module Tid)); } let nil_jmp : jmp term = empty Jmp.{ @@ -491,7 +499,7 @@ let term_pp ?(no_cut=false) ?(box=horizontal) pp_self ppf t = let open Format in let attrs = Dict.data t.dict in Seq.iter attrs ~f:(fun attr -> - pp_open_tag ppf (asprintf "%a" pp_attr attr)); + pp_open_stag ppf (String_tag (asprintf "%a" pp_attr attr))); let pp_cut ppf = if not no_cut then Format.pp_print_break ppf 1 0 else fprintf ppf " " in @@ -500,7 +508,7 @@ let term_pp ?(no_cut=false) ?(box=horizontal) pp_self ppf t = pp_cut pp_self t.self; Format.pp_close_box ppf (); - Seq.iter attrs ~f:(fun _ -> pp_close_tag ppf ()) + Seq.iter attrs ~f:(fun _ -> pp_close_stag ppf ()) [@@warning "-D"] (* for open and close tag *) let pp_value slots ppf x = @@ -706,6 +714,13 @@ module Ir_def = struct } } + let with_value ({self={Def.var}} as t) v = { + t with self = Def.{ + var; + rhs = Rhs.of_value v + } + } + let map_exp def ~f : def term = with_rhs def (f (rhs def)) @@ -809,7 +824,7 @@ module Ir_phi = struct let substitute phi x y = map_exp phi ~f:(Exp.substitute x y) let free_vars phi = - values phi |> Seq.fold ~init:Bap_var.Set.empty ~f:(fun vars (_,e) -> + values phi |> Seq.fold ~init:(Set.empty (module Bap_var)) ~f:(fun vars (_,e) -> Set.union vars (Exp.free_vars e)) let pp_self ppf {Phi.var; map} = @@ -859,6 +874,8 @@ module Ir_jmp = struct | Direct tid -> Some (Resolved tid) | Indirect exp -> match Bap_helpers.Type.infer_exn exp with | Imm len -> Some (Indirect {vec = Rhs.of_exp exp; len}) + | Mem (addr, _) -> + Some (Indirect {vec = Rhs.of_exp exp; len = Bap_size.in_bits addr}) | _ -> None let lbl_of_dst : Jmp.dst -> label = function @@ -986,7 +1003,7 @@ module Ir_jmp = struct let substitute jmp x y = map_exp jmp ~f:(Exp.substitute x y) let free_vars jmp = - exps jmp |> Seq.fold ~init:Bap_var.Set.empty ~f:(fun vars e -> + exps jmp |> Seq.fold ~init:(Set.empty (module Bap_var)) ~f:(fun vars e -> Set.union vars (Exp.free_vars e)) let eval jmp bili = @@ -1642,7 +1659,7 @@ module Ir_blk = struct let free_vars blk = let (++) = Set.union and (--) = Set.diff in - let init = Bap_var.Set.empty,Bap_var.Set.empty in + let init = (Set.empty (module Bap_var)),(Set.empty (module Bap_var)) in fst @@ Seq.fold (elts blk) ~init ~f:(fun (vars,kill) -> function | `Phi _ -> vars, kill | `Def def -> @@ -1949,7 +1966,7 @@ module Ir_program = struct let get_and_cache (get : 'a getter) prog tid : 'a term option = let open Option.Monad_infix in get prog tid >>= fun (path,term) -> - Tid.Table.change prog.self.paths tid (fun _ -> Some path); + Hashtbl.change prog.self.paths tid (fun _ -> Some path); Some term type 'a entry = { @@ -1959,7 +1976,7 @@ module Ir_program = struct let make_getter (term : 'a entry) prog (tid : tid) : 'a term option = let open Option.Monad_infix in - match Tid.Table.find prog.self.paths tid with + match Hashtbl.find prog.self.paths tid with | None -> get_and_cache term.get prog tid | Some path -> try @@ -1987,7 +2004,7 @@ module Ir_program = struct match lookup t p tid with | None -> None | Some _ -> - let path = Tid.Table.find_exn p.self.paths tid in + let path = Hashtbl.find_exn p.self.paths tid in match t.par with | Blk -> Some (blk_of_path p path) | Arg -> Some (arg_of_path p path) diff --git a/lib/bap_types/bap_ir.mli b/lib/bap_types/bap_ir.mli index 7641e809a..6a712d2dc 100644 --- a/lib/bap_types/bap_ir.mli +++ b/lib/bap_types/bap_ir.mli @@ -316,6 +316,7 @@ module Ir_def : sig val rhs : t -> exp val with_lhs : t -> var -> t val with_rhs : t -> exp -> t + val with_value : t -> unit Theory.value -> t val map_exp : t -> f:(exp -> exp) -> t val substitute : t -> exp -> exp -> t val free_vars : t -> Bap_var.Set.t @@ -431,6 +432,8 @@ module Call : sig include Regular.S with type t := t end +val rip_relative_addr : (Theory.Value.cls, bool) KB.slot + module Label : sig type t = label val create : unit -> t diff --git a/lib/bap_types/bap_ir_callgraph.ml b/lib/bap_types/bap_ir_callgraph.ml index ed0e5b626..6a3469fcd 100644 --- a/lib/bap_types/bap_ir_callgraph.ml +++ b/lib/bap_types/bap_ir_callgraph.ml @@ -12,7 +12,7 @@ let create program = let init = G.Node.insert src g in Term.enum blk_t sub |> Seq.fold ~init ~f:(fun g blk -> Term.enum jmp_t blk |> - Seq.fold ~init:Tid.Map.empty ~f:(fun dsts jmp -> + Seq.fold ~init:(Map.empty (module Tid)) ~f:(fun dsts jmp -> match Ir_jmp.kind jmp with | Goto _ | Ret _ | Int _ -> dsts | Call call -> match Call.target call with diff --git a/lib/bap_types/bap_ir_graph.ml b/lib/bap_types/bap_ir_graph.ml index bb8117ba4..49f8391e2 100644 --- a/lib/bap_types/bap_ir_graph.ml +++ b/lib/bap_types/bap_ir_graph.ml @@ -30,7 +30,7 @@ module Pred = struct | Some xs -> Some (Set.add xs src)) let insert dst preds = - Map.set preds ~key:dst ~data:Tid.Set.empty + Map.set preds ~key:dst ~data:(Set.empty (module Tid)) end (* internal representation of a graph: @@ -82,7 +82,7 @@ type difference_kind = [@@deriving variants, sexp] let jmp_set b = Term.enum jmp_t b |> Seq.map ~f:Term.tid |> - Seq.fold ~init:Tid.Set.empty ~f:Set.add + Seq.fold ~init:(Set.empty (module Tid)) ~f:(fun s x -> Set.add s x) (** [control_flow_difference bx by] computes a changes in control flow produced by blocks [bx] and [by]. Only changes, that affects graph @@ -338,7 +338,7 @@ end let empty = { sub = Sub.create (); - preds = Tid.Map.empty; + preds = (Map.empty (module Tid)); } let create ?tid ?name () = { @@ -360,17 +360,17 @@ let number_of_nodes t = Term.length blk_t t.sub let preds_of_sub sub : Tid.Set.t Tid.Map.t = Term.enum blk_t sub |> - Seq.fold ~init:Tid.Map.empty ~f:(fun ins src -> + Seq.fold ~init:(Map.empty (module Tid)) ~f:(fun ins src -> let src_id = Term.tid src in let ins = Map.change ins src_id (function - | None -> Some Tid.Set.empty + | None -> Some (Set.empty (module Tid)) | other -> other) in Term.enum jmp_t src |> Seq.fold ~init:ins ~f:(fun ins jmp -> match succ_tid_of_jmp jmp with | None -> ins | Some tid -> Map.change ins tid (function - | None -> Some (Tid.Set.singleton src_id) + | None -> Some (Set.singleton (module Tid) src_id) | Some set -> Some (Set.add set src_id)))) let of_sub sub = { diff --git a/lib/bap_types/bap_ogre.ml b/lib/bap_types/bap_ogre.ml index 53967f240..bf475a65f 100644 --- a/lib/bap_types/bap_ogre.ml +++ b/lib/bap_types/bap_ogre.ml @@ -16,7 +16,7 @@ end let pp = Ogre.Doc.pp include Sexpable.Of_stringable(Stringable) -include Binable.Of_stringable(Stringable) [@@warning "-D"] +include Binable.Of_stringable_without_uuid(Stringable) [@@warning "-D"] type KB.Conflict.t += Spec_inconsistency of Error.t diff --git a/lib/bap_types/bap_result.ml b/lib/bap_types/bap_result.ml index b653d0d4d..b6bb97317 100644 --- a/lib/bap_types/bap_result.ml +++ b/lib/bap_types/bap_result.ml @@ -57,7 +57,7 @@ module Storage = struct end class sparse : storage = object - val storage = Bitvector.Map.empty + val storage = (Map.empty (module Bitvector)) method save x u = {< storage = Map.set storage ~key:x ~data:u >} method load x = Map.find storage x end diff --git a/lib/bap_types/bap_stmt.ml b/lib/bap_types/bap_stmt.ml index 6f3c366f9..fd3ebd92b 100644 --- a/lib/bap_types/bap_stmt.ml +++ b/lib/bap_types/bap_stmt.ml @@ -212,6 +212,14 @@ let slot = Knowledge.Class.property ~package:"bap" ~public:true ~desc:"semantics of statements in BIL" +let bool_domain = Knowledge.Domain.flat "bool" + ~inspect:sexp_of_bool ~equal:Bool.equal ~empty:false + +let rip_relative = Knowledge.Class.property ~package:"bap" + Theory.Semantics.cls "rip-relative" bool_domain + ~public:true + ~desc:"RIP-relative addressing is used in the semantics" + let code = KB.Class.property ~package:"bap" ~persistent Theory.Program.cls "bil-code" domain ~public:true diff --git a/lib/bap_types/bap_stmt.mli b/lib/bap_types/bap_stmt.mli index 10f70625c..b35bcf98b 100644 --- a/lib/bap_types/bap_stmt.mli +++ b/lib/bap_types/bap_stmt.mli @@ -44,5 +44,6 @@ module Stmts_data : Data.S with type t = stmt list val slot : (Theory.Semantics.cls, stmt list) Knowledge.slot val code : (Theory.program, stmt list) KB.slot +val rip_relative : (Theory.Semantics.cls, bool) Knowledge.slot val domain : stmt list Knowledge.domain val persistent : stmt list Knowledge.persistent diff --git a/lib/bap_types/bap_toplevel.ml b/lib/bap_types/bap_toplevel.ml index bc9968e52..7b79fb671 100644 --- a/lib/bap_types/bap_toplevel.ml +++ b/lib/bap_types/bap_toplevel.ml @@ -69,7 +69,7 @@ let get slot = eval slot this |> function | Some x -> x -let () = Caml.Printexc.register_printer @@ function +let () = Stdlib.Printexc.register_printer @@ function | Conflict err -> Some (Format.asprintf "%a" Knowledge.Conflict.pp err) | _ -> None diff --git a/lib/bap_types/bap_trie.ml b/lib/bap_types/bap_trie.ml index bcfb6a265..135c1604b 100644 --- a/lib/bap_types/bap_trie.ml +++ b/lib/bap_types/bap_trie.ml @@ -5,10 +5,66 @@ open Option.Monad_infix open Bap_trie_intf module Make(Key : Key) = struct - module Tokens = Hashtbl.Make_binable(struct - type t = Key.token [@@deriving bin_io, compare, sexp] - let hash = Key.token_hash - end) + module Token_key = struct + type t = Key.token [@@deriving bin_io, compare, sexp] + let hash = Key.token_hash + end + + (* Simple assoc-list based table (v0.17 compat) *) + module Tokens = struct + type 'a t = (Token_key.t * 'a) list ref + + let create () : 'a t = ref [] + + let find t k = + let rec loop = function + | [] -> None + | (k',v) :: rest -> + if Base.Poly.equal k k' then Some v else loop rest in + loop !t + + let change t k ~f = + let rec loop acc = function + | [] -> (match f None with + | Some v -> List.rev ((k,v) :: acc) + | None -> List.rev acc) + | (k',v) :: rest -> + if Base.Poly.equal k k' + then (match f (Some v) with + | Some v' -> List.rev acc @ [(k',v')] @ rest + | None -> List.rev acc @ rest) + else loop ((k',v) :: acc) rest in + t := loop [] !t + + let add_exn t ~key ~data = t := (key,data) :: !t + + let fold t ~init ~f = List.fold !t ~init ~f:(fun acc (k,v) -> f ~key:k ~data:v acc) + + let iteri t ~f = List.iter !t ~f:(fun (k,v) -> f ~key:k ~data:v) + + let sexp_of_t sa t = + Sexp.List (List.map !t ~f:(fun (k,v) -> Sexp.List [Token_key.sexp_of_t k; sa v])) + + let t_of_sexp sa = function + | Sexp.List items -> + ref (List.map items ~f:(function + | Sexp.List [k;v] -> (Token_key.t_of_sexp k, sa v) + | _ -> failwith "Trie.Sexp: bad pair")) + | _ -> failwith "Trie.Sexp: expected list" + + module A = struct + type 'a t = (Token_key.t * 'a) list [@@deriving bin_io] + end + + let bin_shape_t sa = A.bin_shape_t sa + let bin_size_t sa (t : 'a t) = A.bin_size_t sa !t + let bin_write_t wa (buf : Bin_prot.Common.buf) ~(pos:int) (t : 'a t) = A.bin_write_t wa buf ~pos !t + let bin_read_t ra buf ~pos_ref = ref (A.bin_read_t ra buf ~pos_ref) + let __bin_read_t__ ra buf ~pos_ref = ref (A.__bin_read_t__ ra buf ~pos_ref) + let bin_writer_t wa = A.bin_writer_t wa + let bin_reader_t ra = A.bin_reader_t ra + let bin_t tc = A.bin_t tc + end type key = Key.t type token = Key.token @@ -26,7 +82,7 @@ module Make(Key : Key) = struct let rec loop n {subs} = let c = Key.nth_token k n in if n + 1 = len then found subs c else find subs n c - and found parent c = Tokens.change parent c (function + and found parent c = Tokens.change parent c ~f:(function | None -> f None >>| init | Some t -> Some {t with data = f t.data}) and find parent n c = match Tokens.find parent c with @@ -35,7 +91,7 @@ module Make(Key : Key) = struct | None -> return () | Some _ -> let sub = create () in - Tokens.add_exn parent c sub; + ignore (Tokens.add_exn parent ~key:c ~data:sub); loop (n+1) sub in if len > 0 then loop 0 trie else trie.data <- f trie.data @@ -97,7 +153,7 @@ module Make(Key : Key) = struct pp_val data pp_prefix (List.rev rprefix)); pp_table ppf rprefix t.subs and pp_table ppf rprefix cs = - Tokens.iteri cs (fun ~key ~data -> + Tokens.iteri cs ~f:(fun ~key ~data -> let rprefix = key :: rprefix in pp_trie ppf rprefix data) in pp_trie ppf [] t diff --git a/lib/bap_types/bap_types.ml b/lib/bap_types/bap_types.ml index 28163a344..f7236dc12 100644 --- a/lib/bap_types/bap_types.ml +++ b/lib/bap_types/bap_types.ml @@ -106,6 +106,7 @@ module Std = struct end let slot = Bap_stmt.slot let code = Bap_stmt.code + let rip_relative = Bap_stmt.rip_relative let domain = Bap_stmt.domain let persistent = Bap_stmt.persistent end diff --git a/lib/bap_types/bap_value.ml b/lib/bap_types/bap_value.ml index d865c09c9..ddcb71017 100644 --- a/lib/bap_types/bap_value.ml +++ b/lib/bap_types/bap_value.ml @@ -21,9 +21,7 @@ type 'a tag = { slot : (Theory.program,'a option) KB.slot; } -module Value = struct - type t = Univ_map.Packed.t = T : 'a Type_equal.Id.t * 'a -> t -end +module Value = Univ_map.Packed module Equal = struct type ('a,'b) t = ('a,'b) Type_equal.t = T : ('a,'a) t @@ -147,7 +145,7 @@ module Univ = struct } [@@deriving bin_io] end - include Binable.Of_binable(Repr)(struct + include Binable.Of_binable_without_uuid(Repr)(struct type t = Value.t let to_binable x = Repr.{ typeid = typeid x; @@ -208,7 +206,7 @@ module Match = struct handlers : (Value.t -> 's) Map.M(Uid).t; } - let empty = Map.empty (module Uid) + let empty = (Map.empty (module Uid)) let default default = { handlers = empty; @@ -261,7 +259,7 @@ module Dict = struct List.fold ~init:empty ~f:(fun dict (Value.T (k,x)) -> Univ_map.set dict k x) end - include Binable.Of_binable(Data)(struct + include Binable.Of_binable_without_uuid(Data)(struct type t = Univ_map.t let to_binable = Data.of_dict let of_binable = Data.to_dict diff --git a/lib/bap_types/bap_var.ml b/lib/bap_types/bap_var.ml index 724f4557c..e31d1d66d 100644 --- a/lib/bap_types/bap_var.ml +++ b/lib/bap_types/bap_var.ml @@ -115,7 +115,7 @@ module T = struct let of_sexpable = Repr.to_var end) - include Binable.Of_binable(Repr)(struct + include Binable.Of_binable_without_uuid(Repr)(struct type t = var let to_binable = Repr.of_var let of_binable = Repr.to_var diff --git a/lib/bare/bare.ml b/lib/bare/bare.ml index c935c166a..09b1d9fd6 100644 --- a/lib/bare/bare.ml +++ b/lib/bare/bare.ml @@ -66,8 +66,8 @@ module Rule = struct let reset {rule} = {rule; work = [rule]} - let empty = String.Map.empty - let binding x rhs = String.Map.singleton x rhs + let empty = (Map.empty (module String)) + let binding x rhs = Map.singleton (module String) x rhs let sexp_fold_atoms ~get_pos ~init ~f sexp = let rec loop init s = match s with @@ -84,7 +84,7 @@ module Rule = struct else atoms) let collect_free_vars ~get_pos xs = - List.fold ~init:String.Map.empty ~f:(vars_of_sexp ~get_pos) xs + List.fold ~init:(Map.empty (module String)) ~f:(vars_of_sexp ~get_pos) xs let check_rule ~get_pos lhs rhs = let def = collect_free_vars ~get_pos lhs diff --git a/lib/bitvec_binprot/bitvec_binprot.ml b/lib/bitvec_binprot/bitvec_binprot.ml index 19e8bfd25..2d8dcc376 100644 --- a/lib/bitvec_binprot/bitvec_binprot.ml +++ b/lib/bitvec_binprot/bitvec_binprot.ml @@ -1,6 +1,6 @@ open Bin_prot.Std type t = Bitvec.t -module Functions = Bin_prot.Utils.Make_binable(struct +module Functions = Bin_prot.Utils.Make_binable_without_uuid(struct module Binable = struct type t = string [@@deriving bin_io] end diff --git a/lib/graphlib/graphlib.mli b/lib/graphlib/graphlib.mli index b8f33e4e0..37641514a 100644 --- a/lib/graphlib/graphlib.mli +++ b/lib/graphlib/graphlib.mli @@ -1043,7 +1043,7 @@ module Std : sig [rev] is true, then the graph is reversed. For example, the following will build a set of reachable nodes: - [fold_reachable (module G) ~init:G.Node.Set.empty ~f:Set.add] + [fold_reachable (module G) ~init:(Set.empty (module G.Node)) ~f:Set.add] *) val fold_reachable : (module Graph with type t = 'c diff --git a/lib/graphlib/graphlib_graph.ml b/lib/graphlib/graphlib_graph.ml index af705673e..47fb4e44b 100644 --- a/lib/graphlib/graphlib_graph.ml +++ b/lib/graphlib/graphlib_graph.ml @@ -402,7 +402,7 @@ module To_ocamlgraph(G : Graph) = struct let find_edge g x y = match G.Node.edge x y g with | Some e -> e - | None -> raise Caml.Not_found + | None -> raise Stdlib.Not_found let find_all_edges g x y = G.Node.edge x y g |> function | None -> [] @@ -482,7 +482,7 @@ module Of_ocamlgraph(G : Graph.Sig.P) = struct let remove n g = G.remove_vertex g n let has_edge x y g = G.mem_edge g x y let edge x y g = - try Some (G.find_edge g x y) with Caml.Not_found -> None + try Some (G.find_edge g x y) with Stdlib.Not_found -> None let degree ?dir n g = try match dir with @@ -568,8 +568,8 @@ module Of_ocamlgraph(G : Graph.Sig.P) = struct let cmp (type t) (module C : Comparable with type t = t) enum x y = - let set x = Seq.fold (enum x) ~f:Set.add ~init:C.Set.empty in - C.Set.compare (set x) (set y) + let set x = Seq.fold (enum x) ~f:(fun s x -> Set.add s x) ~init:(Set.empty (module C)) in + Poly.compare (Set.to_list (set x)) (Set.to_list (set y)) (* complexity: O(e*log(e) + n*log(n)), where [e] is a number of edges and [n] is a number of nodes. See a note above for the @@ -605,7 +605,7 @@ let compare (type e) (type g) (type n) let t_of_sexp = opaque_of_sexp end) in let module Nodes = E.Node.Set in - let set empty x = Seq.fold x ~f:Set.add ~init:empty in + let set empty x = Seq.fold x ~f:(fun s x -> Set.add s x) ~init:empty in let edges edges src dst empty g = edges g |> Seq.map ~f:(fun e -> src e, dst e) |> set empty in let e_edges = edges E.edges E.Edge.src E.Edge.dst Edges.empty e in @@ -627,7 +627,7 @@ module Ordering(G : Graph) = struct } let init g = { - numbers = G.Node.Map.empty; + numbers = (Map.empty (module G.Node)); nodes_left = G.number_of_nodes g; nodes_entered = 0; } @@ -755,7 +755,7 @@ let postorder_traverse graph ?rev ?start g = let create_namer (type t) (type n) (module G : Graph with type t = t and type node = n) g = let namer = - depth_first_search (module G) g ~init:G.Node.Map.empty + depth_first_search (module G) g ~init:(Map.empty (module G.Node)) ~leave_node:(fun rpost n names -> Map.set names ~key:n ~data:(Int.to_string rpost)) in Map.find_exn namer @@ -829,10 +829,10 @@ let idom (type t) (type n) (type e) ~start_tree:(fun _ len -> if len <> 0 then return len else len) ~enter_node:(fun _ _ len -> len + 1)) in let node = Array.create ~len entry in - let pnums = G.Node.Table.create ~size:len () in + let pnums : (n, int) Hashtbl.Poly.t = Hashtbl.Poly.create ~size:len () in let doms = Array.create ~len ~-1 in let pnum = - Hashtbl.find_and_call pnums + Hashtbl.Poly.find_and_call pnums ~if_found:Fn.id ~if_not_found:(fun _ -> raise Unreachable) in if len > 0 then doms.(len - 1) <- len - 1; @@ -882,12 +882,12 @@ let dominators (type t) (type n) (type e) and type edge = e and type node = n) ?rev g entry = let `idom parent = idom ?rev (module G) g entry in - let init = G.nodes g |> Seq.fold ~init:G.Node.Map.empty ~f:(fun t n -> + let init = G.nodes g |> Seq.fold ~init:(Map.empty (module G.Node)) ~f:(fun t n -> Map.set t ~key:n ~data:[]) in let children = G.nodes g |> Seq.fold ~init ~f:(fun tree n -> match parent n with | Some p -> Map.add_multi tree ~key:p ~data:n - | None -> tree) |> Map.map ~f:G.Node.Set.of_list in + | None -> tree) |> Map.map ~f:(Set.of_list (module G.Node)) in create_tree parent children module type Dom_frontier_algo = functor (G : Graph) -> sig @@ -903,13 +903,13 @@ module Dom_frontier_cooper(G:Graph) = struct else match idom r with | None -> Set.add dfs r | Some p -> walk top (Set.add dfs r) p in - G.nodes g |> Seq.fold ~init:G.Node.Map.empty ~f:(fun dfs n -> + G.nodes g |> Seq.fold ~init:(Map.empty (module G.Node)) ~f:(fun dfs n -> let adj = adj n g in let dom = idom n in - Seq.fold adj ~init:G.Node.Set.empty ~f:(walk dom) |> + Seq.fold adj ~init:(Set.empty (module G.Node)) ~f:(walk dom) |> Set.fold ~init:dfs ~f:(fun dfs visited -> Map.change dfs visited (function - | None -> Some (G.Node.Set.singleton n) + | None -> Some (Set.singleton (module G.Node) n) | Some set -> Some (Set.add set n)))) end @@ -934,8 +934,8 @@ let strong_components (module G : Graph with type t = t and type node = n and type edge = e) g = - let roots = G.Node.Table.create () in - let comps = G.Node.Table.create ~size:(G.number_of_nodes g) () in + let roots = Hashtbl.create (module G.Node) in + let comps = Hashtbl.create (module G.Node) ~size:(G.number_of_nodes g) in let root = Hashtbl.find_exn roots in let spill_comp root stack = List.drop_while stack ~f:(fun c -> @@ -995,7 +995,7 @@ let shortest_path let adj = if rev then G.Node.inputs else G.Node.outputs in let dst = if rev then G.Edge.src else G.Edge.dst in let visited = G.Node.Hash_set.create () in - let dist = G.Node.Table.create () in + let dist = Hashtbl.create (module G.Node) in let q = Heap.create ~cmp () in let rec loop () = match Heap.pop q with | None -> None @@ -1358,11 +1358,11 @@ module Fixpoint = struct reverse_postorder_traverse (module G) ~rev ?start g |> Sequence.to_array in let rnodes = - Array.foldi nodes ~init:G.Node.Map.empty ~f:(fun i rnodes n -> + Array.foldi nodes ~init:(Map.empty (module G.Node)) ~f:(fun i rnodes n -> Map.set rnodes ~key:n ~data:i) in let succs = Array.map nodes ~f:(fun n -> let succs = if rev then G.Node.preds else G.Node.succs in - succs n g |> Sequence.fold ~init:Int.Set.empty ~f:(fun ns n -> + succs n g |> Sequence.fold ~init:(Set.empty (module Int)) ~f:(fun ns n -> match Map.find rnodes n with | None -> ns | Some i -> Set.add ns i)) in @@ -1410,12 +1410,12 @@ module Fixpoint = struct | Step (visits,works,approx) -> loop visits (iters+1) works approx else make_solution iters approx in let works = List.init (Array.length nodes) Fn.id in - let approx = Map.fold init ~init:Int.Map.empty + let approx = Map.fold init ~init:(Map.empty (module Int)) ~f:(fun ~key:node ~data approx -> match Map.find rnodes node with | None -> approx | Some n -> Map.set approx ~key:n ~data) in - loop Int.Map.empty iters (Int.Set.of_list works) approx + loop (Map.empty (module Int)) iters (Set.of_list (module Int) works) approx end let fixpoint = Fixpoint.compute diff --git a/lib/graphlib/graphlib_pp.ml b/lib/graphlib/graphlib_pp.ml index 501fd6ca6..add7a72fe 100644 --- a/lib/graphlib/graphlib_pp.ml +++ b/lib/graphlib/graphlib_pp.ml @@ -61,7 +61,7 @@ let by_natural_order (type a) variant compare nodes = let compare = compare let sexp_of_t = sexp_of_opaque end) end in - Seq.fold nodes ~init:(Set.empty (module T)) ~f:Set.add |> + Seq.fold nodes ~init:(Set.empty (module T)) ~f:(fun s x -> Set.add s x) |> Set.to_sequence |> by_given_order variant compare module Dot = struct diff --git a/lib/graphlib/graphlib_regular.ml b/lib/graphlib/graphlib_regular.ml index 2c7d86c5f..5a708e5d7 100644 --- a/lib/graphlib/graphlib_regular.ml +++ b/lib/graphlib/graphlib_regular.ml @@ -31,7 +31,7 @@ module Make(Node : Opaque.S)(Label : T) = struct type graph = node_info Node.Map.t [@@deriving compare] - let empty_node = {inc = Node.Map.empty; out = Node.Map.empty} + let empty_node = {inc = (Map.empty (module Node)); out = (Map.empty (module Node))} module Node = struct type nonrec edge = edge @@ -134,7 +134,7 @@ module Make(Node : Opaque.S)(Label : T) = struct Map.change g (src e) (function | None -> Some (Field.fset field empty_node - (Node.Map.singleton (dst e) e.data)) + (Map.singleton (module Node) (dst e) e.data)) | Some ns -> let map = Field.get field ns in Some (Field.fset field ns @@ -168,7 +168,7 @@ module Make(Node : Opaque.S)(Label : T) = struct let is_directed = true - let empty = Node.Map.empty + let empty = (Map.empty (module Node)) let nodes g = Map.keys g |> Seq.of_list diff --git a/lib/knowledge/bap_knowledge.ml b/lib/knowledge/bap_knowledge.ml index ea4d64797..625ac2cf8 100644 --- a/lib/knowledge/bap_knowledge.ml +++ b/lib/knowledge/bap_knowledge.ml @@ -17,9 +17,9 @@ type conflict = exn = .. module Conflict = struct type t = conflict = .. - let to_string = Caml.Printexc.to_string + let to_string = Stdlib.Printexc.to_string let pp ppf err = Format.fprintf ppf "%s" (to_string err) - let register_printer = Caml.Printexc.register_printer + let register_printer = Stdlib.Printexc.register_printer let sexp_of_t err = Sexp.Atom (to_string err) end @@ -159,21 +159,21 @@ end let branching_bit a b = highest_bit (a lxor b) let rec find_exn t k = match t with - | Nil -> raise Caml.Not_found + | Nil -> raise Stdlib.Not_found | Tip (k', v) when k = k' -> v - | Tip _ -> raise Caml.Not_found + | Tip _ -> raise Stdlib.Not_found | Bin (k', l, r) -> match Key.compare k' k with - | NA -> raise Caml.Not_found + | NA -> raise Stdlib.Not_found | LB -> find_exn l k | RB -> find_exn r k let find t k = try Some (find_exn t k) - with Caml.Not_found -> None + with Stdlib.Not_found -> None let mem k t = try ignore (find_exn k t); true - with Caml.Not_found -> false + with Stdlib.Not_found -> false let node payload branching l r = match l, r with | Nil, o | o, Nil -> o @@ -364,7 +364,7 @@ end = struct let unescaped_exists_so_escape ?(skip_pos=(-1)) s = let buf = Buffer.create (String.length s + 1) in - Caml.StringLabels.iteri s ~f:(fun p c -> + Stdlib.StringLabels.iteri s ~f:(fun p c -> if p <> skip_pos && is_separator_unescaped s p c then Buffer.add_char buf escape_char; Buffer.add_char buf c); @@ -594,7 +594,7 @@ end = struct ?package ?(reliability=trustworthy) name = let name = Name.create ?package name in - let agent = Caml.Digest.string (Name.show name) in + let agent = Stdlib.Digest.string (Name.show name) in if Hashtbl.mem agents agent then failwithf "An agent with name `%a' already exists, \ please choose another name" Name.str name (); @@ -775,7 +775,7 @@ module Domain = struct (module S : Comparator.S with type t = t and type comparator_witness = o) ?(inspect=S.comparator.sexp_of_t) name = - let empty = Set.empty (module S) in + let empty = (Set.empty (module S)) in let order x y : Order.partial = if Set.equal x y then EQ else if Set.is_subset x y then LT else @@ -801,7 +801,7 @@ module Domain = struct ?join ~equal name = - let empty = Map.empty (module K) in + let empty = (Map.empty (module K)) in let join = match join with | Some join -> join | None -> fun x y -> @@ -2121,7 +2121,7 @@ module Record = struct end } - include Binable.Of_binable(Repr)(struct + include Binable.Of_binable_without_uuid(Repr)(struct type t = record let to_binable s = Dict.foreach s ~init:[] { @@ -2265,8 +2265,8 @@ module Knowledge = struct let empty_class = { last = Oid.first; vals = Oid.Tree.empty; - objs = Map.empty (module Name.Full); - pubs = Map.empty (module String); + objs = (Map.empty (module Name.Full)); + pubs = (Map.empty (module String)); } type t = { @@ -2281,13 +2281,13 @@ module Knowledge = struct let empty : Env.t = { package = user_package; - classes = Map.empty (module Name); + classes = (Map.empty (module Name)); context = Dict.empty; } let noinfo : Env.info = { data = Record.empty; - comp = Map.empty (module Name); + comp = (Map.empty (module Name)); name = None; } @@ -2472,7 +2472,7 @@ module Knowledge = struct let t_of_sexp = opaque_of_sexp let empty = empty cls - include Binable.Of_binable(Record)(struct + include Binable.Of_binable_without_uuid(Record)(struct type t = (a,b) cls value let to_binable : 'a value -> Record.t = fun {data} -> data @@ -2700,7 +2700,7 @@ module Knowledge = struct end in let module R = struct include Comparator - include Binable.Of_binable(Oid)(struct + include Binable.Of_binable_without_uuid(Oid)(struct type t = a obj let to_binable = Fn.id let of_binable = Fn.id @@ -2714,7 +2714,7 @@ module Knowledge = struct slot : Name.t; repr : string; error : Conflict.t; - trace : Caml.Printexc.raw_backtrace; + trace : Stdlib.Printexc.raw_backtrace; } let () = Conflict.register_printer (function @@ -2724,7 +2724,7 @@ module Knowledge = struct "Unable to update the slot %a of %s,\n%a\n\ Backtrace:\n%s" Name.pp slot repr Conflict.pp error - (Caml.Printexc.raw_backtrace_to_string trace) + (Stdlib.Printexc.raw_backtrace_to_string trace) | _ -> None) @@ -2755,7 +2755,7 @@ module Knowledge = struct | Error err -> raise (Record.Merge_conflict err))}} with Record.Merge_conflict err -> non_monotonic slot obj err @@ - Caml.Printexc.get_raw_backtrace () + Stdlib.Printexc.get_raw_backtrace () let notify {Slot.watchers} obj data = Hashtbl.data watchers |> @@ -2852,7 +2852,7 @@ module Knowledge = struct fun slot obj -> objects slot.cls >>| fun {vals} -> match Oid.Tree.find_exn vals obj with - | exception Caml.Not_found -> Sleep + | exception Stdlib.Not_found -> Sleep | {data; comp=slots} -> match Map.find slots (uid slot) with | Some Work _ -> Awoke | other -> match other,Record.is_empty data with @@ -2933,7 +2933,7 @@ module Knowledge = struct fun slot id -> objects slot.cls >>| fun {Env.vals} -> match Oid.Tree.find_exn vals id with - | exception Caml.Not_found -> slot.dom.empty + | exception Stdlib.Not_found -> slot.dom.empty | {data} -> Record.get slot.key slot.dom data let rec collect_inner @@ -3213,7 +3213,7 @@ module Knowledge = struct compute_value cls obj >>= fun () -> objects cls >>| fun {Env.vals} -> match Oid.Tree.find_exn vals obj with - | exception Caml.Not_found -> Value.empty cls + | exception Stdlib.Not_found -> Value.empty cls | {data=x} -> Value.create cls x let run cls obj s = (obj >>= get_value cls).run s @@ -3368,7 +3368,7 @@ module Knowledge = struct } let of_canonical_v1 {payload} = - let init = Map.empty (module Name) in + let init = (Map.empty (module Name)) in let classes = List.fold payload ~init ~f:(fun state (cid,objs) -> Map.add_exn state ~key:cid @@ -3377,7 +3377,7 @@ module Knowledge = struct init_last {empty with classes} let of_canonical_v2 {payload} = - let init = Map.empty (module Name) in + let init = (Map.empty (module Name)) in let classes = List.fold payload ~init ~f:(fun state (cid,(last,objs)) -> let init = { diff --git a/lib/knowledge/bap_knowledge.mli b/lib/knowledge/bap_knowledge.mli index 175edb549..15d31efca 100644 --- a/lib/knowledge/bap_knowledge.mli +++ b/lib/knowledge/bap_knowledge.mli @@ -1471,7 +1471,7 @@ module Knowledge : sig return the least upper bound of [x] and [y], if it exists. *) val mapping : - ('a,'e) Map.comparator -> + (module Comparator.S with type t = 'a and type comparator_witness = 'e) -> ?inspect:('d -> Base.Sexp.t) -> ?join:('d -> 'd -> ('d, conflict) result) -> equal:('d -> 'd -> bool) -> @@ -1485,7 +1485,7 @@ module Knowledge : sig operator is the set union, and the order operator is the [is_subset] function. *) - val powerset : ('a,'e) Set.comparator -> + val powerset : (module Comparator.S with type t = 'a and type comparator_witness = 'e) -> ?inspect:('a -> Sexp.t) -> string -> ('a,'e) Set.t domain @@ -1595,11 +1595,11 @@ module Knowledge : sig val array : 'a persistent -> 'a array persistent (** [set order t] derives persistent for a set. *) - val set : ('a,'c) Set.comparator -> 'a t -> ('a,'c) Set.t persistent + val set : (module Comparator.S with type t = 'a and type comparator_witness = 'c) -> 'a t -> ('a,'c) Set.t persistent (** [map order t] derives persistent for a map. *) - val map : ('k,'c) Map.comparator -> 'k t -> 'd t -> ('k,'d,'c) Map.t persistent + val map : (module Comparator.S with type t = 'k and type comparator_witness = 'c) -> 'k t -> 'd t -> ('k,'d,'c) Map.t persistent end (** Conflicting information. diff --git a/lib/microx/microx_conqueror.ml b/lib/microx/microx_conqueror.ml index 8bfd00a1d..622a8ab5f 100644 --- a/lib/microx/microx_conqueror.ml +++ b/lib/microx/microx_conqueror.ml @@ -13,7 +13,7 @@ let visit vis tid = Map.change vis tid ~f:(function | Some n -> Some (n+1)) let create_mapping prog = - let addrs = Addr.Table.create () in + let addrs = Hashtbl.create (module Addr) in let add t a = Hashtbl.set addrs ~key:a ~data:(Term.tid t) in Term.enum sub_t prog |> Seq.iter ~f:(fun sub -> Term.enum blk_t sub |> Seq.iter ~f:(fun blk -> @@ -41,8 +41,8 @@ class context val blk : blk term option = None val callstack : sub term list = [] val steps_left = max_steps - val vis : int Tid.Map.t = Tid.Map.empty (* visited *) - val cps : 's Tid.Map.t Tid.Map.t = Tid.Map.empty + val vis : int Tid.Map.t = (Map.empty (module Tid)) (* visited *) + val cps : 's Tid.Map.t Tid.Map.t = (Map.empty (module Tid)) val rets : tid list = [] method visited = vis @@ -71,7 +71,7 @@ class context if Map.mem vis p then self else {< cps = Map.update cps key ~f:(function - | None -> Tid.Map.singleton p self + | None -> Map.singleton (module Tid) p self | Some ps -> Map.set ps p self) >} diff --git a/lib/monads/dune b/lib/monads/dune index 1977445b9..a5a66915e 100644 --- a/lib/monads/dune +++ b/lib/monads/dune @@ -3,5 +3,5 @@ (public_name monads) (wrapped false) (preprocess (pps ppx_bap)) - (libraries core_kernel core_kernel.rope) + (libraries core_kernel) (private_modules monads_monad monads_monoid monads_types)) diff --git a/lib/monads/monads_monad.ml b/lib/monads/monads_monad.ml index 79c72fe68..239d0af8b 100644 --- a/lib/monads/monads_monad.ml +++ b/lib/monads/monads_monad.ml @@ -651,7 +651,7 @@ module ResultT = struct module type S = sig include S - val failf : ('a, Caml.Format.formatter, unit, unit -> 'b t) format4 -> 'a + val failf : ('a, Stdlib.Format.formatter, unit, unit -> 'b t) format4 -> 'a end module Make(M : Monad.S) : S with type 'a t := 'a T(M).t @@ -662,7 +662,7 @@ module ResultT = struct include Make(struct type t = Error.t end)(M) let failf fmt = - let open Caml.Format in + let open Stdlib.Format in let buf = Buffer.create 512 in let ppf = formatter_of_buffer buf in let kon ppf () = @@ -1175,9 +1175,9 @@ module State = struct init = ctxt; created = global; current = global; - parents = Id.Map.empty; - children = Id.Map.empty; - forks = Id.Map.empty; + parents = (Map.empty (module Id)); + children = (Map.empty (module Id)); + forks = (Map.empty (module Id)); } let rec alive_parent k child = @@ -1204,7 +1204,7 @@ module State = struct let siblings () = SM.gets (fun k -> match Map.find k.children (alive_parent k k.current) with - | None -> Id.Set.empty + | None -> (Set.empty (module Id)) | Some cs -> Set.filter cs ~f:(Map.mem k.forks)) let context k = @@ -1237,7 +1237,7 @@ module State = struct let remove_dead_parents k = let parents = - Map.fold k.forks ~init:Id.Map.empty ~f:(fun ~key ~data:_ ps -> + Map.fold k.forks ~init:(Map.empty (module Id)) ~f:(fun ~key ~data:_ ps -> Map.set ps ~key ~data:(alive_parent k key)) in let children = Map.filter_keys k.children ~f:(Map.mem parents) in {k with children; parents} diff --git a/lib/monads/monads_monad.mli b/lib/monads/monads_monad.mli index fd5dd18ac..dea43da6a 100644 --- a/lib/monads/monads_monad.mli +++ b/lib/monads/monads_monad.mli @@ -99,7 +99,7 @@ module Result : sig module Error : sig module type S = sig include S - val failf : ('a, Caml.Format.formatter, unit, unit -> 'b t) format4 -> 'a + val failf : ('a, Stdlib.Format.formatter, unit, unit -> 'b t) format4 -> 'a end @@ -313,7 +313,7 @@ module State : sig include Identifiable.S with type t = id val zero : t val succ : t -> t - val pp : Caml.Format.formatter -> id -> unit + val pp : Stdlib.Format.formatter -> id -> unit end module T1(T : T)(M : Monad) : sig diff --git a/lib/monads/monads_monoid.ml b/lib/monads/monads_monoid.ml index 5af2545af..d01d3d926 100644 --- a/lib/monads/monads_monoid.ml +++ b/lib/monads/monads_monoid.ml @@ -42,14 +42,18 @@ module String = struct val run : t -> string end = struct module Base = struct - type t = Rope.t - let zero = Rope.of_string "" - let plus = Rope.(^) + type t = Buffer.t + let zero = Buffer.create 16 + let plus a b = + let c = Buffer.create (Buffer.length a + Buffer.length b) in + Buffer.add_buffer c a; + Buffer.add_buffer c b; + c end include Base include Make(Base) - let add t x = Rope.(t ^ of_string x) - let run = Rope.to_string + let add t x = Buffer.add_string t x; t + let run = Buffer.contents end type t = string diff --git a/lib/ogre/ogre.ml b/lib/ogre/ogre.ml index f6847ff8a..7b8e0a0af 100644 --- a/lib/ogre/ogre.ml +++ b/lib/ogre/ogre.ml @@ -87,7 +87,7 @@ module Type = struct fields = Map.set fields ~key:name ~data:(t.pack x) } - let empty = {fields = String.Map.empty} + let empty = {fields = (Map.empty (module String))} let scheme field = { signature = [{fname = field.name; ftype = field.t.typ}]; @@ -179,8 +179,8 @@ module Doc = struct } [@@deriving bin_io, compare] let empty = { - scheme = String.Map.empty; - entries = String.Map.empty; + scheme = (Map.empty (module String)); + entries = (Map.empty (module String)); } let is_empty {scheme}= Map.is_empty scheme @@ -189,7 +189,7 @@ module Doc = struct let declarations {scheme} = Map.length scheme let definitions {entries} = Map.length entries - let clear doc = {doc with entries = String.Map.empty} + let clear doc = {doc with entries = (Map.empty (module String))} let update_scheme name sign doc = match Map.find doc.scheme name with @@ -319,7 +319,7 @@ module Doc = struct Error.List.map (tabulate values) ~f:(function | pos, `Positional x -> positional header pos x | _, `Named (fnam,x) -> named header fnam x) >>= - String.Map.of_alist_or_error + Map.of_alist_or_error (module String) let parse_entry doc = function | Sexp.List (Sexp.Atom "declare" :: Sexp.Atom name :: flds) -> @@ -649,7 +649,7 @@ module Exp = struct | Var n -> sub n let offsets names = - List.foldi names ~init:String.Map.empty ~f:(fun pos offs name -> + List.foldi names ~init:(Map.empty (module String)) ~f:(fun pos offs name -> Map.set offs ~key:name ~data:pos) let names_index names = @@ -673,8 +673,9 @@ module Exp = struct Var {attr=x;field={Type.fname=n1}}, Var {attr=y;field={Type.fname=n2}}) -> Var (fun row -> - bool String.(Map.find_exn row.(x).fields n1 = - Map.find_exn row.(y).fields n2)) + bool (let v1 = Base.Map.find_exn row.(x).fields n1 in + let v2 = Base.Map.find_exn row.(y).fields n2 in + String.equal v1 v2)) | Bop (op,x,y) -> Bop (op,lambda x, lambda y) | Uop (op,x) -> Uop(op,lambda x) | Var n -> Var (get_indiced n) diff --git a/lib/regular/regular.mli b/lib/regular/regular.mli index ad8a888b6..6188ffd53 100644 --- a/lib/regular/regular.mli +++ b/lib/regular/regular.mli @@ -818,6 +818,8 @@ module Std : sig type t include Comparable.S with type t := t include Hashable.S with type t := t + val sexp_of_t : t -> Sexp.t + val t_of_sexp : Sexp.t -> t end (** creates a module implementing [Opaque] interface. *) diff --git a/lib/regular/regular_bytes.ml b/lib/regular/regular_bytes.ml index ec3f41882..627c34efa 100644 --- a/lib/regular/regular_bytes.ml +++ b/lib/regular/regular_bytes.ml @@ -2,7 +2,7 @@ module Std_bytes = Bytes open Core_kernel[@@warning "-D"] -module Binable = Bin_prot.Utils.Make_binable(struct +module Binable = Bin_prot.Utils.Make_binable_without_uuid(struct module Binable = String type t = Std_bytes.t let to_binable = Std_bytes.unsafe_to_string diff --git a/lib/regular/regular_cache.ml b/lib/regular/regular_cache.ml index e5dc7e5c8..b3c404536 100644 --- a/lib/regular/regular_cache.ml +++ b/lib/regular/regular_cache.ml @@ -47,7 +47,7 @@ module Digest = struct let add buf fmt = format ("%s"^^fmt) buf let add_sexp d sexp_of x = add d "%a" Sexp.pp (sexp_of x) - let add_file d name = add d "%s" (Caml.Digest.(file name |> to_hex)) + let add_file d name = add d "%s" (Stdlib.Digest.(file name |> to_hex)) let create ~namespace = make namespace end diff --git a/lib/regular/regular_data.ml b/lib/regular/regular_data.ml index a16db082a..623c9825c 100644 --- a/lib/regular/regular_data.ml +++ b/lib/regular/regular_data.ml @@ -54,19 +54,15 @@ let pretty_writer (type t) (module T : Pretty_printer.S with type t = t) = Write.create ~pp:T.pp () -module Ver = Comparable.Make(struct - type t = string [@@deriving sexp] - let sep = '.' - type strings = string list [@@deriving compare] - let compare x y = - let x = String.split ~on:sep x in - let y = String.split ~on:sep y in - compare_strings x y - end) - +module Ver = String module Id = String -type 'a table = 'a Ver.Map.t Id.Map.t +type 'a with_desc = { + cls : 'a; + desc : string option; +} + +type 'a table = (String.t, (String.t, 'a with_desc, String.comparator_witness) Map.t, String.comparator_witness) Map.t type 'a with_info = { serializer : 'a; @@ -75,10 +71,6 @@ type 'a with_info = { desc : string option; } -type 'a with_desc = { - cls : 'a; - desc : string option; -} type 'a definition = { @@ -86,8 +78,8 @@ type 'a definition = { default_printer : 'a writer with_info option; default_reader : 'a reader with_info; default_writer : 'a writer with_info; - writers : 'a writer with_desc table; - readers : 'a reader with_desc table; + writers : 'a writer table; + readers : 'a reader table; } @@ -132,16 +124,16 @@ module Class = struct let add_method field cls ?desc ~ver name met : unit = update field cls ~f:(fun mets -> Map.change mets name ~f:(function - | None -> Some (Ver.Map.singleton ver {cls=met; desc}) - | Some vs -> Some (Ver.Map.set vs ver {cls=met; desc}))) + | None -> Some (Map.singleton (module String) ver {cls=met; desc}) + | Some vs -> Some (Map.set vs ~key:ver ~data:{cls=met; desc}))) - let find_with_ver (table : 'a table) ?ver name : (string * 'a) option = - match Map.find table name with + let find_with_ver (table : 'a table) ?ver name = + match Base.Map.find table name with | None -> None | Some vs -> match ver with - | Some ver -> Option.(Map.find vs ver >>| fun x -> ver,x) - | None -> Map.max_elt vs + | Some ver -> Option.(Base.Map.find vs ver >>| fun x -> ver,x) + | None -> Base.Map.max_elt vs let find_with_info from ?ver name = match find_with_ver from ?ver name with @@ -151,7 +143,7 @@ module Class = struct desc; } - let find (table : 'a table) ?ver name : 'a option = + let find (table : 'a table) ?ver name = Option.(find_with_ver table ?ver name >>| snd) let find_info (table : 'a table) ?ver name = @@ -202,18 +194,19 @@ module Class = struct let writers cls = get writer_field cls let readers cls = get reader_field cls + type collector = { + collect : 'a. 'a definition -> string * info list + } + + let collect_info (get,_) def = let name = match def.module_name with | None -> "unknown" | Some name -> name in name, - Map.fold (get def) ~init:[] ~f:(fun ~key:name ~data:vers acc -> - Map.fold vers ~init:acc ~f:(fun ~key:ver ~data:{desc} acc -> - (name, `Ver ver, desc) :: acc)) - - type collector = { - collect : 'a. 'a definition -> string * info list - } + List.fold (Base.Map.to_alist (get def)) ~init:[] ~f:(fun acc (fname,vers) -> + Base.Map.fold vers ~init:acc ~f:(fun ~key:ver ~data:(vd : _ with_desc) acc -> + (fname, `Ver ver, vd.desc) :: acc)) let writers_collector = { collect = fun def -> collect_info writer_field def @@ -268,8 +261,8 @@ module New(T : Versioned.S) : Instance with type t = T.t = struct default_printer = None; default_writer; default_reader; - writers = Id.Map.empty; - readers = Id.Map.empty; + writers = (Map.empty (module Id)); + readers = (Map.empty (module Id)); } end @@ -291,9 +284,9 @@ module Extend(T : sig let find_writer = Class.get_method writer_field cls let enum_info (table : 'a table) : info list = - Map.fold table ~init:[] ~f:(fun ~key:name ~data:vers acc -> - Map.fold vers ~init:acc ~f:(fun ~key:ver ~data:{desc} acc -> - (name, `Ver ver, desc) :: acc)) + List.fold (Base.Map.to_alist table) ~init:[] ~f:(fun acc (_name,vers) -> + Base.Map.fold vers ~init:acc ~f:(fun ~key:ver ~data:vd acc -> + (_name, `Ver ver, vd.desc) :: acc)) let available_readers () = enum_info (Class.readers cls) let available_writers () = enum_info (Class.writers cls) diff --git a/lib/regular/regular_opaque.ml b/lib/regular/regular_opaque.ml index 5dcedd07e..21e9ecb69 100644 --- a/lib/regular/regular_opaque.ml +++ b/lib/regular/regular_opaque.ml @@ -7,6 +7,8 @@ module type S = sig type t include Comparable with type t := t include Hashable with type t := t + val sexp_of_t : t -> Sexp.t + val t_of_sexp : Sexp.t -> t end module Make(M : sig @@ -20,4 +22,6 @@ module Make(M : sig end include Comparable.Make(M) include Hashable.Make_and_derive_hash_fold_t(M) + let sexp_of_t = M.sexp_of_t + let t_of_sexp = M.t_of_sexp end diff --git a/lib/regular/regular_seq.ml b/lib/regular/regular_seq.ml index 4baa168ad..4212b84ed 100644 --- a/lib/regular/regular_seq.ml +++ b/lib/regular/regular_seq.ml @@ -35,7 +35,7 @@ let compare compare_a t1 t2 = then r.return c); 0) -module Binable = Bin_prot.Utils.Make_binable1(struct +module Binable = Bin_prot.Utils.Make_binable1_without_uuid(struct module Binable = List type 'a t = 'a Sequence.t let to_binable = Sequence.to_list diff --git a/lib/text_tags/text_tags.ml b/lib/text_tags/text_tags.ml index 3abc4a8db..c5c224db3 100644 --- a/lib/text_tags/text_tags.ml +++ b/lib/text_tags/text_tags.ml @@ -41,11 +41,11 @@ module Html = struct let install fmt = pp_set_mark_tags fmt true; pp_set_print_tags fmt true; - pp_set_formatter_tag_functions fmt { - mark_open_tag; - mark_close_tag; - print_open_tag = print_open_tag fmt; - print_close_tag = print_close_tag fmt; + pp_set_formatter_stag_functions fmt { + mark_open_stag = (function String_tag s -> mark_open_tag s | _ -> ""); + mark_close_stag = (function String_tag s -> mark_close_tag s | _ -> ""); + print_open_stag = (fun stag -> print_open_tag fmt (match stag with String_tag s -> s | _ -> "")); + print_close_stag = (fun stag -> print_close_tag fmt (match stag with String_tag s -> s | _ -> "")); } [@@warning "-D"] end @@ -91,11 +91,11 @@ module Blocks = struct let install fmt = pp_set_mark_tags fmt true; pp_set_print_tags fmt true; - pp_set_formatter_tag_functions fmt { - mark_open_tag; - mark_close_tag; - print_open_tag = print_open_tag fmt; - print_close_tag = print_close_tag fmt; + pp_set_formatter_stag_functions fmt { + mark_open_stag = (function String_tag s -> mark_open_tag s | _ -> ""); + mark_close_stag = (function String_tag s -> mark_close_tag s | _ -> ""); + print_open_stag = (fun stag -> print_open_tag fmt (match stag with String_tag s -> s | _ -> "")); + print_close_stag = (fun stag -> print_close_tag fmt (match stag with String_tag s -> s | _ -> "")); } [@@warning "-D"] end @@ -148,10 +148,10 @@ module Attr = struct let install ppf = pp_set_print_tags ppf true; - let tags = pp_get_formatter_tag_functions ppf () in - pp_set_formatter_tag_functions ppf { + let tags = pp_get_formatter_stag_functions ppf () in + pp_set_formatter_stag_functions ppf { tags with - print_open_tag = print_open_tag ppf; + print_open_stag = (fun stag -> print_open_tag ppf (match stag with String_tag s -> s | _ -> "")); }; let out = pp_get_formatter_out_functions ppf () in pp_set_formatter_out_functions ppf { @@ -183,13 +183,13 @@ let install fmt mode = | None -> raise (Unknown_mode mode) let with_mode fmt mode = - let g = pp_get_formatter_tag_functions fmt () in + let g = pp_get_formatter_stag_functions fmt () in let mark = pp_get_mark_tags fmt () in let print = pp_get_print_tags fmt () in let finally () = pp_set_mark_tags fmt mark; pp_set_print_tags fmt print; - pp_set_formatter_tag_functions fmt g in + pp_set_formatter_stag_functions fmt g in install fmt mode; Exn.protect ~finally [@@warning "-D"] diff --git a/lib/x86_cpu/x86_cpu.ml b/lib/x86_cpu/x86_cpu.ml index 3a56d9ff6..f2b54d8f5 100644 --- a/lib/x86_cpu/x86_cpu.ml +++ b/lib/x86_cpu/x86_cpu.ml @@ -7,13 +7,13 @@ module Make_CPU(Env : ModeVars) = struct include X86_env include Env (* we do not include pc into a set of gpr *) - let gpr = Var.Set.of_list @@ [ + let gpr = Set.of_list (module Var) @@ [ rax; rcx; rdx; rsi; rdi; rbx; rbp; rsp; ] @ Array.to_list r @ Array.to_list ymms - let flags = Var.Set.of_list [ + let flags = Set.of_list (module Var) [ cf; pf; af; zf; sf; oF; df ] diff --git a/lib/x86_cpu/x86_target.ml b/lib/x86_cpu/x86_target.ml index a6cfdd36c..86b9a3867 100644 --- a/lib/x86_cpu/x86_target.ml +++ b/lib/x86_cpu/x86_target.ml @@ -151,10 +151,16 @@ module M16 = struct [status], untyped [cf; pf; af; zf; sf; of_]; [control], untyped [tf; if_; df; md]; [integer], untyped [cf; pf; af; zf; sf; of_]; - [system], untyped [iopll; ioplh; rf; vm; ac; vif; vip; id; aes; ai] + [system], untyped [iopll; ioplh; rf; vm; ac; vif; vip; id; aes; ai]; + (* AF has no core-theory role. *) + [carry_flag], untyped [cf]; + [parity_flag], untyped [pf]; + [zero_flag], untyped [zf]; + [sign_flag], untyped [sf]; + [overflow_flag], untyped [of_] ] - let aliases = hregs @< lregs @< [iopl] @< [eflags] + let aliases = hregs @< lregs @< index8 @< [iopl] @< [eflags] let regs = Theory.Role.Register.[ [general; integer], main @< index @< segment; @@ -258,41 +264,65 @@ module M64 = struct reg r16 "DS"; reg r16 "ES"; reg r16 "SS"; + reg r16 "FS"; + reg r16 "GS"; ] let rx = array r64 "R" 8 ~index:(fun i -> string_of_int (i+8)) + (* The APX extended GPRs R16..R31. *) + let egpr = array r64 "R" 16 + ~index:(fun i -> string_of_int (i+16)) + + let rx_sub ?(first=8) ?(size=8) t suffix = array t "R" size + ~index:(fun i -> string_of_int (i+first) ^ suffix) + let rxd = rx_sub r32 "D" + let rxw = rx_sub r16 "W" + let rxb = rx_sub r8 "B" + let egprd = rx_sub ~first:16 ~size:16 r32 "D" + let egprw = rx_sub ~first:16 ~size:16 r16 "W" + let egprb = rx_sub ~first:16 ~size:16 r8 "B" + let stx = M32.stx let mmx = M32.mmx - let xmmx = array r128 "XMM" 16 - let ymmx = array r256 "YMM" 16 + (* The EVEX-only vector registers 16..31, in the 256-bit model. *) + let xmmx = array r128 "XMM" 32 + let ymmx = array r256 "YMM" 32 let mxsr = reg r32 "MXCSR" + let fpcw = reg r16 "FPU_CONTROL" let flags = M32.flags let rflags = reg r64 "RFLAGS" let mems = Theory.Mem.define r64 r8 let data = Theory.Var.define mems "mem" - let aliases = M32.aliases @< M32.main @< M32.index @< xmmx + let aliases = M32.aliases @< M32.main @< M32.index @< + rxd @< rxw @< rxb @< egprd @< egprw @< egprb @< xmmx - let vars = main @< index @< segment @< rx @< stx @< mmx @< ymmx @< - flags @< [data] @< [mxsr] + let vars = main @< index @< segment @< rx @< egpr @< stx @< mmx @< ymmx @< + flags @< [data] @< [mxsr] @< [fpcw] let regs = Theory.Role.Register.[ - [general; integer], main @< index @< segment @< rx; + [general; integer], main @< index @< segment @< rx @< egpr; [general; floating], stx @< mmx @< ymmx; [stack_pointer], untyped [reg r64 "RSP"]; [frame_pointer], untyped [reg r64 "RBP"]; [Role.index], untyped index; [Role.segment], untyped segment; - [status], untyped [mxsr]; + [status], untyped [mxsr] @ untyped [fpcw]; [alias], aliases; ] @ M16.flag_roles let aliasing = M32.aliasing @ lo_bits_of main are M32.main @ lo_bits_of index are M32.index @ + lo_bits_of rx are rxd @ + lo_bits_of rxd are rxw @ + lo_bits_of rxw are rxb @ + lo_bits_of egpr are egprd @ + lo_bits_of egprd are egprw @ + lo_bits_of egprw are egprb @ lo_bits_of ymmx are xmmx @ lo_bits_of [rflags] are [M16.eflags] end diff --git a/lib/x86_cpu/x86_types.ml b/lib/x86_cpu/x86_types.ml index d304bb6a2..14c5cffaa 100644 --- a/lib/x86_cpu/x86_types.ml +++ b/lib/x86_cpu/x86_types.ml @@ -16,6 +16,7 @@ type operand = | Ovec of int | Oseg of int | Oaddr of Exp.t + | Oaddr_rip_relative of Exp.t | Oimm of addr [@@deriving compare] @@ -105,7 +106,7 @@ type opcode = | Movdq of typ * operand * typ * operand * bool (** dst type, dst op, src type, src op, aligned *) | Movoffset of (typ * operand) * offsetinfo list (** dest type, dest, (src copy length, src type, src, src src offset, src dest offset)* *) - | Lea of typ * operand * Exp.t + | Lea of typ * operand * Exp.t * bool | Call of operand * addr (** addr is RA *) | Shift of binop * typ * operand * operand | Shiftd of binop * typ * operand * operand * operand diff --git a/lib_test/bap/run_tests.ml b/lib_test/bap/run_tests.ml index 3302b9e12..2419234c5 100644 --- a/lib_test/bap/run_tests.ml +++ b/lib_test/bap/run_tests.ml @@ -1,9 +1,9 @@ -open Core_kernel[@@warning "-D"] +open Core[@@warning "-D"] open Bap_plugins.Std open OUnit2 -module Sys = Caml.Sys +module Sys = Stdlib.Sys let suite () = "BAP" >::: [ diff --git a/lib_test/bap_image/test_image.ml b/lib_test/bap_image/test_image.ml index 513eee9bc..76196fa1f 100644 --- a/lib_test/bap_image/test_image.ml +++ b/lib_test/bap_image/test_image.ml @@ -30,7 +30,7 @@ let create_segment let create_file () = Bytes.create 0x1000 -let files : Bytes.t String.Table.t = String.Table.create () +let files : Bytes.t String.Table.t = Hashtbl.create (module String) let data ?(base=0) ?(gap=0) f ss asize name = @@ -39,7 +39,7 @@ let data ?(base=0) ?(gap=0) f ss asize name = let data = f data in let addr = !addr_ref in let len = Bytes.length data in - let dst = String.Table.find_or_add files name + let dst = Hashtbl.find_or_add files name ~default:create_file in let off = addr - base in Bytes.blit @@ -99,7 +99,7 @@ let print_list r = Or_error.sexp_of_t sexp_of_addr_list r let to_list ~word_size backend ~expect ctxt = - let data = String.Table.find_exn files backend |> Bytes.to_string in + let data = Hashtbl.find_exn files backend |> Bytes.to_string in let r = Image.of_string ~backend data >>| fun (img,warns) -> assert_bool "to_list: no warning" (List.is_empty warns); Table.to_sequence (Image.words img word_size) |> @@ -109,7 +109,7 @@ let to_list ~word_size backend ~expect ctxt = assert_equal ~ctxt ~printer:print_list (Ok expect) r let check ?(base=0) backend ~f ctxt = - let data = String.Table.find_exn files backend in + let data = Hashtbl.find_exn files backend in let data = Bytes.to_string data in let r = Image.of_string ~backend data >>= fun (img,warns) -> diff --git a/lib_test/bap_types/test_graph.ml b/lib_test/bap_types/test_graph.ml index 6f37d78c0..a9c9d8d73 100644 --- a/lib_test/bap_types/test_graph.ml +++ b/lib_test/bap_types/test_graph.ml @@ -54,7 +54,7 @@ module Test_algo(Gl : Graph_for_algo) = struct Note: time is incremented by any of the following events: enter_node, leave_node. Edges events are ignored. *) let timestamps ty gr : int * ('n,node_info,_) Map.t = - Graphlib.depth_first_search ty gr ~init:(0,Node.Map.empty) + Graphlib.depth_first_search ty gr ~init:(0,Map.empty (module Node)) ~enter_node:(fun pre node (time,stamps) -> time + 1, Map.change stamps node ~f:(function | None -> Some {empty with pre; enter = time} @@ -74,13 +74,13 @@ module Test_algo(Gl : Graph_for_algo) = struct } let empty = { - children = Node.Map.empty; - iparents = Node.Map.empty; + children = (Map.empty (module Node)); + iparents = (Map.empty (module Node)); } let add_relation t ~parent ~child = { children = Map.change t.children parent( function - | None -> Some (Node.Set.singleton child) + | None -> Some (Set.singleton (module Node) child) | Some cs when Set.mem cs child -> assert_failure "Child was already adopted" | Some cs -> Some (Set.add cs child)); @@ -90,7 +90,7 @@ module Test_algo(Gl : Graph_for_algo) = struct } let children t parent = match Map.find t.children parent with - | None -> Node.Set.empty + | None -> (Set.empty (module Node)) | Some children -> children let parent t child = Map.find t.iparents child @@ -99,7 +99,7 @@ module Test_algo(Gl : Graph_for_algo) = struct (transitive closure) *) let rec descendants t parent = (* according to [1] each node is descendant of itself. *) - let init = Node.Set.singleton parent in + let init = Set.singleton (module Node) parent in Set.fold (children t parent) ~init ~f:(fun ds parent -> Set.union ds (descendants t parent)) @@ -108,7 +108,7 @@ module Test_algo(Gl : Graph_for_algo) = struct let rec loop parents child = match parent t child with | None -> parents | Some parent -> loop (Set.add parents parent) parent in - loop Node.Set.empty child + loop (Set.empty (module Node)) child end let build_tree g = @@ -222,9 +222,9 @@ module Test_algo(Gl : Graph_for_algo) = struct Seq.to_list_rev in Seq.range 0 (Gl.number_of_nodes gr) |> Seq.map ~f:node |> Seq.iter ~f:(fun n -> - let exp = Node.Set.of_list (exp_dfrt n) in - let got = Node.Set.of_list (set_of_frontier n) in - assert_equal ~ctxt ~cmp:Node.Set.equal exp got) + let exp = Set.of_list (module Node) (exp_dfrt n) in + let got = Set.of_list (module Node) (set_of_frontier n) in + assert_equal ~ctxt ~cmp:Set.equal exp got) let compare_scc gr ctxt = let scc = Graphlib.strong_components (module Gl) gr in @@ -248,10 +248,10 @@ module Test_algo(Gl : Graph_for_algo) = struct ]) let nodes g = - Gl.nodes g |> Seq.fold ~init:Gl.Node.Set.empty ~f:Set.add + Gl.nodes g |> Seq.fold ~init:(Set.empty (module Gl.Node)) ~f:(fun s x -> Set.add s x) let edges g = - Gl.edges g |> Seq.fold ~init:Gl.Edge.Set.empty ~f:Set.add + Gl.edges g |> Seq.fold ~init:(Set.empty (module Gl.Edge)) ~f:(fun s x -> Set.add s x) let equal_sets s1 s2 ctxt = assert_equal ~ctxt ~cmp:Set.equal s1 s2 @@ -310,7 +310,7 @@ module Construction(Factory : Factory) = struct and type Edge.label = unit) g = G.edges g |> Seq.map ~f:(fun e -> G.Edge.src e, G.Edge.dst e, G.Edge.src e) |> - Seq.fold ~init:Edges.empty ~f:Set.add + Seq.fold ~init:Edges.empty ~f:(fun s x -> Set.add s x) let compare e g : int = let ees = make_edges (module E) e in @@ -319,7 +319,7 @@ module Construction(Factory : Factory) = struct | 0 -> 0 | n -> let set enum g = - enum g |> Seq.fold ~init:Nodes.empty ~f:Set.add in + enum g |> Seq.fold ~init:Nodes.empty ~f:(fun s x -> Set.add s x) in Nodes.compare (set E.nodes e) (set G.nodes g) let random_elt number enum e = @@ -570,7 +570,7 @@ module Test_partition = struct let add x s = Set.add s x - let s = Set.empty (module Int) + let s = (Set.empty (module Int)) |> add 0 |> add 1 |> add 2 diff --git a/lib_test/powerpc/powerpc_move_tests.ml b/lib_test/powerpc/powerpc_move_tests.ml index b6cf12dc3..479f2d182 100644 --- a/lib_test/powerpc/powerpc_move_tests.ml +++ b/lib_test/powerpc/powerpc_move_tests.ml @@ -61,7 +61,7 @@ let mtcrf arch _ctxt = j*4 <= i && i < (j + 1) * 4) then let expected = if r1_bits.(i) then Word.b1 else Word.b0 in - let cr_bit = Int.Map.find_exn cri i in + let cr_bit = Map.find_exn cri i in let value = lookup_var ctxt cr_bit in let err = sprintf "mtcrf assign to bit %d failed\n" i in assert_bool err (is_equal_words expected value)) diff --git a/lib_test/powerpc/powerpc_tests_helpers.ml b/lib_test/powerpc/powerpc_tests_helpers.ml index 0c048672c..ecda2962c 100644 --- a/lib_test/powerpc/powerpc_tests_helpers.ml +++ b/lib_test/powerpc/powerpc_tests_helpers.ml @@ -16,7 +16,7 @@ let make_name prefix i = sprintf "%s%d" prefix i let make_var_i typ prefix i = Var.create (make_name prefix i) typ let make_regs typ ?alias prefix range = - List.fold ~init:String.Map.empty ~f:(fun regs i -> + List.fold ~init:(Map.empty (module String)) ~f:(fun regs i -> let var = make_var_i typ prefix i in let name = Var.name var in let regs = Map.set regs name var in @@ -78,13 +78,13 @@ module Make(B : Bitwidth) = struct let cri = let _, bits = - List.fold (List.rev cr_bits) ~init:(0,Int.Map.empty) + List.fold (List.rev cr_bits) ~init:(0,Map.empty (module Int)) ~f:(fun (num, bits) bit -> num + 1, Map.set bits ~key:num ~data:bit) in bits let crn = - Int.Map.fold cri ~init:String.Map.empty + Map.fold cri ~init:(Map.empty (module String)) ~f:(fun ~key:_ ~data:var acc -> Map.set acc (Var.name var) var) @@ -100,11 +100,11 @@ module Make(B : Bitwidth) = struct ] let cr_fields = - List.fold fields ~init:String.Map.empty ~f:(fun fs (name, _, fd) -> + List.fold fields ~init:(Map.empty (module String)) ~f:(fun fs (name, _, fd) -> Map.set fs name fd) let cri_fields = - List.fold fields ~init:Int.Map.empty ~f:(fun fs (_, index, fd) -> + List.fold fields ~init:(Map.empty (module Int)) ~f:(fun fs (_, index, fd) -> Map.set fs index fd) (** fixed precision flags *) @@ -133,7 +133,7 @@ let raise_arch () = failwith "powerpc arch is the only expected" let cr_bit n = - Int.Map.find_exn Any_ppc.cri n + Map.find_exn Any_ppc.cri n let nf = cr_bit 0 let pf = cr_bit 1 @@ -219,8 +219,8 @@ let lookup_var c var = match c#lookup var with let find_gpr arch name = try match arch with - | `ppc -> String.Map.find_exn P32.gpr name - | _ -> String.Map.find_exn P64.gpr name + | `ppc -> Map.find_exn P32.gpr name + | _ -> Map.find_exn P64.gpr name with _ -> sprintf "gpr %s not" name |> failwith diff --git a/lib_test/x86/run_x86_tests.ml b/lib_test/x86/run_x86_tests.ml index 8034c5af1..f4084ac5b 100644 --- a/lib_test/x86/run_x86_tests.ml +++ b/lib_test/x86/run_x86_tests.ml @@ -3,6 +3,7 @@ open OUnit2 open Bap_plugins.Std let suite = "X86" >::: [ + Test_atomic.suite; Test_pshufb.suite; Test_pcmp.suite; ] diff --git a/lib_test/x86/test_atomic.ml b/lib_test/x86/test_atomic.ml new file mode 100644 index 000000000..87ee0f242 --- /dev/null +++ b/lib_test/x86/test_atomic.ml @@ -0,0 +1,78 @@ +open Core_kernel[@@warning "-D"] +open Bap.Std +open OUnit2 + +let lift arch bytes = + let memory = Or_error.ok_exn (Memory.create LittleEndian + (Word.of_int ~width:(match arch with `x86 -> 32 | _ -> 64) 0x1000) + (Bigstring.of_string bytes)) in + let memory,insn = Or_error.ok_exn + (Disasm_expert.Basic.with_disasm ~backend:"llvm" (Arch.to_string arch) + ~f:(fun dis -> match Disasm_expert.Basic.insn_of_mem dis memory with + | Ok (m,Some i,_) -> Ok (m,i) + | _ -> Or_error.error_string "atomic fixture did not decode")) in + let module Target = (val target_of_arch arch) in + Target.lift memory insn + +let calls bil = List.filter_map bil ~f:(Bil.decode Bil.intrinsic) + +let case name arch bytes target = name >:: fun _ -> + let bil = Or_error.ok_exn (lift arch bytes) in + assert_equal [target] (calls bil); + let before,after = List.split_while bil ~f:(fun s -> + Option.is_none (Bil.decode Bil.intrinsic s)) in + assert_bool "inputs precede the intrinsic" (List.length before >= 2); + assert_bool "captured lane identities survive BIL-to-BIR" + (List.exists before ~f:(function + | Bil.Move (v,_) -> not (Var.is_virtual v) + && String.is_prefix (Var.name v) ~prefix:"intrinsic:x86:atomic:" + | _ -> false)); + let memory = (object inherit [bool] Stmt.visitor + method! enter_load ~mem:_ ~addr:_ _ _ _ = true + method! enter_store ~mem:_ ~addr:_ ~exp:_ _ _ _ = true + end)#run bil false in + assert_bool "the intrinsic is the only memory effect" (not memory); + assert_bool "continuation contains result or flags" (not (List.is_empty after)) + +let captured name bytes role expected = name >:: fun _ -> + let bil = Or_error.ok_exn (lift `x86_64 bytes) in + let before = List.take_while bil ~f:(fun s -> + Option.is_none (Bil.decode Bil.intrinsic s)) in + let var = List.find_map_exn before ~f:(function + | Bil.Move (v,_) when String.is_prefix (Var.name v) + ~prefix:("intrinsic:x86:atomic:" ^ role ^ ":") -> Some v + | _ -> None) in + let state = Stmt.eval before (new Bili.context) in + match state#lookup var with + | Some result -> (match Bil.Result.value result with + | Bil.Imm word -> assert_bool "captured value" (Word.equal word expected) + | _ -> assert_failure "captured lane is not an immediate") + | None -> assert_failure "captured lane is absent" + +let suite = "atomic" >::: [ + case "add8" `x86_64 "\xf0\x00\x37" "x86:atomic_add_8"; + case "add16" `x86_64 "\xf0\x66\x01\x37" "x86:atomic_add_16"; + case "add32" `x86_64 "\xf0\x01\x37" "x86:atomic_add_32"; + case "add64" `x86_64 "\xf0\x48\x01\x37" "x86:atomic_add_64"; + case "ia32" `x86 "\xf0\x01\x37" "x86:atomic_add_32"; + case "implicit_xchg" `x86_64 "\x48\x87\x37" "x86:atomic_xchg_64"; + case "xadd" `x86_64 "\xf0\x48\x0f\xc1\x37" "x86:atomic_add_64"; + case "cmpxchg" `x86_64 "\xf0\x48\x0f\xb1\x37" "x86:atomic_cmpxchg_64"; + case "cmpxchg8b" `x86_64 "\xf0\x0f\xc7\x0f" "x86:atomic_cmpxchg_64"; + case "bts" `x86_64 "\xf0\x48\x0f\xba\x2f\x01" "x86:atomic_or_64"; + captured "neg_rip_has_no_immediate" "\xf0\x48\xf7\x1d\x00\x00\x00\x00" + "address" (Word.of_int ~width:64 0x1008); + captured "not_rip_has_no_immediate" "\xf0\x48\xf7\x15\x00\x00\x00\x00" + "address" (Word.of_int ~width:64 0x1008); + captured "signed_immediate" "\xf0\x48\x83\x07\xff" "input0" (Word.ones 64); + "plain_add" >:: (fun _ -> + assert_equal [] (calls (Or_error.ok_exn (lift `x86_64 "\x48\x01\x37")))); + "register_xchg" >:: (fun _ -> + assert_equal [] (calls (Or_error.ok_exn (lift `x86_64 "\x48\x87\xf7")))); + "unsupported_cmpxchg16b" >:: (fun _ -> + assert_bool "unsupported width is rejected" + (Result.is_error (lift `x86_64 "\xf0\x48\x0f\xc7\x0f"))); + "invalid_lock_register" >:: (fun _ -> + assert_bool "invalid LOCK form is rejected" + (Result.is_error (lift `x86_64 "\xf0\x48\x01\xf7"))); +] diff --git a/monads.opam b/monads.opam index 8e3c1e227..83e29cc65 100644 --- a/monads.opam +++ b/monads.opam @@ -10,9 +10,9 @@ tags: ["bap" "monad"] homepage: "https://github.com/BinaryAnalysisPlatform/bap" bug-reports: "https://github.com/BinaryAnalysisPlatform/bap/issues" depends: [ - "dune" {>= "3.1"} + "dune" {>= "3.8"} "bap-common" {= version} - "core_kernel" {>= "v0.14" & < "v0.16"} + "core_kernel" {>= "v0.17" & < "v0.18"} "ppx_bap" {= version} "odoc" {with-doc} ] diff --git a/nix/package.nix b/nix/package.nix new file mode 100644 index 000000000..5ae13b2a1 --- /dev/null +++ b/nix/package.nix @@ -0,0 +1,165 @@ +{ lib +, stdenv +, ocamlPackages +, dune_3 +, llvmPackages +, zlib +, gmp +, libffi +, openssl +, ncurses +, readline +, libxml2 +, sqlite +, z3 +, curl +, pcre +, pcre2 +, zstd +, pkg-config +, git +, src +}: + +let + llvm = llvmPackages.llvm; + + # The fork carries the OCaml libraries that Nixpkgs does not package + # (bitvec, graphlib, monads, ogre, regular, text-tags, ppx_bap) in its + # own workspace; everything else comes from Nixpkgs. + ocamlDeps = with ocamlPackages; [ + findlib + dune-site + dune-configurator + dune-private-libs + + base + stdio + core_kernel + bin_prot + sexplib + sexplib0 + parsexp + stdlib-shims + ocamlgraph + yojson + ezjsonm + + ppxlib + ppx_assert + ppx_bench + ppx_bin_prot + ppx_compare + ppx_cold + ppx_enumerate + ppx_expect + ppx_fields_conv + ppx_hash + ppx_here + ppx_inline_test + ppx_optcomp + ppx_sexp_conv + ppx_sexp_value + ppx_variants_conv + ppx_bitstring + bitstring + + cmdliner_1 + re + uri + uuidm + xmlm + zarith + z3 + camlzip + ocurl + linenoise + mmap + fileutils + ocamlbuild + frontc + ]; +in +stdenv.mkDerivation { + pname = "bap"; + version = "2.6.0-alpha"; + + inherit src; + + nativeBuildInputs = [ + ocamlPackages.ocaml + ocamlPackages.findlib + dune_3 + pkg-config + git + llvm.dev + ]; + + # The checked-in `configure` is the old oasis driver; dune generates + # config.status from config.status.in instead. + dontConfigure = true; + + buildInputs = ocamlDeps ++ [ + llvm.lib + z3 + pcre + zstd + ncurses + readline + gmp + zlib + openssl + libffi + curl + libxml2 + sqlite + ]; + + # BAP's configure is a dune rule over config.status.in. Writing the + # file in the source tree overrides the empty fallback and bakes the + # final store prefix into the installed configuration. + postPatch = '' + # BAP's LLVM configurator hardcodes the legacy -lcurses link name; + # Nixpkgs' ncurses only installs -lncurses. + substituteInPlace lib/bap_llvm/config/llvm_configurator.ml \ + --replace-fail '"-lcurses"' '"-lncurses"' + + # Dune expands the site pforms against its default install root + # (_build/install) on a plain build. Point the generated site + # tables at the final store prefix instead. + substituteInPlace plugins/primus_lisp/primus_lisp_config.ml.ab \ + --replace-fail '$'{site_lisp} "\"$out/share/bap-common/lisp\"" \ + --replace-fail '$'{site_site_lisp} "\"$out/share/bap-common/site_lisp\"" \ + --replace-fail '$'{site_semantics} "\"$out/share/bap-common/semantics\"" + substituteInPlace plugins/api/api_sites.ml.ab \ + --replace-fail '$'{site_api} "\"$out/share/bap-common/api\"" + + cat > config.status.in <= "3.1"} - "core_kernel" {>= "v0.14" & < "v0.16"} + "dune" {>= "3.8"} + "core_kernel" {>= "v0.17" & < "v0.18"} "bap-common" {= version} "monads" {= version} "odoc" {with-doc} diff --git a/plugins/analyze/analyze_main.ml b/plugins/analyze/analyze_main.ml index 2361f0385..244fcb9b8 100644 --- a/plugins/analyze/analyze_main.ml +++ b/plugins/analyze/analyze_main.ml @@ -50,7 +50,7 @@ open Core_kernel[@@warning "-D"] open Bap_main open Bap_knowledge open Bap.Std -module Sys = Caml.Sys +module Sys = Stdlib.Sys include Loggers() @@ -87,7 +87,7 @@ let initial_ctxt ~history directives path = { commands = collect_commands (); history; directives = List.fold directives - ~init:String.Map.empty + ~init:(Map.empty (module String)) ~f:(fun dirs (name,_,desc) -> Map.add_exn dirs name desc) } diff --git a/plugins/api/api_main.ml b/plugins/api/api_main.ml index c8dfec761..f03d58cc9 100644 --- a/plugins/api/api_main.ml +++ b/plugins/api/api_main.ml @@ -1,7 +1,7 @@ open Core_kernel[@@warning "-D"] open Result.Monad_infix open Bap.Std -module Sys = Caml.Sys +module Sys = Stdlib.Sys include Self() module Configuration = Bap_main.Extension.Configuration @@ -16,7 +16,7 @@ let try_with_default ~default f = match try_with f with let getenv v = try Some (Sys.getenv v) - with Caml.Not_found -> None + with Stdlib.Not_found -> None module Path = FilePath.DefaultPath.Abstract type path = Path.filename diff --git a/plugins/beagle/beagle_main.ml b/plugins/beagle/beagle_main.ml index 5d38179dc..ada90fb15 100644 --- a/plugins/beagle/beagle_main.ml +++ b/plugins/beagle/beagle_main.ml @@ -86,7 +86,7 @@ module Param = struct end let make_alphabet (module A : Alphabet) = - Seq.range 0 256 |> Seq.fold ~init:Char.Set.empty ~f:(fun alpha c -> + Seq.range 0 256 |> Seq.fold ~init:(Set.empty (module Char)) ~f:(fun alpha c -> let c = Char.of_int_exn c in let i = A.index c in if i < 0 || i >= A.length then alpha @@ -115,9 +115,9 @@ let hunters_club = ~uuid:"1fa35cfe-f720-473c-a5ac-50fa8fa9f1fd" ~name:"beagle-hunters-club" (fun _ -> { - addrs = Addr.Set.empty; - checked = Bil.Result.Id.Set.empty; - cache = String.Map.empty; + addrs = (Set.empty (module Addr)); + checked = (Set.empty (module Bil.Result.Id)); + cache = (Map.empty (module String)); }) @@ -147,7 +147,7 @@ let hunter = ~f:Unscrambler.add_word ~init:dict in let build input = Unscrambler.build dict input |> - Seq.fold ~init:String.Set.empty ~f:Set.add in + Seq.fold ~init:(Set.empty (module String)) ~f:(fun s x -> Set.add s x) in Hunter (build)) diff --git a/plugins/bil/bil_float.ml b/plugins/bil/bil_float.ml index e3524b3ff..068b72f7f 100644 --- a/plugins/bil/bil_float.ml +++ b/plugins/bil/bil_float.ml @@ -78,7 +78,7 @@ module Make(B : Theory.Core) = struct let smin x y = ite (x <$ y) x y let leading_one sort = - one sort lsl (of_int sort Caml.(Theory.Bitv.size sort - 1)) + one sort lsl (of_int sort Stdlib.(Theory.Bitv.size sort - 1)) end @@ -125,7 +125,7 @@ module Make(B : Theory.Core) = struct let open IEEE754 in let bits = Sort.bits fsort in let bit = Bits.define 1 in - let bits_1 = Bits.define Caml.(Bits.size bits - 1) in + let bits_1 = Bits.define Stdlib.(Bits.size bits - 1) in let sign = ite sign (B.one bit) (B.zero bit) in B.append bits sign (B.append bits_1 expn coef) @@ -134,7 +134,7 @@ module Make(B : Theory.Core) = struct let {IEEE754.p; t} = IEEE754.Sort.spec fsort in let is_subnormal = (inv (msb coef)) && (is_one expn) in ite is_subnormal (pred expn) expn >>>= fun expn -> - if Caml.(p = t) then pack_raw fsort sign expn coef + if Stdlib.(p = t) then pack_raw fsort sign expn coef else B.low (Bits.define t) coef >>>= fun coef -> pack_raw fsort sign expn coef >>= fun r -> !!r @@ -172,7 +172,7 @@ module Make(B : Theory.Core) = struct let with_sign sign bitv = let open B in bitv >>-> fun s bitv -> - let s' = Bits.define Caml.(Bits.size s - 1) in + let s' = Bits.define Stdlib.(Bits.size s - 1) in let bit = Bits.define 1 in ite sign ((append s (one bit) (zero s')) lor !!bitv) ((append s (zero bit) (ones s')) land !!bitv) @@ -388,11 +388,11 @@ module Make(B : Theory.Core) = struct let size = Bits.size sort in let pow, num = nearest_pow2 size in let sort' = Bits.define num in - let shifts = List.init pow ~f:(fun p -> Caml.(num / (2 lsl p))) in + let shifts = List.init pow ~f:(fun p -> Stdlib.(num / (2 lsl p))) in let shifts,_ = List.fold shifts ~init:([],0) ~f:(fun (acc,prev) curr -> - let total = Caml.(curr + prev) in + let total = Stdlib.(curr + prev) in (total, curr) :: acc, total) in let shifts = List.rev shifts in let rec loop lets x = function @@ -403,7 +403,7 @@ module Make(B : Theory.Core) = struct ite (is_zero (x land mask)) (of_int sort shf) (zero sort) >>>= fun nextn -> loop (nextn :: lets) nextx shifts in loop [] (B.unsigned sort' !!x) shifts >>>= fun n -> - of_int sort Caml.(num - size) >>>= fun dif -> + of_int sort Stdlib.(num - size) >>>= fun dif -> ite (is_zero !!x) (of_int sort size) (n - dif) let possible_lshift expn coef = @@ -677,7 +677,7 @@ module Make(B : Theory.Core) = struct let lost_afew = b0, b0, b1 in nomin >>-> fun sort nomin -> let rec loop i bits nomin = - if Caml.(i < 0) then + if Stdlib.(i < 0) then List.fold bits ~f:(lor) ~init:(zero sort) >>>= fun coef -> match_ [ (nomin > denom) --> f coef lost_alot; @@ -690,8 +690,8 @@ module Make(B : Theory.Core) = struct ite (nomin > denom) (nomin - denom) nomin >>>= fun next_nomin -> next_nomin lsl one sort >>>= fun next_nomin -> bind next_nomin (fun next_nomin -> - loop Caml.(i - 1) (bit :: bits) next_nomin) in - loop Caml.(prec - 1) [] !!nomin + loop Stdlib.(i - 1) (bit :: bits) next_nomin) in + loop Stdlib.(prec - 1) [] !!nomin let fdiv_finite fsort rm x y = let open B in @@ -774,7 +774,7 @@ module Make(B : Theory.Core) = struct let truncate fsort x rm fsort' = let open B in let sigs_sh = Bits.size (sigs fsort') in - let d_bias = Caml.(bias fsort - bias fsort') in + let d_bias = Stdlib.(bias fsort - bias fsort') in let dst_maxe = max_exponent' (Bits.size @@ exps fsort') in unpack fsort x @@ fun sign expn coef -> if_ (is_all_ones expn || is_zero expn) @@ -806,8 +806,8 @@ module Make(B : Theory.Core) = struct (* pre: fsort "<=" fsort' *) let extend fsort x fsort' = let open B in - let d_sigs = Caml.(Bits.size (sigs fsort') - Bits.size (sigs fsort)) in - let d_bias = Caml.(bias fsort' - bias fsort) in + let d_sigs = Stdlib.(Bits.size (sigs fsort') - Bits.size (sigs fsort)) in + let d_bias = Stdlib.(bias fsort' - bias fsort) in unpack fsort x @@ fun sign expn coef -> match_ [ is_all_ones expn --> ones (exps fsort'); @@ -840,7 +840,7 @@ module Make(B : Theory.Core) = struct let exps = exps fsort in let sigs = Bits.define p in bitv >>-> fun inps bitv -> - of_int exps Caml.(bias + p - 1) >>>= fun expn -> + of_int exps Stdlib.(bias + p - 1) >>>= fun expn -> of_int sigs p >>>= fun prec -> clz !!bitv >>>= fun clz -> unsigned sigs clz >>>= fun clz -> @@ -886,8 +886,8 @@ module Make(B : Theory.Core) = struct let range_reduction fsort x f = let open B in let bias = bias fsort in - let low = of_int (exps fsort) Caml.(bias - 0) in - let top = of_int (exps fsort) Caml.(bias + 1) in + let low = of_int (exps fsort) Stdlib.(bias - 0) in + let top = of_int (exps fsort) Stdlib.(bias + 1) in unpack_raw fsort x @@ fun sign expn coef -> match_ [ (expn = top && non_zero coef) --> (expn - low); diff --git a/plugins/bil/bil_ir.ml b/plugins/bil/bil_ir.ml index 74a9a0187..e1fed3aaa 100644 --- a/plugins/bil/bil_ir.ml +++ b/plugins/bil/bil_ir.ml @@ -68,7 +68,7 @@ module BIR = struct List.filter_map blk.jmps ~f:dst let references blks = - List.fold ~init:Tid.Map.empty ~f:(fun refs {jmps} -> + List.fold ~init:(Map.empty (module Tid)) ~f:(fun refs {jmps} -> List.fold jmps ~init:refs ~f:(fun refs jmp -> match dst jmp with | Some tid when Map.mem blks tid -> @@ -78,7 +78,7 @@ module BIR = struct | _ -> refs)) let build_graph = List.fold - ~init:Tid.Map.empty + ~init:(Map.empty (module Tid)) ~f:(fun blks blk -> Map.add_exn blks blk.name blk) diff --git a/plugins/bil/bil_lifter.ml b/plugins/bil/bil_lifter.ml index 8b43b2468..0e1e2dcff 100644 --- a/plugins/bil/bil_lifter.ml +++ b/plugins/bil/bil_lifter.ml @@ -58,7 +58,7 @@ module Relocations = struct let relocations = Fact.eval Request.relocations let external_symbols = Fact.eval Request.external_symbols - let empty = {rels = Int64.Map.empty; exts = Int64.Map.empty} + let empty = {rels = (Map.empty (module Int64)); exts = (Map.empty (module Int64))} let of_spec spec = @@ -85,7 +85,7 @@ module Relocations = struct let references bil = snd @@ reference_analyzer#run bil - (Var.Map.empty, Addr.Set.empty) + (Map.empty (module Var), Set.empty (module Addr)) let addresses bil mem = let start = Memory.min_addr mem in diff --git a/plugins/bil/bil_semantics.ml b/plugins/bil/bil_semantics.ml index 2b0a89dab..9499bca5e 100644 --- a/plugins/bil/bil_semantics.ml +++ b/plugins/bil/bil_semantics.ml @@ -60,7 +60,7 @@ module Basic : Theory.Basic = struct let int s w = vec s @@ Bil.(int @@ Word.create w (size s)) - let effect x = KB.Value.get effects x + let get_eff x = KB.Value.get effects x let (>>->) v f = v >>= fun v -> f (sort v) (value v) @@ -183,7 +183,7 @@ module Basic : Theory.Basic = struct | _ -> exp s (Bil.ite cnd yes nay) - let (>>:=) v f = v >>= fun v -> f (effect v) + let (>>:=) v f = v >>= fun v -> f (get_eff v) let branch cnd yes nay = cnd >>= fun cnd -> @@ -284,7 +284,7 @@ module Basic : Theory.Basic = struct let seq x y = x >>= fun x -> y >>= fun y -> - eff (effect x @ effect y) + eff (get_eff x @ get_eff y) let blk lbl x y = x >>:= fun x -> diff --git a/plugins/byteweight/byteweight_main.ml b/plugins/byteweight/byteweight_main.ml index 100e31e63..7e34591de 100644 --- a/plugins/byteweight/byteweight_main.ml +++ b/plugins/byteweight/byteweight_main.ml @@ -45,7 +45,7 @@ open Core_kernel[@@warning "-D"] open Bap_main open Bap_core_theory open Bap.Std -module Sys = Caml.Sys +module Sys = Stdlib.Sys open KB.Syntax include Loggers() @@ -59,7 +59,7 @@ and p0 m n = float n /. float (m + n) let roots = KB.Class.property Theory.Unit.cls "byteweight-roots" ~package:"bap" @@ KB.Domain.powerset (module Bitvec_order) "roots" -let no_roots = Set.empty (module Bitvec_order) +let no_roots = (Set.empty (module Bitvec_order)) let of_addrs = List.fold ~init:no_roots ~f:(fun roots addr -> Set.add roots (Addr.to_bitvec addr)) diff --git a/plugins/cache/bap_cache.ml b/plugins/cache/bap_cache.ml index 15bb5057a..28ebb4627 100644 --- a/plugins/cache/bap_cache.ml +++ b/plugins/cache/bap_cache.ml @@ -5,9 +5,9 @@ open Bap_cache_types include Self () -module Filename = Caml.Filename -module Random = Caml.Random -module Sys = Caml.Sys +module Filename = Stdlib.Filename +module Random = Stdlib.Random +module Sys = Stdlib.Sys module Unix = Caml_unix module Utils = Bap_cache_utils @@ -56,7 +56,7 @@ end include Cfg -let getenv opt = try Some (Sys.getenv opt) with Caml.Not_found -> None +let getenv opt = try Some (Sys.getenv opt) with Stdlib.Not_found -> None let root () = match !default_root with | Some dir -> dir // ".cache" // "bap" diff --git a/plugins/cache/bap_cache_gc.ml b/plugins/cache/bap_cache_gc.ml index 22dc97bd2..711647646 100644 --- a/plugins/cache/bap_cache_gc.ml +++ b/plugins/cache/bap_cache_gc.ml @@ -80,7 +80,7 @@ include Self () module Cache = Bap_cache module CDF = Int.Map -module Sys = Caml.Sys +module Sys = Stdlib.Sys module Unix = Caml_unix type entry = { @@ -110,7 +110,7 @@ let cdf entries = Array.foldi entries ~init:(Map.empty (module Int),0) ~f:(fun i (m,prev) e -> let f_i = prev + max min_entry_size e.size in - CDF.add_exn m prev i, f_i) + Base.Map.add_exn m ~key:prev ~data:i, f_i) let select entries total_size size_to_free = let cdf = cdf entries in @@ -118,7 +118,7 @@ let select entries total_size size_to_free = if freed < size_to_free then let u = Random.int total_size in let (_,i) = - Option.value_exn (CDF.closest_key cdf `Less_or_equal_to u) in + Option.value_exn (Base.Map.closest_key cdf `Less_or_equal_to u) in if Set.mem indexes i then loop indexes freed else loop (Set.add indexes i) (freed + entries.(i).size) diff --git a/plugins/cache/bap_cache_main.ml b/plugins/cache/bap_cache_main.ml index 9345a61a3..bc69fe8a3 100644 --- a/plugins/cache/bap_cache_main.ml +++ b/plugins/cache/bap_cache_main.ml @@ -7,7 +7,7 @@ open Bap_main include Self() -module Filename = Caml.Filename +module Filename = Stdlib.Filename module Cache = Bap_cache module Utils = Bap_cache_utils module GC = Bap_cache_gc @@ -141,7 +141,7 @@ let () = provide_service (); Ok () -let opts = ref String.Map.empty +let opts = ref (Map.empty (module String)) let add_description ?arg name descr = let name = match arg with diff --git a/plugins/cache/bap_cache_utils.ml b/plugins/cache/bap_cache_utils.ml index 49be733fe..05428bd97 100644 --- a/plugins/cache/bap_cache_utils.ml +++ b/plugins/cache/bap_cache_utils.ml @@ -1,8 +1,8 @@ open Core_kernel[@@warning "-D"] open Regular.Std -module Filename = Caml.Filename -module Sys = Caml.Sys +module Filename = Stdlib.Filename +module Sys = Stdlib.Sys module Unix = Caml_unix let ( / ) = Filename.concat diff --git a/plugins/callgraph_collator/callgraph_collator_main.ml b/plugins/callgraph_collator/callgraph_collator_main.ml index 80655de1b..389e9048f 100644 --- a/plugins/callgraph_collator/callgraph_collator_main.ml +++ b/plugins/callgraph_collator/callgraph_collator_main.ml @@ -87,14 +87,14 @@ let () = Extension.declare ~provides:["collator"] ~doc @@ fun ctxt -> match name_of_dst jmp with | Some dst when filter src && filter dst -> src,Map.update calls src ~f:(function - | None -> String.Set.singleton dst + | None -> Set.singleton (module String) dst | Some dsts -> Set.add dsts dst) | _ -> src,calls end in let calls_of_project proj = let prog = Project.program proj in - snd @@ call_collector#run prog ("",String.Map.empty) in + snd @@ call_collector#run prog ("",Map.empty (module String)) in let prepare proj = calls_of_project proj,0 in @@ -105,7 +105,7 @@ let () = Extension.declare ~provides:["collator"] ~doc @@ fun ctxt -> let collate ver (base,diffs) proj = let alt = calls_of_project proj in let diff = Map.symmetric_diff base alt - ~data_equal:String.Set.equal in + ~data_equal:Set.equal in let is_different = not (Seq.is_empty diff) in if is_different then fprintf ppf "Version %d differs:@\n%!" ver diff --git a/plugins/constant_tracker/constant_tracker_main.ml b/plugins/constant_tracker/constant_tracker_main.ml index 4ad9bf7b7..9b268ec28 100644 --- a/plugins/constant_tracker/constant_tracker_main.ml +++ b/plugins/constant_tracker/constant_tracker_main.ml @@ -11,7 +11,7 @@ type state = { let state = Primus.Machine.State.declare ~uuid:"caf680aa-ef54-4468-9a24-4a125de6ace9" ~name:"constant-tracker" - (fun _ -> {consts = Primus.Value.Id.Set.empty}) + (fun _ -> {consts = (Set.empty (module Primus.Value.Id))}) let is_const x {consts} = Set.mem consts (Primus.Value.id x) diff --git a/plugins/dependencies/dependencies_main.ml b/plugins/dependencies/dependencies_main.ml index cd7a69d8f..49031df7e 100644 --- a/plugins/dependencies/dependencies_main.ml +++ b/plugins/dependencies/dependencies_main.ml @@ -58,7 +58,7 @@ open Core_kernel[@@warning "-D"] open Bap.Std open Regular.Std open Bap_main -module Sys = Caml.Sys +module Sys = Stdlib.Sys include Loggers() @@ -91,7 +91,7 @@ end = struct | None -> cache | Some path -> Map.set cache (Filename.basename path) path) - ~init:String.Map.empty) + ~init:(Map.empty (module String))) ~finally:(fun () -> match UnixLabels.close_process_in ldconfig with | WEXITED 0 -> () @@ -122,7 +122,7 @@ module Spec = struct let libraries = Ogre.collect Ogre.Query.(select (from require)) let set_of_seq = - Seq.fold ~f:Set.add ~init:(Set.empty (module String)) + Seq.fold ~f:(fun s x -> Set.add s x) ~init:(Set.empty (module String)) let build name = imports >>| set_of_seq >>= fun imports -> @@ -146,8 +146,8 @@ module Unit = struct let empty name = { name; - imports = Set.empty (module String); - exports = Set.empty (module String); + imports = (Set.empty (module String)); + exports = (Set.empty (module String)); libraries = []; } diff --git a/plugins/disassemble/disassemble_main.ml b/plugins/disassemble/disassemble_main.ml index 1e02a9ecd..e075df676 100644 --- a/plugins/disassemble/disassemble_main.ml +++ b/plugins/disassemble/disassemble_main.ml @@ -91,7 +91,7 @@ open Monads.Std open Format open Bap_plugins.Std -module Sys = Caml.Sys +module Sys = Stdlib.Sys include Self() open Bap_main @@ -178,7 +178,7 @@ end = struct | Some c -> c + 1) let build_histo = - Map.fold ~init:Int.Map.empty ~f:(fun ~key ~data -> + Map.fold ~init:(Map.empty (module Int)) ~f:(fun ~key ~data -> Map.add_multi ~key:data ~data:key) let pp_histo ppf stats = @@ -190,7 +190,7 @@ end = struct let print_missing () = let lifted = ref 0 and missed = ref 0 and failed = ref 0 in KB.objects Theory.Program.cls >>= - KB.Seq.fold ~init:String.Map.empty ~f:(fun stats insn -> + KB.Seq.fold ~init:(Map.empty (module String)) ~f:(fun stats insn -> let* sema = KB.collect Theory.Semantics.slot insn in let code = KB.Value.get Theory.Semantics.code sema in if Option.is_none code then KB.return stats @@ -323,8 +323,8 @@ let rw_file = Extension.Type.define ~name:"" ~print:Fn.id ~parse:Fn.id ~digest:(fun path -> if Sys.file_exists path - then Caml.Digest.file path - else Caml.Digest.string "empty") + then Stdlib.Digest.file path + else Stdlib.Digest.string "empty") "" let update = @@ -383,8 +383,8 @@ let target = let t = Extension.Type.define Theory.Target.unknown ~name:"NAME" ~digest:(fun t -> - let r = Caml.Digest.string@@Theory.Target.to_string t in - Format.eprintf "target digest = %s@\n" (Caml.Digest.to_hex r); + let r = Stdlib.Digest.string@@Theory.Target.to_string t in + Format.eprintf "target digest = %s@\n" (Stdlib.Digest.to_hex r); r) ~parse:(fun s -> match Theory.Target.lookup ~package:"bap" s with | Some t -> t @@ -458,9 +458,9 @@ module Dump_formats = struct end let setup_gc () = - let opts = Caml.Gc.get () in + let opts = Stdlib.Gc.get () in info "Setting GC parameters"; - Caml.Gc.set { + Stdlib.Gc.set { opts with minor_heap_size = 2 * 1024 * 1024; major_heap_increment = 64 * 1024 * 1024; @@ -499,7 +499,7 @@ let create_and_process input libraries outputs passes loader target update Fn.non Filename.is_implicit loader in let package = input in let digest = - let file = Caml.Digest.file in + let file = Stdlib.Digest.file in let config = Extension.Configuration.digest ctxt in let input = file input in let libraries = List.map libraries ~f:file in diff --git a/plugins/disassemble/disassemble_main_rules.ml b/plugins/disassemble/disassemble_main_rules.ml index 4babce8b9..84c37a2e3 100644 --- a/plugins/disassemble/disassemble_main_rules.ml +++ b/plugins/disassemble/disassemble_main_rules.ml @@ -109,9 +109,9 @@ module Symbols = struct } [@@deriving compare, equal, bin_io, sexp] let empty = { - roots = Set.empty (module Addr); - names = Map.empty (module Addr); - aliases = Map.empty (module Addr); + roots = (Set.empty (module Addr)); + names = (Map.empty (module Addr)); + aliases = (Map.empty (module Addr)); } let slot = KB.Class.property Theory.Unit.cls @@ -241,7 +241,7 @@ module Symbols = struct let* name = KB.resolve Theory.Label.possible_name obj in let init = match name with | Some name -> Set.singleton (module String) name - | None -> Set.empty (module String) in + | None -> (Set.empty (module String)) in match unit,addr with | None,_|_,None -> KB.return init | Some unit, Some addr -> diff --git a/plugins/emit_ida_script/emit_ida_script_main.ml b/plugins/emit_ida_script/emit_ida_script_main.ml index 5ce3a35f3..2c3c56716 100644 --- a/plugins/emit_ida_script/emit_ida_script_main.ml +++ b/plugins/emit_ida_script/emit_ida_script_main.ml @@ -3,7 +3,7 @@ open Bap.Std open Format include Self() -module Buffer = Caml.Buffer +module Buffer = Stdlib.Buffer (** ida uses a strange color coding, bgr, IIRC *) let idacode_of_color = function diff --git a/plugins/frontc_parser/frontc_parser_main.ml b/plugins/frontc_parser/frontc_parser_main.ml index 8820f69be..6e0317dc5 100644 --- a/plugins/frontc_parser/frontc_parser_main.ml +++ b/plugins/frontc_parser/frontc_parser_main.ml @@ -203,8 +203,8 @@ let resolver lookup = object(self) end let parse (size : C.Size.base) parse lexbuf = - let env = String.Table.create () in - let tags = String.Table.create () in + let env = Hashtbl.create (module String) in + let tags = Hashtbl.create (module String) in let gamma name = match Hashtbl.find env name with | Some t -> t | None -> `Void in diff --git a/plugins/glibc_runtime/glibc_runtime_main.ml b/plugins/glibc_runtime/glibc_runtime_main.ml index e1b95a18e..d13eb76c5 100644 --- a/plugins/glibc_runtime/glibc_runtime_main.ml +++ b/plugins/glibc_runtime/glibc_runtime_main.ml @@ -180,8 +180,8 @@ let refine_glibc_internal_aliases () = KB.collect Theory.Label.aliases label >>| fun aliases -> let init = match name with | Some name when is_glibc_internal name -> - String.Set.singleton @@ drop_glibc_internal name - | None | Some _ -> String.Set.empty in + Set.singleton (module String) @@ drop_glibc_internal name + | None | Some _ -> (Set.empty (module String)) in Set.fold aliases ~init ~f:(fun acc s -> if is_glibc_internal s then Set.add acc @@ drop_glibc_internal s diff --git a/plugins/ida/bap_ida_info.ml b/plugins/ida/bap_ida_info.ml index 0768e156d..a37e37752 100644 --- a/plugins/ida/bap_ida_info.ml +++ b/plugins/ida/bap_ida_info.ml @@ -2,7 +2,7 @@ open Core_kernel[@@warning "-D"] open Bap.Std include Self() -module Sys = Caml.Sys +module Sys = Stdlib.Sys type version = Vold | Vnew [@@deriving sexp, equal] diff --git a/plugins/ida/bap_ida_service.ml b/plugins/ida/bap_ida_service.ml index ea771b2fa..3ab321d17 100644 --- a/plugins/ida/bap_ida_service.ml +++ b/plugins/ida/bap_ida_service.ml @@ -4,10 +4,10 @@ open Bap.Std include Self () -module Buffer = Caml.Buffer -module Filename = Caml.Filename +module Buffer = Stdlib.Buffer +module Filename = Stdlib.Filename module Unix = Caml_unix -module Sys = Caml.Sys +module Sys = Stdlib.Sys module Info = Bap_ida_info @@ -63,7 +63,7 @@ let setup_headless_env path = let old_path,new_path = try Unix.getenv var, lib ^ ":" ^ Unix.getenv var - with Caml.Not_found -> "", lib in + with Stdlib.Not_found -> "", lib in Unix.putenv var new_path; fun () -> try diff --git a/plugins/ida/ida_main.ml b/plugins/ida/ida_main.ml index 598db1c50..4ac1f0980 100644 --- a/plugins/ida/ida_main.ml +++ b/plugins/ida/ida_main.ml @@ -25,7 +25,7 @@ module type Target = sig val provide : Knowledge.agent -> t -> unit end -let digest = Caml.Digest.file +let digest = Stdlib.Digest.file let request = sprintf " @@ -179,17 +179,17 @@ end = struct List.fold flows ~init:[] ~f:(fun acc addr -> (Some !addr, `Jump)::acc) in let helper tab (addr,_normal_flow,other_flows) = - Addr.Table.add_exn tab ~key:!addr + Hashtbl.add_exn tab ~key:!addr ~data:(other_flows_to_dests other_flows); tab in List.fold bf - ~init:(Addr.Table.create ()) + ~init:(Hashtbl.create (module Addr)) ~f:helper let resolve t mem _ = match - Addr.Table.find t (Memory.min_addr mem) + Hashtbl.find t (Memory.min_addr mem) with | Some dests -> dests | None -> [] diff --git a/plugins/mips/mips.ml b/plugins/mips/mips.ml index f0eba4da5..487193afe 100644 --- a/plugins/mips/mips.ml +++ b/plugins/mips/mips.ml @@ -36,7 +36,7 @@ module Std = struct let (^) = concat - let lifters = String.Table.create () + let lifters = Hashtbl.create (module String) let delayed_opcodes = Hashtbl.create (module String) @@ -63,7 +63,7 @@ module Std = struct sprintf "instruction %s doesn't have an operand with index %d" insn_name n in Error (Error.of_string str) in - match String.Table.find lifters (Insn.name insn) with + match Hashtbl.find lifters (Insn.name insn) with | None -> Ok [] | Some lifter -> lift lifter diff --git a/plugins/mips/mips_cpu.ml b/plugins/mips/mips_cpu.ml index eb4c81e45..c6c94e316 100644 --- a/plugins/mips/mips_cpu.ml +++ b/plugins/mips/mips_cpu.ml @@ -17,7 +17,7 @@ let find m reg = let (module M : MIPS) = m in let open M in let open E in - let find_reg regs reg = String.Map.find regs (Reg.name reg) in + let find_reg regs reg = Map.find regs (Reg.name reg) in let find_gpr = find_reg gpr in let find_fpr = find_reg fpr in let reg_searches = [find_gpr; find_fpr] in @@ -47,7 +47,7 @@ let make_cpu addr_size endian memory = | `r64 -> jmp e in let find name regs n = try - Int.Map.find_exn regs n + Map.find_exn regs n with _ -> mips_fail "%s with number %d not found" name n in let gpr n = find "GPR" gpri n in diff --git a/plugins/mips/mips_model.ml b/plugins/mips/mips_model.ml index d4530252a..878d0a653 100644 --- a/plugins/mips/mips_model.ml +++ b/plugins/mips/mips_model.ml @@ -36,23 +36,23 @@ let make_regs_list typ prefix size = Array.init ~f:(fun i -> make_var_i typ prefix i) size let reglist_to_map regs = - List.fold ~init:String.Map.empty ~f:(fun regs var -> - String.Map.set regs (Var.name var) var) regs + List.fold ~init:(Map.empty (module String)) ~f:(fun regs var -> + Map.set regs (Var.name var) var) regs let make_regs typ ?alias prefix range = - List.fold ~init:String.Map.empty ~f:(fun regs i -> + List.fold ~init:(Map.empty (module String)) ~f:(fun regs i -> let var = make_var_i typ prefix i in let name = Var.name var in - let regs = String.Map.set regs name var in + let regs = Map.set regs name var in match alias with | None -> regs | Some a -> let name = make_name a i in - String.Map.set regs name var) range + Map.set regs name var) range let make_regs_i typ prefix range = - List.fold ~init:Int.Map.empty ~f:(fun regs i -> - Int.Map.set regs i (make_var_i typ prefix i)) range + List.fold ~init:(Map.empty (module Int)) ~f:(fun regs i -> + Map.set regs i (make_var_i typ prefix i)) range let make_reg typ name = Var.create name typ let flag name = Var.create name (Type.imm 1) @@ -72,10 +72,10 @@ module Vars = struct end let of_vars vars = - String.Map.map vars ~f:(fun v -> Exp.of_var v) + Map.map vars ~f:(fun v -> Exp.of_var v) let of_vars_i vars = - Int.Map.map vars ~f:(fun v -> Exp.of_var v) + Map.map vars ~f:(fun v -> Exp.of_var v) module Exps = struct open Vars @@ -134,7 +134,7 @@ module Make_MIPS(S: Spec) : MIPS = struct ] let gpr = - List.fold gprs ~init:String.Map.empty ~f:(fun init (reg, alias) -> + List.fold gprs ~init:(Map.empty (module String)) ~f:(fun init (reg, alias) -> let name = Var.name reg in let names = [name; alias] in let names = @@ -142,7 +142,7 @@ module Make_MIPS(S: Spec) : MIPS = struct else names in List.fold names ~init ~f:(fun regs name -> Map.set regs name reg)) - let gpri = List.foldi ~init:Int.Map.empty ~f:(fun n regs (reg,_) -> + let gpri = List.foldi ~init:(Map.empty (module Int)) ~f:(fun n regs (reg,_) -> Map.set regs n reg) gprs let hi = make_reg (Type.imm gpr_bitwidth) "HI" @@ -179,11 +179,11 @@ module Make_cpu(M : MIPS) : CPU = struct let gpr = let data = Map.data gpr in - List.fold data ~init:Var.Set.empty - ~f:(fun regs v -> Var.Set.add regs v) + List.fold data ~init:(Set.empty (module Var)) + ~f:(fun regs v -> Set.add regs v) - let sp = Var.Set.find_exn gpr ~f:(fun v -> String.is_prefix ~prefix:"SP" (Var.name v)) - let fp = Var.Set.find_exn gpr ~f:(fun v -> String.is_prefix ~prefix:"FP" (Var.name v)) + let sp = Set.find_exn gpr ~f:(fun v -> String.is_prefix ~prefix:"SP" (Var.name v)) + let fp = Set.find_exn gpr ~f:(fun v -> String.is_prefix ~prefix:"FP" (Var.name v)) (* MIPS doesn't have flags, but structure requires them * We just make a stubs here *) @@ -193,7 +193,7 @@ module Make_cpu(M : MIPS) : CPU = struct let vf = flag "undefined" let nf = flag "undefined" - let flags = Var.Set.of_list [ + let flags = Set.of_list (module Var) [ ] let is = Var.same diff --git a/plugins/mips/mips_rtl.ml b/plugins/mips/mips_rtl.ml index dbe667bad..1bf691cd0 100644 --- a/plugins/mips/mips_rtl.ml +++ b/plugins/mips/mips_rtl.ml @@ -195,7 +195,7 @@ module Exp = struct if width = e.width then e else match e.body with - | Vars (v,vars) when Caml.not (List.is_empty vars) -> + | Vars (v,vars) when Stdlib.not (List.is_empty vars) -> extract_of_vars e hi lo (v :: vars) | _ -> { sign=Unsigned; width; body = Extract (hi,lo,e.body) } diff --git a/plugins/objdump/objdump_main.ml b/plugins/objdump/objdump_main.ml index 61d574163..7fcecbbfe 100644 --- a/plugins/objdump/objdump_main.ml +++ b/plugins/objdump/objdump_main.ml @@ -46,7 +46,7 @@ let demangler = Extension.Configuration.parameter let objdump_cmds demangler= - String.Set.stable_dedup_list objdumps|> + Set.stable_dedup_list (module String) objdumps |> List.map ~f:(fun cmd -> sprintf "%s %s %s" cmd default_objdump_opts @@ match demangler with @@ -118,8 +118,8 @@ end = struct } let empty_table = { - names = Map.empty (module Bitvec_order); - aliases = Map.empty (module Bitvec_order); + names = (Map.empty (module Bitvec_order)); + aliases = (Map.empty (module Bitvec_order)); } type t = { @@ -230,7 +230,7 @@ let provide_aliases repo = require addr |> provide aliases |> comment "extracts aliases from objdump"); - let empty = Set.empty (module String) in + let empty = (Set.empty (module String)) in KB.promise aliases @@ fun label -> KB.collect unit label >>= function | None -> !!empty diff --git a/plugins/optimization/optimization_data.ml b/plugins/optimization/optimization_data.ml index 15c07407e..ad2619697 100644 --- a/plugins/optimization/optimization_data.ml +++ b/plugins/optimization/optimization_data.ml @@ -38,7 +38,7 @@ let updates_of_sub sub = Map.set updates (Term.tid j) data in let add_if add updates t = if is_updated t then add updates t else updates in - fold sub blk_t Tid.Map.empty ~f:(fun updates b -> + fold sub blk_t (Map.empty (module Tid)) ~f:(fun updates b -> fold b def_t updates ~f:(add_if update_rhs) |> fold b jmp_t ~f:(add_if update_jmp)) diff --git a/plugins/optimization/optimization_main.ml b/plugins/optimization/optimization_main.ml index 314534750..0a21efde3 100644 --- a/plugins/optimization/optimization_main.ml +++ b/plugins/optimization/optimization_main.ml @@ -1,20 +1,16 @@ -open Core_kernel[@@warning "-D"] +open Core_kernel [@@warning "-D"] open Bap.Std open Regular.Std open Format -include Self() - +include Self () module Digest = Data.Cache.Digest module O = Optimization_data type level = int - type cls = Phys | Virt | Flag let classify is_flag var = - if is_flag var then Flag - else if Var.is_physical var then Phys - else Virt + if is_flag var then Flag else if Var.is_physical var then Phys else Virt let is_optimization_allowed is_flag level var = match classify is_flag var with @@ -22,56 +18,58 @@ let is_optimization_allowed is_flag level var = | Flag -> level > 1 | Phys -> level > 2 -let def_use_collector = object - inherit [Var.Set.t * Var.Set.t] Term.visitor +let def_use_collector = + object + inherit [Var.Set.t * Var.Set.t] Term.visitor - method! enter_def t (defs,uses) = - Set.add defs (Def.lhs t), Set.union uses (Def.free_vars t) + method! enter_def t (defs, uses) = + (Set.add defs (Def.lhs t), Set.union uses (Def.free_vars t)) - method! enter_phi t (defs,uses) = - Set.add defs (Phi.lhs t), Set.union uses (Phi.free_vars t) + method! enter_phi t (defs, uses) = + (Set.add defs (Phi.lhs t), Set.union uses (Phi.free_vars t)) - method! enter_jmp t (defs,uses) = - defs, Set.union uses (Jmp.free_vars t) -end + method! enter_jmp t (defs, uses) = (defs, Set.union uses (Jmp.free_vars t)) + end let computed_def_use sub = - def_use_collector#visit_sub sub (Var.Set.empty,Var.Set.empty) + def_use_collector#visit_sub sub (Set.empty (module Var), Set.empty (module Var)) let compute_dead can_touch protected sub = - let defs,uses = computed_def_use sub in + let defs, uses = computed_def_use sub in let dead = Set.diff defs uses in let live v = not (Set.mem dead v) in - Term.enum blk_t sub |> - Seq.fold ~init:Tid.Set.empty ~f:(fun dead blk -> - Term.enum ~rev:true def_t blk |> - Seq.fold ~init:(protected,dead) ~f:(fun (protected,dead) def -> + Term.enum blk_t sub + |> Seq.fold ~init:(Set.empty (module Tid)) ~f:(fun dead blk -> + Term.enum ~rev:true def_t blk + |> Seq.fold ~init:(protected, dead) ~f:(fun (protected, dead) def -> let v = Def.lhs def in - if not (can_touch v) || live v - then (protected,dead) - else if Set.mem protected (Var.base v) - then Set.remove protected (Var.base v), dead - else protected, Set.add dead (Term.tid def)) |> - snd) + if (not (can_touch v)) || live v then (protected, dead) + else if Set.mem protected (Var.base v) then + (Set.remove protected (Var.base v), dead) + else (protected, Set.add dead (Term.tid def))) + |> snd) let is_alive dead t = not (Set.mem dead (Term.tid t)) let live_phi dead blk = Term.filter phi_t ~f:(is_alive dead) blk let live_def can_touch dead blk = Term.filter def_t blk ~f:(fun d -> - not (can_touch (Def.lhs d)) || is_alive dead d) + (not (can_touch (Def.lhs d))) || is_alive dead d) let rec substitute vars exp = - let substituter = object - inherit Exp.mapper as super - method! map_let var ~exp ~body = - let exp = super#map_exp exp in - let body = substitute (Map.remove vars var) body in - Bil.let_ var exp body - method! map_var v = match Map.find vars v with - | None -> Bil.var v - | Some e -> e - end in + let substituter = + object + inherit Exp.mapper as super + + method! map_let var ~exp ~body = + let exp = super#map_exp exp in + let body = substitute (Map.remove vars var) body in + Bil.let_ var exp body + + method! map_var v = + match Map.find vars v with None -> Bil.var v | Some e -> e + end + in substituter#map_exp exp |> Exp.fold_consts let equal_kinds j j' = compare_jmp_kind (Jmp.kind j) (Jmp.kind j') = 0 @@ -79,48 +77,47 @@ let equal_kinds j j' = compare_jmp_kind (Jmp.kind j) (Jmp.kind j') = 0 let substitute sub vars = let def d = let rhs = substitute vars (Def.rhs d) in - if Exp.(Def.rhs d <> rhs) then - O.mark_updated (Def.with_rhs d rhs) - else d in + if Exp.(Def.rhs d <> rhs) then O.mark_updated (Def.with_rhs d rhs) else d + in let jmp j = let j' = Jmp.map_exp j ~f:(substitute vars) in - if Exp.(Jmp.cond j <> Jmp.cond j') || not (equal_kinds j j') - then O.mark_updated j' - else j in + if Exp.(Jmp.cond j <> Jmp.cond j') || not (equal_kinds j j') then + O.mark_updated j' + else j + in Term.map blk_t sub ~f:(Blk.map_elts ~def ~jmp) (* A simple constant propagation. Note, the input is required to be in SSA. *) let propagate_consts can_touch sub = - Seq.fold (Term.enum blk_t sub) ~init:Var.Map.empty - ~f:(fun vars b -> - Seq.fold (Term.enum def_t b) ~init:vars - ~f:(fun vars d -> - let v = Def.lhs d in - if can_touch v then - match Def.rhs d with - | Bil.Unknown _ | Bil.Int _ as exp -> - Map.set vars ~key:v ~data:exp - | _ -> vars - else vars)) |> - substitute sub + Seq.fold (Term.enum blk_t sub) ~init:(Map.empty (module Var)) ~f:(fun vars b -> + Seq.fold (Term.enum def_t b) ~init:vars ~f:(fun vars d -> + let v = Def.lhs d in + if can_touch v then + match Def.rhs d with + | (Bil.Unknown _ | Bil.Int _) as exp -> + Map.set vars ~key:v ~data:exp + | _ -> vars + else vars)) + |> substitute sub let clean can_touch dead sub = Term.map blk_t sub ~f:(fun b -> live_def can_touch dead b |> live_phi dead) let is_flag arch = - let module T = (val (target_of_arch arch)) in + let module T = (val target_of_arch arch) in T.CPU.is_flag let free_vars prog = report_progress ~note:"free-vars" (); - let (++) = Set.union in + let ( ++ ) = Set.union in let collect cls t ~f = - Seq.fold (Term.enum cls t) ~init:Var.Set.empty - ~f:(fun acc x -> acc ++ f x) in + Seq.fold (Term.enum cls t) ~init:(Set.empty (module Var)) ~f:(fun acc x -> acc ++ f x) + in let sub_free sub = Sub.free_vars sub |> Set.filter ~f:Var.is_physical in let sub_args sub = collect arg_t sub ~f:(fun arg -> - Set.add (Exp.free_vars (Arg.rhs arg)) (Arg.lhs arg)) in + Set.add (Exp.free_vars (Arg.rhs arg)) (Arg.lhs arg)) + in collect sub_t prog ~f:(fun sub -> sub_args sub ++ sub_free sub) let process_sub free can_touch sub = @@ -128,27 +125,32 @@ let process_sub free can_touch sub = let s = propagate_consts can_touch s in let dead' = compute_dead can_touch free s in let dead = Set.union dead dead' in - if Set.is_empty dead' then s, dead - else loop dead (clean can_touch dead' s) in - let sub', dead = loop Tid.Set.empty (Sub.ssa sub) in + if Set.is_empty dead' then (s, dead) + else loop dead (clean can_touch dead' s) + in + let sub', dead = loop (Set.empty (module Tid)) (Sub.ssa sub) in O.create dead sub' let digest_of_sub sub level = - let add addrs t = match Term.get_attr t address with + let add addrs t = + match Term.get_attr t address with | None -> addrs - | Some a -> Set.add addrs a in + | Some a -> Set.add addrs a + in let addrs = - Term.to_sequence blk_t sub |> - Seq.fold ~init:(Set.empty (module Addr)) - ~f:(fun addrs b -> - Seq.fold (Blk.elts b) ~init:(add addrs b) - ~f:(fun addrs -> function - | `Def d -> add addrs d - | `Jmp j -> add addrs j - | `Phi p -> add addrs p)) in + Term.to_sequence blk_t sub + |> Seq.fold + ~init:(Set.empty (module Addr)) + ~f:(fun addrs b -> + Seq.fold (Blk.elts b) ~init:(add addrs b) ~f:(fun addrs -> function + | `Def d -> add addrs d + | `Jmp j -> add addrs j + | `Phi p -> add addrs p)) + in let digest = Digest.create ~namespace:"optimization" in - let digest = Set.fold addrs ~init:digest ~f:(fun d a -> - Digest.add d "%a" Addr.pp a) in + let digest = + Set.fold addrs ~init:digest ~f:(fun d a -> Digest.add d "%a" Addr.pp a) + in let digest = Digest.add digest "%s" (Sub.name sub) in Digest.add digest "%d" level @@ -162,69 +164,66 @@ let run level proj = match O.Cache.load digest with | Some data -> O.apply sub data | None -> - let data = process_sub free can_touch sub in - let sub = O.update sub data in - let data = O.find_unreachable sub data in - O.Cache.save digest data; - O.remove_dead_code sub data)) + let data = process_sub free can_touch sub in + let sub = O.update sub data in + let data = O.find_unreachable sub data in + O.Cache.save digest data; + O.remove_dead_code sub data)) let () = - Config.manpage [ - `S "SYNOPSIS"; - `Pre " - $(b,--)$(mname) -"; - `S "DESCRIPTION"; - - `P "An autorun pass that conservatively removes dead code. The - removed dead code is usually produced by a lifter, though it might - be possible that a binary indeed contains a dead code. The algorithm - doesn't remove variables that are stored in memory, only registers - are considered"; - - `S "ALGORITHM"; - - `P "Applies constant folding, dead code elimination, and constant - propagation in a loop until the fixed point is reached. The - algorithm is interprocedural, however it is not call graph - sensitive, as instead of considering the call graph we use an over - approximation that any function can call any other, thus any - variables that occurs free in any function is considered to be - non-constant. The algorithm is, however, flow sensitive on the - control flow graph level and uses the SSA form to encode data - facts. Since, it is not always safe to rely on the control flow - integrity and CFG precision, by default we optimize only flags and - virtual variables under a presumption that those two kind of data - points rarely used non-locally. - - See the $(b,--optimization-level) parameter for the list of - available optimization levels and their consequences."; - - `S "DEPENDENCIES"; - `P "$(b,bap-plugin-api)(1)"; - - `S "SEE ALSO"; - `P "$(b,bap-plugin-api)(1), $(b,bap-plugin-ssa)(1)"; - ]; + Config.manpage + [ + `S "SYNOPSIS"; + `Pre "\n $(b,--)$(mname)\n"; + `S "DESCRIPTION"; + `P + "An autorun pass that conservatively removes dead code. The\n\ + \ removed dead code is usually produced by a lifter, though it might\n\ + \ be possible that a binary indeed contains a dead code. The algorithm\n\ + \ doesn't remove variables that are stored in memory, only registers\n\ + \ are considered"; + `S "ALGORITHM"; + `P + "Applies constant folding, dead code elimination, and constant\n\ + \ propagation in a loop until the fixed point is reached. The\n\ + \ algorithm is interprocedural, however it is not call graph\n\ + \ sensitive, as instead of considering the call graph we use an over\n\ + \ approximation that any function can call any other, thus any\n\ + \ variables that occurs free in any function is considered to be\n\ + \ non-constant. The algorithm is, however, flow sensitive on the\n\ + \ control flow graph level and uses the SSA form to encode data\n\ + \ facts. Since, it is not always safe to rely on the control flow\n\ + \ integrity and CFG precision, by default we optimize only flags and\n\ + \ virtual variables under a presumption that those two kind of data\n\ + \ points rarely used non-locally.\n\n\ + \ See the $(b,--optimization-level) parameter for the list of\n\ + \ available optimization levels and their consequences."; + `S "DEPENDENCIES"; + `P "$(b,bap-plugin-api)(1)"; + `S "SEE ALSO"; + `P "$(b,bap-plugin-api)(1), $(b,bap-plugin-ssa)(1)"; + ]; let level = let doc = - "Specifies the optimization level. The higher the value the more - aggressive (and less safe) optimizations are applied. On level - 0 we touch nothing, only some constant folding may occur. On - level 1 we optimize only the synthetic code that was generated - by the lifter. Since such code can't leave a scope of instruction - it is not affected by the imprecision of a control flow graph. - On level 2, we also move and optimize processor flags. This - removes a significant amount of code and simplifies the program - and is a fair compromise between safety and performance. - (Since flags are rarely used non-locally). - Finally, on level 3 we extend our analysis to all variables." in - - Config.(param int ~default:0 ~doc "level") in - - Config.declare_extension - ~doc:"removes dead code and propagates constants" - ~provides:["pass"; "optimization"; "analysis"; "simplification"] - (fun {Config.get=(!)} -> - if !level > 0 - then Project.register_pass ~deps:["api"] ~autorun:true (run !level)) + "Specifies the optimization level. The higher the value the more\n\ + \ aggressive (and less safe) optimizations are applied. On level\n\ + \ 0 we touch nothing, only some constant folding may occur. On\n\ + \ level 1 we optimize only the synthetic code that was generated\n\ + \ by the lifter. Since such code can't leave a scope of instruction\n\ + \ it is not affected by the imprecision of a control flow graph.\n\ + \ On level 2, we also move and optimize processor flags. This\n\ + \ removes a significant amount of code and simplifies the program\n\ + \ and is a fair compromise between safety and performance.\n\ + \ (Since flags are rarely used non-locally).\n\ + \ Finally, on level 3 we extend our analysis to all variables." + in + + Config.(param int ~default:0 ~doc "level") + in + + Config.declare_extension ~doc:"removes dead code and propagates constants" + ~provides:[ "pass"; "optimization"; "analysis"; "simplification" ] + (fun { Config.get = ( ! ) } -> + if !level > 0 then + Project.register_pass ~deps:[ "api" ] ~runonce:false ~autorun:true + (run !level)) diff --git a/plugins/patterns/patterns_main.ml b/plugins/patterns/patterns_main.ml index 8406ad09c..38bf35d01 100644 --- a/plugins/patterns/patterns_main.ml +++ b/plugins/patterns/patterns_main.ml @@ -113,7 +113,7 @@ open Bap_core_theory open Bap.Std open Bap_main open Bap_primus.Std -module Sys = Caml.Sys +module Sys = Stdlib.Sys module Sigma = Primus.Lisp.Semantics module Lambda = Theory.Label @@ -999,7 +999,7 @@ module Rules = struct let empty = { cases = []; - known = Set.empty (module Action); + known = (Set.empty (module Action)); } let slot = KB.Class.property Theory.Unit.cls "pattern-rules" @@ -1029,7 +1029,7 @@ module Rules = struct let empty = { cases = []; - known = Set.empty (module Action); + known = (Set.empty (module Action)); } let concat x y = { @@ -1123,9 +1123,9 @@ end = struct Filename.concat folder file)) let dedup selected = - let empty = Set.empty (module String) in + let empty = (Set.empty (module String)) in List.fold selected ~init:(empty,empty) ~f:(fun (digests,files) file -> - let digest = Caml.Digest.file file in + let digest = Stdlib.Digest.file file in if Set.mem digests digest || Set.mem files file then digests,files else Set.add digests digest, @@ -1169,7 +1169,7 @@ end = struct include Bitvec_binprot end - let empty_roots = Set.empty (module Addr) + let empty_roots = (Set.empty (module Addr)) let empty_names = Bap_relation.empty Addr.compare String.compare type outcome = { @@ -1178,8 +1178,8 @@ end = struct } [@@deriving bin_io, compare, sexp, equal] let empty = { - roots = Set.empty (module Addr); - names = Map.empty (module Addr); + roots = (Set.empty (module Addr)); + names = (Map.empty (module Addr)); } let slot = KB.Class.property Theory.Unit.cls "patterns-outcome" diff --git a/plugins/phoenix/phoenix_root.ml b/plugins/phoenix/phoenix_root.ml index 02142002b..2f66460d8 100644 --- a/plugins/phoenix/phoenix_root.ml +++ b/plugins/phoenix/phoenix_root.ml @@ -1,6 +1,6 @@ open Core_kernel[@@warning "-D"] -module Sys = Caml.Sys +module Sys = Stdlib.Sys module Unix = Caml_unix exception Target_directory_is_a_file diff --git a/plugins/piqi_printers/dune b/plugins/piqi_printers/dune deleted file mode 100644 index a4f90d49b..000000000 --- a/plugins/piqi_printers/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name bap_piqi_printers_plugin) - (public_name bap-piqi.plugin) - (preprocess (pps ppx_bap)) - (libraries bap-piqi)) - -(plugin - (name piqi_printers) - (package bap-piqi) - (libraries bap-piqi.plugin) - (optional) - (site (bap-common plugins))) diff --git a/plugins/piqi_printers/piqi_printers_main.ml b/plugins/piqi_printers/piqi_printers_main.ml deleted file mode 100644 index e697573ac..000000000 --- a/plugins/piqi_printers/piqi_printers_main.ml +++ /dev/null @@ -1,71 +0,0 @@ -open Core_kernel[@@warning "-D"] -open Regular.Std -open Bap.Std -include Self() - - -let () = Config.manpage [ - `S "DESCRIPTION"; - `P - "Provide a serialization for BIR and BIL, using piqi - serialization files. The plugin provides five formats - of serialization: JSON, protobuf, textual, binary and XML."; - `P - "The serialization routines can be use programmatically, using - the Data interface, or from a print plugin"; - - `S "SEE ALSO"; - `P "$(b,regular)(3), $(b,bap-plugin-print)(1), $(b,bap-piqi)(3)" - ] - -module Bil = struct - open Bil_piqi - open Bir_piqi - - let writer f fmt = - let to_bytes s = f fmt s |> Bytes.of_string in - Data.Write.create ~to_bytes () - - let reader f fmt = - let of_bytes b = f fmt (Bytes.to_string b) in - Data.Read.create ~of_bytes () - - let ver = "0.1" - let desc_of_type = function - | `json -> "JSON" - | `pb -> "protobuf" - | `piq -> "textual" - | `pib -> "binary" - | `xml -> "XML" - let s fmt = - sprintf "Piqi generated %s serializer" (desc_of_type fmt) - - let register () = - List.iter all_of_fmt ~f:(fun fmt -> - let name = Sexp.to_string (sexp_of_fmt fmt) in - let desc = s fmt in - Stmt.add_reader ~desc ~ver name (reader stmt_of_string fmt); - Stmt.add_writer ~desc ~ver name (writer string_of_stmt fmt); - Exp.add_reader ~desc ~ver name (reader exp_of_string fmt); - Exp.add_writer ~desc ~ver name (writer string_of_exp fmt); - Bil.add_reader ~desc ~ver name (reader bil_of_string fmt); - Bil.add_writer ~desc ~ver name (writer string_of_bil fmt); - Sub.add_writer ~desc ~ver name (writer string_of_sub fmt); - Sub.add_reader ~desc ~ver name (reader sub_of_string fmt); - Blk.add_writer ~desc ~ver name (writer string_of_blk fmt); - Blk.add_reader ~desc ~ver name (reader blk_of_string fmt); - Arg.add_writer ~desc ~ver name (writer string_of_arg fmt); - Arg.add_reader ~desc ~ver name (reader arg_of_string fmt); - Phi.add_writer ~desc ~ver name (writer string_of_phi fmt); - Phi.add_reader ~desc ~ver name (reader phi_of_string fmt); - Def.add_writer ~desc ~ver name (writer string_of_def fmt); - Def.add_reader ~desc ~ver name (reader def_of_string fmt); - Program.add_writer ~desc ~ver name (writer string_of_program fmt); - Program.add_reader ~desc ~ver name (reader program_of_string fmt)) - -end - -let () = Config.declare_extension - ~doc:"provides piqi-based serialization for BIL and BIR" - ~provides:["printer"; "serialization"; "xml"; "json"; "protobuf"] - @@ fun _ -> Bil.register () diff --git a/plugins/piqi_printers/piqi_printers_main.mli b/plugins/piqi_printers/piqi_printers_main.mli deleted file mode 100644 index e69de29bb..000000000 diff --git a/plugins/powerpc/powerpc.ml b/plugins/powerpc/powerpc.ml index af8ed1662..fed596dc2 100644 --- a/plugins/powerpc/powerpc.ml +++ b/plugins/powerpc/powerpc.ml @@ -41,7 +41,7 @@ module Std = struct nth bit cpu.cr 2 := x = zero; ] - let lifters = String.Table.create () + let lifters = Hashtbl.create (module String) let register name lifter = Hashtbl.change lifters name ~f:(fun _ -> Some lifter) diff --git a/plugins/powerpc/powerpc.mli b/plugins/powerpc/powerpc.mli index 9ac219d38..711db6a9c 100644 --- a/plugins/powerpc/powerpc.mli +++ b/plugins/powerpc/powerpc.mli @@ -399,6 +399,11 @@ module Std : sig (** imm constructor - constructs an immediate from operand *) val imm : (op -> exp) ec + (** [immw width] is like [imm], but re-extends the sign from the + ISA-documented operand field [width], for backends that report + raw zero-extended fields (LLVM >= 15 PowerPC) *) + val immw : bitwidth -> (op -> exp) ec + (** var constructor - constructs a variable of bitwidth *) val var : (bitwidth -> exp) ec diff --git a/plugins/powerpc/powerpc_dsl.ml b/plugins/powerpc/powerpc_dsl.ml index c1664d590..7843ebdcc 100644 --- a/plugins/powerpc/powerpc_dsl.ml +++ b/plugins/powerpc/powerpc_dsl.ml @@ -27,11 +27,29 @@ let int_of_imm = function | Some x -> x | None -> ppc_fail "failed to convert imm operand to int" +(* [imm signed op] creates an immediate expression, trusting the value + reported by the disassembler backend. *) let imm signed op = let w = Word.of_int ~width:32 (int_of_imm op) in if signed then Exp.(signed @@ of_word w) else Exp.(unsigned @@ of_word w) +(* [immw width signed op] is like [imm], but [width] is the + ISA-documented width of the underlying operand field. Some LLVM + backends (PowerPC since ~LLVM 15) report raw zero-extended fields + instead of sign-decoded values, so when the value falls into the + upper half of the field and [signed] is requested, we re-extend the + sign from [width]. *) +let immw width signed op = + let v = int_of_imm op in + let v = + if width < 32 && v >= (1 lsl (width - 1)) && v < (1 lsl width) + then v - (1 lsl width) + else v in + let w = Word.of_int ~width:32 v in + if signed then Exp.(signed @@ of_word w) + else Exp.(unsigned @@ of_word w) + let signed f = f true let unsigned f = f false diff --git a/plugins/powerpc/powerpc_dsl.mli b/plugins/powerpc/powerpc_dsl.mli index f83c29ede..4714d8cb3 100644 --- a/plugins/powerpc/powerpc_dsl.mli +++ b/plugins/powerpc/powerpc_dsl.mli @@ -16,6 +16,11 @@ val bitwidth : int -> bitwidth val int_of_bitwidth : bitwidth -> int val imm : (op -> exp) ec + +(** [immw width] is like [imm], but re-extends the sign from the + ISA-documented operand field [width], for backends that report raw + zero-extended fields. *) +val immw : bitwidth -> (op -> exp) ec val var : (bitwidth -> exp) ec val reg : (reg -> exp) -> (op -> exp) ec val const : (bitwidth -> int -> exp) ec diff --git a/plugins/powerpc/powerpc_load.ml b/plugins/powerpc/powerpc_load.ml index e8640ad2a..b4033b0b1 100644 --- a/plugins/powerpc/powerpc_load.ml +++ b/plugins/powerpc/powerpc_load.ml @@ -9,19 +9,19 @@ open Powerpc.Std 83 eb ff fc - lwz r31, -4(r11) *) let lbz cpu ops = let rt = unsigned cpu.reg ops.(0) in - let im = signed imm ops.(1) in + let im = signed (immw halfword) ops.(1) in let ra = signed cpu.reg ops.(2) in RTL.[ rt := cpu.load (ra + im) byte; ] let lhz cpu ops = let rt = unsigned cpu.reg ops.(0) in - let im = signed imm ops.(1) in + let im = signed (immw halfword) ops.(1) in let ra = signed cpu.reg ops.(2) in RTL.[ rt := cpu.load (ra + im) halfword; ] let lwz cpu ops = let rt = unsigned cpu.reg ops.(0) in - let im = signed imm ops.(1) in + let im = signed (immw halfword) ops.(1) in let ra = signed cpu.reg ops.(2) in RTL.[ rt := cpu.load (ra + im) word; ] @@ -57,7 +57,7 @@ let lwzx cpu ops = 85 3f ff fc lwzu r9, -4(r31) *) let lbzu cpu ops = let rt = unsigned cpu.reg ops.(0) in - let im = signed imm ops.(2) in + let im = signed (immw halfword) ops.(2) in let ra = signed cpu.reg ops.(3) in RTL.[ rt := cpu.load (ra + im) byte; @@ -66,7 +66,7 @@ let lbzu cpu ops = let lhzu cpu ops = let rt = unsigned cpu.reg ops.(0) in - let im = signed imm ops.(2) in + let im = signed (immw halfword) ops.(2) in let ra = signed cpu.reg ops.(3) in RTL.[ rt := cpu.load (ra + im) halfword; @@ -75,7 +75,7 @@ let lhzu cpu ops = let lwzu cpu ops = let rt = unsigned cpu.reg ops.(0) in - let im = signed imm ops.(2) in + let im = signed (immw halfword) ops.(2) in let ra = signed cpu.reg ops.(3) in RTL.[ rt := cpu.load (ra + im) word; @@ -122,7 +122,7 @@ let lwzux cpu ops = a8 29 00 05 lha r1, 5(r9) *) let lha cpu ops = let rt = signed cpu.reg ops.(0) in - let im = signed imm ops.(1) in + let im = signed (immw halfword) ops.(1) in let ra = signed cpu.reg ops.(2) in RTL.[ rt := cpu.load (ra + im) halfword; @@ -168,7 +168,7 @@ let lwax cpu ops = let lhau cpu ops = let rt = signed cpu.reg ops.(0) in let ra = signed cpu.reg ops.(1) in - let im = signed imm ops.(2) in + let im = signed (immw halfword) ops.(2) in RTL.[ rt := cpu.load (ra + im) halfword; ra := ra + im diff --git a/plugins/powerpc/powerpc_model.ml b/plugins/powerpc/powerpc_model.ml index 26bd12c2a..6aa0df2f2 100644 --- a/plugins/powerpc/powerpc_model.ml +++ b/plugins/powerpc/powerpc_model.ml @@ -59,7 +59,7 @@ let make_name prefix i = sprintf "%s%d" prefix i let make_var_i typ prefix i = Var.create (make_name prefix i) typ let make_regs typ ?alias prefix range = - List.fold ~init:String.Map.empty ~f:(fun regs i -> + List.fold ~init:(Map.empty (module String)) ~f:(fun regs i -> let var = make_var_i typ prefix i in let name = Var.name var in let regs = Map.set regs name var in @@ -71,7 +71,7 @@ let make_regs typ ?alias prefix range = let make_regs_i typ prefix range = - List.fold ~init:Int.Map.empty ~f:(fun regs i -> + List.fold ~init:(Map.empty (module Int)) ~f:(fun regs i -> Map.set regs i (make_var_i typ prefix i)) range let flag name = Var.create name (Type.imm 1) @@ -150,13 +150,13 @@ module Vars (B : Bitwidth) = struct let cri = let _, bits = - List.fold (List.rev cr_bits) ~init:(0,Int.Map.empty) + List.fold (List.rev cr_bits) ~init:(0,Map.empty (module Int)) ~f:(fun (num, bits) bit -> num + 1, Map.set bits ~key:num ~data:bit) in bits let crn = - Int.Map.fold cri ~init:String.Map.empty + Map.fold cri ~init:(Map.empty (module String)) ~f:(fun ~key:_ ~data:var acc -> Map.set acc (Var.name var) var) @@ -172,11 +172,11 @@ module Vars (B : Bitwidth) = struct ] let cr_fields = - List.fold fields ~init:String.Map.empty ~f:(fun fs (name, _, fd) -> + List.fold fields ~init:(Map.empty (module String)) ~f:(fun fs (name, _, fd) -> Map.set fs name fd) let cri_fields = - List.fold fields ~init:Int.Map.empty ~f:(fun fs (_, index, fd) -> + List.fold fields ~init:(Map.empty (module Int)) ~f:(fun fs (_, index, fd) -> Map.set fs index fd) (** fixed precision flags *) @@ -211,7 +211,7 @@ module Exps(B : Bitwidth) = struct let cri = Map.map cri ~f:(fun v -> Exp.of_var v) let crn = - Int.Map.fold Vars.cri ~init:String.Map.empty + Map.fold Vars.cri ~init:(Map.empty (module String)) ~f:(fun ~key:_ ~data:var acc -> Map.set acc (Var.name var) (Exp.of_var var)) @@ -256,7 +256,7 @@ module Make_ppc(S : Spec) : PowerPC = struct let mem = Var.create "mem" (Type.mem S.addr_size `r8) - let flags = Var.Set.of_list [ + let flags = Set.of_list (module Var) [ so; ca; ca32; ov; ov32; Map.find_exn cri 0; Map.find_exn cri 1; @@ -285,16 +285,16 @@ module Make_cpu(P : PowerPC) : CPU = struct let gpr = let data = Map.data gpr in - List.fold data ~init:Var.Set.empty - ~f:(fun regs v -> Var.Set.add regs v) + List.fold data ~init:(Set.empty (module Var)) + ~f:(fun regs v -> Set.add regs v) - let sp = Var.Set.find_exn gpr ~f:(fun v -> String.equal (Var.name v) "R1") + let sp = Set.find_exn gpr ~f:(fun v -> String.equal (Var.name v) "R1") let vf = ov let cf = ca let nf = Map.find_exn cri 0 let zf = Map.find_exn cri 1 - let flags = Var.Set.of_list [ + let flags = Set.of_list (module Var) [ so; ca; ov; cf; nf; zf; ca32; ov32; ] diff --git a/plugins/powerpc/powerpc_rtl.ml b/plugins/powerpc/powerpc_rtl.ml index cafa6645b..021cfb933 100644 --- a/plugins/powerpc/powerpc_rtl.ml +++ b/plugins/powerpc/powerpc_rtl.ml @@ -222,7 +222,7 @@ module Exp = struct if width = e.width then { e with sign=Unsigned; } else match e.body with - | Vars (v,vars) when Caml.not (List.is_empty vars) -> + | Vars (v,vars) when Stdlib.not (List.is_empty vars) -> extract_of_vars e hi lo (v :: vars) | _ -> { sign=Unsigned; width; body = Extract (hi,lo,e.body) } diff --git a/plugins/powerpc/powerpc_store.ml b/plugins/powerpc/powerpc_store.ml index 28b5eb6c8..853bf2f67 100644 --- a/plugins/powerpc/powerpc_store.ml +++ b/plugins/powerpc/powerpc_store.ml @@ -9,19 +9,19 @@ open Powerpc.Std 91 28 ff d4 stw r9,-44(r8) *) let stb cpu ops = let rs = unsigned cpu.reg ops.(0) in - let im = signed imm ops.(1) in + let im = signed (immw halfword) ops.(1) in let ra = signed cpu.reg ops.(2) in RTL.[ cpu.store (ra + im) rs byte; ] let sth cpu ops = let rs = unsigned cpu.reg ops.(0) in - let im = signed imm ops.(1) in + let im = signed (immw halfword) ops.(1) in let ra = signed cpu.reg ops.(2) in RTL.[ cpu.store (ra + im) rs halfword; ] let stw cpu ops = let rs = unsigned cpu.reg ops.(0) in - let im = signed imm ops.(1) in + let im = signed (immw halfword) ops.(1) in let ra = signed cpu.reg ops.(2) in RTL.[ cpu.store (ra + im) rs word; ] @@ -64,7 +64,7 @@ let stdx cpu ops = 94 21 ff f0 stwu r1,-16(r1) *) let stbu cpu ops = let rs = unsigned cpu.reg ops.(1) in - let im = signed imm ops.(2) in + let im = signed (immw halfword) ops.(2) in let ra = signed cpu.reg ops.(3) in RTL.[ cpu.store (ra + im) rs byte; @@ -73,7 +73,7 @@ let stbu cpu ops = let sthu cpu ops = let rs = unsigned cpu.reg ops.(1) in - let im = signed imm ops.(2) in + let im = signed (immw halfword) ops.(2) in let ra = signed cpu.reg ops.(3) in RTL.[ cpu.store (ra + im) rs halfword; @@ -82,7 +82,7 @@ let sthu cpu ops = let stwu cpu ops = let rs = unsigned cpu.reg ops.(1) in - let im = signed imm ops.(2) in + let im = signed (immw halfword) ops.(2) in let ra = signed cpu.reg ops.(3) in RTL.[ cpu.store (ra + im) rs word; diff --git a/plugins/primus_dictionary/primus_dictionary_main.ml b/plugins/primus_dictionary/primus_dictionary_main.ml index b026e0017..6de0366ea 100644 --- a/plugins/primus_dictionary/primus_dictionary_main.ml +++ b/plugins/primus_dictionary/primus_dictionary_main.ml @@ -11,8 +11,8 @@ type t = { dicts : dict Primus.Value.Map.t; } -let pair key data = {dict = Primus.Value.Map.singleton key data} -let add key data s = {dict = Primus.Value.Map.set s.dict ~key ~data} +let pair key data = {dict = Map.singleton (module Primus.Value) key data} +let add key data s = {dict = Map.set s.dict ~key ~data} (* idea: initialize the dictionary with initial properties of a project and terms. @@ -21,7 +21,7 @@ let state = Primus.Machine.State.declare ~uuid:"F050079C-7FDB-4A8F-8A59-72C9693ADBCE" ~name:"lisp-dictionaries" (fun _ -> - {dicts = Primus.Value.Map.empty}) + {dicts = (Map.empty (module Primus.Value))}) module Pre(Machine : Primus.Machine.S) = struct include Machine.Syntax diff --git a/plugins/primus_exploring/primus_exploring_main.ml b/plugins/primus_exploring/primus_exploring_main.ml index 4496cae98..32252a13d 100644 --- a/plugins/primus_exploring/primus_exploring_main.ml +++ b/plugins/primus_exploring/primus_exploring_main.ml @@ -15,7 +15,7 @@ let state = Primus.Machine.State.declare ~name:"exploring-scheduler" (fun _ -> { pending=Fqueue.empty; - explored=Tid.Map.empty; + explored=(Map.empty (module Tid)); }) module Scheduler(Machine : Primus.Machine.S) = struct diff --git a/plugins/primus_limit/primus_limit_main.ml b/plugins/primus_limit/primus_limit_main.ml index 2f7625542..752574ee6 100644 --- a/plugins/primus_limit/primus_limit_main.ml +++ b/plugins/primus_limit/primus_limit_main.ml @@ -83,7 +83,7 @@ let state = Primus.Machine.State.declare ~name:"primus-limiter" ~uuid:"b1b58dff-54de-4611-abf8-88ff8f6c7481" (fun _ -> { - visited = Name.Map.empty; + visited = (Map.empty (module Name)); length = 0; }) diff --git a/plugins/primus_lisp/primus_lisp_documentation.ml b/plugins/primus_lisp/primus_lisp_documentation.ml index 090d80a5a..e25720dad 100644 --- a/plugins/primus_lisp/primus_lisp_documentation.ml +++ b/plugins/primus_lisp/primus_lisp_documentation.ml @@ -22,7 +22,7 @@ let fail prob = Error (Failed prob) let build_library index = let (%:) k v = Map.singleton (module String) k v in - let init = Map.empty (module String) in + let init = (Map.empty (module String)) in List.fold index ~init ~f:(fun library (cat,elts) -> let cat = Format.asprintf "%a" Doc.Category.pp cat in List.fold ~init:library elts ~f:(fun library (name,desc) -> diff --git a/plugins/primus_lisp/primus_lisp_ieee754.ml b/plugins/primus_lisp/primus_lisp_ieee754.ml index b07bf4475..724a6a361 100644 --- a/plugins/primus_lisp/primus_lisp_ieee754.ml +++ b/plugins/primus_lisp/primus_lisp_ieee754.ml @@ -104,7 +104,7 @@ module Primitives(Machine : Primus.Machine.S) = struct let is_nan x = Float.Class.(compare Nan (Float.classify x) = 0) - let init () = Machine.sequence Caml.[ + let init () = Machine.sequence Stdlib.[ define inf "add" ( +. ); define inf "sub" ( -. ); define inf "div" ( /. ); diff --git a/plugins/primus_lisp/primus_lisp_io.ml b/plugins/primus_lisp/primus_lisp_io.ml index 0f20aeb64..8cafe18ef 100644 --- a/plugins/primus_lisp/primus_lisp_io.ml +++ b/plugins/primus_lisp/primus_lisp_io.ml @@ -15,7 +15,7 @@ type state = { channels : channel Int.Map.t; } -let default_channels = Int.Map.of_alist_exn [ +let default_channels = Map.of_alist_exn (module Int) [ 0, { input = Some In_channel.stdin; output = Some Out_channel.stdout; @@ -59,7 +59,7 @@ let init_channels = Map.set chans ~key:fd ~data:chan) let init_redirections = - List.fold ~init:String.Map.empty ~f:(fun redirs (oldname,newname) -> + List.fold ~init:(Map.empty (module String)) ~f:(fun redirs (oldname,newname) -> match fd_of_name oldname with | Some _ -> redirs | None -> Map.set redirs ~key:oldname ~data:newname) @@ -90,8 +90,8 @@ let state = Primus.Machine.State.declare ~name:"io-channels" ~uuid:"f326a07d-16ed-42ec-958d-76ef584cb341" (fun _ -> { - redirections = String.Map.empty; - channels = Int.Map.empty; + redirections = (Map.empty (module String)); + channels = (Map.empty (module Int)); }) diff --git a/plugins/primus_lisp/primus_lisp_main.ml b/plugins/primus_lisp/primus_lisp_main.ml index 10c29b372..c69c2c4a2 100644 --- a/plugins/primus_lisp/primus_lisp_main.ml +++ b/plugins/primus_lisp/primus_lisp_main.ml @@ -4,7 +4,7 @@ open Bap.Std open Monads.Std open Bap_primus.Std open Format -module Sys = Caml.Sys +module Sys = Stdlib.Sys include Self() module Primitives = Primus_lisp_primitives diff --git a/plugins/primus_lisp/primus_lisp_primitives.ml b/plugins/primus_lisp/primus_lisp_primitives.ml index c067dec13..0a2420d8f 100644 --- a/plugins/primus_lisp/primus_lisp_primitives.ml +++ b/plugins/primus_lisp/primus_lisp_primitives.ml @@ -7,7 +7,7 @@ let registers = Primus.Machine.State.declare ~uuid:"3dd2b905-c019-4466-800f-95b13d7da85e" ~name:"backend-registers" @@ fun proj -> Project.disasm proj |> Disasm.insns |> - Seq.fold ~init:Int.Map.empty ~f:(fun regs (_,insn) -> + Seq.fold ~init:(Map.empty (module Int)) ~f:(fun regs (_,insn) -> Insn.ops insn |> Array.fold ~init:regs ~f:(fun regs -> function | Op.Reg r -> diff --git a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml index ee4b2e9bc..4fddc684d 100644 --- a/plugins/primus_lisp/primus_lisp_semantic_primitives.ml +++ b/plugins/primus_lisp/primus_lisp_semantic_primitives.ml @@ -256,6 +256,10 @@ let export = Primus.Lisp.Type.Spec.[ "get-current-program-counter", unit @-> int, "(get-current-program-counter) is an alias to (get-program-counter)"; + "get-instruction-length", unit @-> int, + "(get-instruction-length) returns the length of the current instruction \ + in bytes."; + "set-symbol-value", tuple [any; a] @-> a, "(set-symbol-value S X) sets the value of the symbol S to X. Returns X"; @@ -839,6 +843,12 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | None -> !!(empty s) | Some addr -> forget@@const_int s addr + let get_instruction_length s lbl = + let open Bap.Std in + KB.collect Memory.slot lbl >>= function + | None -> !!(empty s) + | Some mem -> forget@@int s (Memory.length mem) + let require_symbol v k = match symbol v with | Some name -> k name @@ -1479,6 +1489,7 @@ module Primitives(CT : Theory.Core)(T : Target) = struct | "store-word",_-> data@@store_word t args | "get-program-counter",[] | "get-current-program-counter",[] -> pure@@get_pc s lbl + | "get-instruction-length",[] -> pure@@get_instruction_length s lbl | "set-symbol-value",[sym;x] -> data@@set_symbol t sym x | "symbol-concat",syms -> pure@@symbol_concat s syms | "symbol",[x] -> pure@@mksymbol s x diff --git a/plugins/primus_lisp/site-lisp/llvm-x86-64-floats.lisp b/plugins/primus_lisp/site-lisp/llvm-x86-64-floats.lisp index e8980b26d..a75b833c5 100644 --- a/plugins/primus_lisp/site-lisp/llvm-x86-64-floats.lisp +++ b/plugins/primus_lisp/site-lisp/llvm-x86-64-floats.lisp @@ -24,7 +24,7 @@ (defun reg-val (reg) (case (reg-name reg) - 'RIP (+ (get-current-program-counter) 8) + 'RIP (+ (get-current-program-counter) (get-instruction-length)) 'RSP RSP 'RBP RBP (error "unknown register"))) diff --git a/plugins/primus_loader/primus_loader_basic.ml b/plugins/primus_loader/primus_loader_basic.ml index 2ceec6631..6ba6e294b 100644 --- a/plugins/primus_loader/primus_loader_basic.ml +++ b/plugins/primus_loader/primus_loader_basic.ml @@ -273,7 +273,7 @@ module Make(Param : Param)(Machine : Primus.Machine.S) = struct method! enter_blk = add method! enter_sub = add end in - visitor#run prog String.Map.empty + visitor#run prog (Map.empty (module String)) let init_names () = Machine.get () >>= fun proj -> diff --git a/plugins/primus_print/primus_print_main.ml b/plugins/primus_print/primus_print_main.ml index 0fc003c8f..bc02bff7c 100644 --- a/plugins/primus_print/primus_print_main.ml +++ b/plugins/primus_print/primus_print_main.ml @@ -112,7 +112,7 @@ let concat streams = facts or another derived fact. *) let process_rule rule = let module Prov = Primus.Observation.Provider in - let observing = String.Set.of_list (rule_providers rule) in + let observing = Set.of_list (module String) (rule_providers rule) in let facts,to_facts = Primus.Observation.list_providers () |> List.filter ~f:(fun p -> Set.mem observing (Prov.name p)) |> diff --git a/plugins/primus_promiscuous/primus_promiscuous_main.ml b/plugins/primus_promiscuous/primus_promiscuous_main.ml index e1779347c..f4a81c24f 100644 --- a/plugins/primus_promiscuous/primus_promiscuous_main.ml +++ b/plugins/primus_promiscuous/primus_promiscuous_main.ml @@ -65,7 +65,7 @@ let init_visited prog = if Term.has_attr blk Term.visited then Set.add visited (Term.tid blk) else visited - end)#run prog Tid.Set.empty + end)#run prog (Set.empty (module Tid)) let state = Primus.Machine.State.declare ~name:"conflicts" diff --git a/plugins/primus_propagate_taint/primus_propagate_taint_main.ml b/plugins/primus_propagate_taint/primus_propagate_taint_main.ml index 0ed15f0d2..76c762b20 100644 --- a/plugins/primus_propagate_taint/primus_propagate_taint_main.ml +++ b/plugins/primus_propagate_taint/primus_propagate_taint_main.ml @@ -25,9 +25,9 @@ let mapper = Primus.Machine.State.declare ~name:"primus-taint-mapper" ~uuid:"12511d75-e626-4b0d-8dcd-2a3b597992cf" (fun _ -> { - regs = Tid.Map.empty; - ptrs = Tid.Map.empty; - tids = Taint.Object.Map.empty; + regs = (Map.empty (module Tid)); + ptrs = (Map.empty (module Tid)); + tids = (Map.empty (module Taint.Object)); }) let is_mem v = match Var.typ v with @@ -64,7 +64,7 @@ module Intro(Machine : Primus.Machine.S) = struct kind t >>= fun k -> Object.create k >>= fun taint -> connect t taint >>| fun () -> - Taint.Object.Set.singleton taint + Set.singleton (module Taint.Object) taint let introduces def = List.find_map translation ~f:(fun (k,s,r) -> @@ -126,7 +126,7 @@ module Mapper(Machine : Primus.Machine.S) = struct ] let remap tids objs = - Tid.Set.filter_map objs ~f:(Map.find tids) + Set.filter_map (module Tid) objs ~f:(Base.Map.find tids) let update vars term = Machine.List.iter relations ~f:(fun (rel,fld) -> @@ -139,7 +139,7 @@ module Mapper(Machine : Primus.Machine.S) = struct else Field.fset fld s @@ Map.update (Field.get fld s) (Term.tid term) ~f:(function - | None -> Var.Map.singleton var taints + | None -> Map.singleton (module Var) var taints | Some taints' -> Map.update taints' var ~f:(function | None -> taints diff --git a/plugins/primus_random/primus_random_main.ml b/plugins/primus_random/primus_random_main.ml index 9303020f6..e859be35b 100644 --- a/plugins/primus_random/primus_random_main.ml +++ b/plugins/primus_random/primus_random_main.ml @@ -407,7 +407,7 @@ let main ctxt = ~name:"generators-for-arguments" @@ fun proj -> let prog = Project.program proj in Term.enum sub_t prog |> - Seq.fold ~init:{args=Var.Map.empty} ~f:(fun init sub -> + Seq.fold ~init:{args=(Map.empty (module Var))} ~f:(fun init sub -> Term.enum arg_t sub |> Seq.fold ~init ~f:(fun {args} arg -> if Poly.(Arg.intent arg = Some In) then {args} @@ -430,7 +430,7 @@ let main ctxt = let randomize_vars _ = Machine.get () >>= fun proj -> - vars_collector#run (Project.program proj) Var.Set.empty |> + vars_collector#run (Project.program proj) (Set.empty (module Var)) |> Set.to_sequence |> Machine.Seq.iter ~f:(fun var -> match Var.typ var with | Mem _ | Unk -> Machine.return () diff --git a/plugins/primus_region/primus_region_main.ml b/plugins/primus_region/primus_region_main.ml index 74f94f3e7..091bb1494 100644 --- a/plugins/primus_region/primus_region_main.ml +++ b/plugins/primus_region/primus_region_main.ml @@ -24,7 +24,7 @@ let state = Primus.Machine.State.declare ~uuid:"0FC4AF7F-7237-4CE1-874A-4971801C6D67" ~name:"region" (fun _ -> { - regions = Primus.Value.Map.empty; + regions = (Map.empty (module Primus.Value)); }) module Pre(Machine : Primus.Machine.S) = struct diff --git a/plugins/primus_round_robin/primus_round_robin_main.ml b/plugins/primus_round_robin/primus_round_robin_main.ml index 5076ef8c2..098391f22 100644 --- a/plugins/primus_round_robin/primus_round_robin_main.ml +++ b/plugins/primus_round_robin/primus_round_robin_main.ml @@ -17,7 +17,7 @@ let state = Primus.Machine.State.declare ~name:"round-robin-scheduler" (fun _ -> { pending = Fqueue.empty; - finished = Mid.Set.empty; + finished = (Set.empty (module Mid)); }) diff --git a/plugins/primus_symbolic_executor/primus_symbolic_executor_main.ml b/plugins/primus_symbolic_executor/primus_symbolic_executor_main.ml index 3596259a4..1f83e64ab 100644 --- a/plugins/primus_symbolic_executor/primus_symbolic_executor_main.ml +++ b/plugins/primus_symbolic_executor/primus_symbolic_executor_main.ml @@ -26,7 +26,7 @@ type memory = { let memories = Primus.Machine.State.declare ~uuid:"15dbb89a-3bfb-421c-8b19-16605425c3f5" ~name:"symbolic-memories" @@ fun _ -> - String.Map.empty + (Map.empty (module String)) module Bank = Primus.Memory.Descriptor module Id = Monad.State.Multi.Id @@ -367,8 +367,8 @@ type executor = { let executor = Primus.Machine.State.declare ~uuid:"e21aa0fe-bc37-48e3-b398-ce7e764843c8" ~name:"symbolic-executor-formulae" @@ fun _ -> { - values = Primus.Value.Id.Map.empty; - inputs = Set.empty (module Input); + values = (Map.empty (module Primus.Value.Id)); + inputs = (Set.empty (module Input)); } @@ -400,7 +400,7 @@ end = struct let context = Primus.Machine.State.declare ~uuid:"9538b1fa-b6c0-464a-b11e-22377a10b0b6" ~name:"symbolic-context" @@ fun _ -> { - assertions = Map.empty (module String); + assertions = (Map.empty (module String)); } @@ -430,7 +430,7 @@ end = struct let get scope = Machine.Local.get context >>| fun s -> match Map.find s.assertions scope with - | None -> Set.empty (module SMT.Formula) + | None -> (Set.empty (module SMT.Formula)) | Some xs -> xs end end @@ -579,8 +579,8 @@ let master = Primus.Machine.State.declare ~uuid:"8d2b41d4-4852-40e9-917a-33f1f5af01a1" ~name:"symbolic-executor-master" @@ fun _ -> { self = None; - tasks = Int.Map.empty; - tries = Tid.Map.empty; (* queued or finished forks *) + tasks = (Map.empty (module Int)); + tries = (Map.empty (module Tid)); (* queued or finished forks *) ready = 0; } @@ -593,8 +593,8 @@ let worker = Primus.Machine.State.declare task = { id = null; edge = None; - constraints = Set.empty (module SMT.Formula); - inputs = Set.empty (module Input); + constraints = (Set.empty (module SMT.Formula)); + inputs = (Set.empty (module Input)); }; } @@ -689,7 +689,7 @@ let forker ctxt : Primus.component = Set.add (cs ++ self.task.constraints) constr in Executor.inputs >>= fun inputs -> let inputs = - Seq.fold inputs ~init:self.task.inputs ~f:Set.add in + Seq.fold inputs ~init:self.task.inputs ~f:(fun s x -> Set.add s x) in let task = {inputs; constraints; edge; id=self.tid} in Machine.Global.update master ~f:(push_task task) @@ -733,7 +733,7 @@ let forker ctxt : Primus.component = let ready = s.ready + Map.length s.tasks in report_progress ~stage:(ready-1) ~total:ready (); Machine.Global.put master { - s with tasks = Int.Map.empty + s with tasks = (Map.empty (module Int)) } >>| fun () -> None | Some (m,t,ts) -> let queued = Map.length s.tasks in diff --git a/plugins/primus_systems/primus_systems_main.ml b/plugins/primus_systems/primus_systems_main.ml index 0a155e6c6..6574aca2a 100644 --- a/plugins/primus_systems/primus_systems_main.ml +++ b/plugins/primus_systems/primus_systems_main.ml @@ -45,7 +45,7 @@ open Core_kernel[@@warning "-D"] open Bap_main open Bap_primus.Std open Format -module Sys = Caml.Sys +module Sys = Stdlib.Sys let command what = sprintf " diff --git a/plugins/primus_test/primus_test_main.ml b/plugins/primus_test/primus_test_main.ml index 88e571682..2b063f7c2 100644 --- a/plugins/primus_test/primus_test_main.ml +++ b/plugins/primus_test/primus_test_main.ml @@ -135,8 +135,8 @@ module Location = struct let state = Primus.Machine.State.declare ~uuid:"22d66ae9-82ad-4185-a1f8-5eb99f5569df" ~name:"incident-locations" @@ fun _ -> { - incidents = String.Map.empty; - locations = Primus.Value.Map.empty; + incidents = (Map.empty (module String)); + locations = (Map.empty (module Primus.Value)); } let push pc machine t = @@ -177,7 +177,7 @@ module Location = struct let set_cls name id cls s = { s with incidents = Map.update s.incidents name ~f:(function - | None -> Primus.Value.Map.singleton id cls + | None -> Map.singleton (module Primus.Value) id cls | Some classes -> Map.set classes id cls) } diff --git a/plugins/primus_wandering/primus_wandering_main.ml b/plugins/primus_wandering/primus_wandering_main.ml index d8a7a0be3..55a12e59d 100644 --- a/plugins/primus_wandering/primus_wandering_main.ml +++ b/plugins/primus_wandering/primus_wandering_main.ml @@ -14,7 +14,7 @@ type t = { let state = Primus.Machine.State.declare ~uuid:"99883d0e-94b2-41a4-bce6-1e4a949fd919" ~name:"wandering-scheduler" - (fun _ -> {pending = Int.Map.empty}) + (fun _ -> {pending = (Map.empty (module Int))}) module Make (Random : sig val generator : Primus.generator end) @@ -55,7 +55,7 @@ module Make | _ -> Machine.switch id >>| fun () -> drop i t else Machine.forks () >>| fun fs -> { - pending = Seq.foldi fs ~init:Int.Map.empty ~f:(fun i cs id -> + pending = Seq.foldi fs ~init:(Map.empty (module Int)) ~f:(fun i cs id -> Map.set cs ~key:i ~data:id); } diff --git a/plugins/primus_x86/primus_x86_loader.ml b/plugins/primus_x86/primus_x86_loader.ml index c0a7fdc09..66047d886 100644 --- a/plugins/primus_x86/primus_x86_loader.ml +++ b/plugins/primus_x86/primus_x86_loader.ml @@ -27,7 +27,7 @@ module SetupPLT(Machine : Primus.Machine.S) = struct let intrinsics = let+ prog = Machine.gets Project.program in Term.enum sub_t prog |> - Seq.fold ~init:String.Set.empty ~f:(fun intrinsics sub -> + Seq.fold ~init:(Set.empty (module String)) ~f:(fun intrinsics sub -> if Term.has_attr sub Sub.intrinsic then Set.add intrinsics (Sub.name sub) else intrinsics) diff --git a/plugins/print/print_main.ml b/plugins/print/print_main.ml index 59b3c0884..53fb4ff7e 100644 --- a/plugins/print/print_main.ml +++ b/plugins/print/print_main.ml @@ -349,8 +349,8 @@ let setup_tabs ppf = pp_set_tab ppf () let sorted_blocks nodes = - let init = Set.empty (module Block) in - Seq.fold nodes ~init ~f:Set.add |> + let init = (Set.empty (module Block)) in + Seq.fold nodes ~init ~f:(fun s x -> Set.add s x) |> Set.to_sequence let sort_fns fns = diff --git a/plugins/propagate_taint/propagate_taint_main.ml b/plugins/propagate_taint/propagate_taint_main.ml index 4bebc0498..2c56ff45b 100644 --- a/plugins/propagate_taint/propagate_taint_main.ml +++ b/plugins/propagate_taint/propagate_taint_main.ml @@ -52,14 +52,14 @@ let contains_seed sub = let seeded callgraph subs = let callers sub = Graphlib.fold_reachable (module Graphs.Callgraph) callgraph - ~rev:true ~init:Tid.Set.empty ~f:Set.add (Term.tid sub) in + ~rev:true ~init:(Set.empty (module Tid)) ~f:(fun s x -> Set.add s x) (Term.tid sub) in Seq.filter subs ~f:contains_seed |> - Seq.fold ~init:Tid.Set.empty ~f:(fun subs sub -> + Seq.fold ~init:(Set.empty (module Tid)) ~f:(fun subs sub -> Set.add (Set.union subs @@ callers sub) (Term.tid sub)) let tids_of_sub sub = let terms t p = - Term.enum t p |> Seq.fold ~init:Tid.Set.empty ~f:(fun set t -> + Term.enum t p |> Seq.fold ~init:(Set.empty (module Tid)) ~f:(fun set t -> Set.add set (Term.tid t)) in let (++) = Set.union in let init = terms arg_t sub in @@ -81,12 +81,12 @@ module State = struct let create sub_total = { sub_count = 0; sub_total; - visited = Tid.Set.empty; - terms = Tid.Set.empty; + visited = (Set.empty (module Tid)); + terms = (Set.empty (module Tid)); taints = Taints.empty; } - let keys = Map.fold ~init:Tid.Set.empty ~f:(fun ~key ~data set -> + let keys = Map.fold ~init:(Set.empty (module Tid)) ~f:(fun ~key ~data set -> Set.add set key) let update_taints t taints = { diff --git a/plugins/propagate_taint/propagator.ml b/plugins/propagate_taint/propagator.ml index cb0aae100..132e27def 100644 --- a/plugins/propagate_taint/propagator.ml +++ b/plugins/propagate_taint/propagator.ml @@ -24,9 +24,9 @@ module Result = struct let empty = { - visited = Tid.Map.empty; - tainted_regs = Tid.Map.empty; - tainted_ptrs = Tid.Map.empty; + visited = (Map.empty (module Tid)); + tainted_regs = (Map.empty (module Tid)); + tainted_ptrs = (Map.empty (module Tid)); } let of_context ctxt = { @@ -37,7 +37,7 @@ module Result = struct let taints_of_tid taints tid : Taint.map = Map.find taints tid |> function - | None -> Var.Map.empty + | None -> (Map.empty (module Var)) | Some ts -> ts let tainted_regs t = taints_of_tid t.tainted_regs @@ -79,7 +79,7 @@ let propagate taints vars tid v r : taints = let ts = taints r in Map.change vars tid (function | None when Set.is_empty ts -> None - | None -> Some (Var.Map.of_alist_exn [v, ts]) + | None -> Some (Map.of_alist_exn (module Var) [v, ts]) | Some vs -> Option.some @@ Map.change vs v (function | None when Set.is_empty ts -> None | None -> Some ts @@ -90,8 +90,8 @@ class context ?max_steps ?max_loop p = object(self : 's) inherit Taint.context as taints inherit Conqueror.context ?max_steps ?max_loop p as super - val tvs : taints = Tid.Map.empty - val tms : taints = Tid.Map.empty + val tvs : taints = (Map.empty (module Tid)) + val tms : taints = (Map.empty (module Tid)) method tvs = tvs method tms = tms @@ -116,13 +116,13 @@ class context ?max_steps ?max_loop p = object(self : 's) end let taint_reg ctxt x seed = - ctxt#taint_reg x (Tid.Set.singleton seed) + ctxt#taint_reg x (Set.singleton (module Tid) seed) let taint_ptr ctxt x seed = match Bil.Result.value x with | Bil.Mem _ | Bil.Bot -> ctxt | Bil.Imm a -> - ctxt#taint_ptr a `r8 (Tid.Set.singleton seed) + ctxt#taint_ptr a `r8 (Set.singleton (module Tid) seed) let taint_result t ctxt v = match Term.get_attr t Taint.reg, Term.get_attr t Taint.ptr with diff --git a/plugins/raw/raw_main.ml b/plugins/raw/raw_main.ml index aba396903..4744dcceb 100644 --- a/plugins/raw/raw_main.ml +++ b/plugins/raw/raw_main.ml @@ -12,7 +12,7 @@ open Bap_main open Core_kernel[@@warning "-D"] open Extension.Syntax -module Buffer = Caml.Buffer +module Buffer = Stdlib.Buffer module Unix = Caml_unix module Spec = struct @@ -98,7 +98,7 @@ let register_loader ctxt = "length", Int64.to_string @@ match ctxt-->length with | None -> Int64.(measure input - (ctxt-->offset)) | Some n -> n; - ] |> String.Map.of_alist_exn in + ] |> Map.of_alist_exn (module String) in let buf = Buffer.create 128 in let ppf = Format.formatter_of_buffer buf in doc_template |> diff --git a/plugins/read_symbols/read_symbols_main.ml b/plugins/read_symbols/read_symbols_main.ml index 6ebd46a7f..6a72cf766 100644 --- a/plugins/read_symbols/read_symbols_main.ml +++ b/plugins/read_symbols/read_symbols_main.ml @@ -88,7 +88,7 @@ open Core_kernel[@@warning "-D"] open Bap_main open Bap_core_theory open KB.Syntax -module Sys = Caml.Sys +module Sys = Stdlib.Sys include Bap_main.Loggers() let anonymous_prefix = "__anonymous_sub%" diff --git a/plugins/report/report_main.ml b/plugins/report/report_main.ml index ca7f96c26..0ea1aa5c3 100644 --- a/plugins/report/report_main.ml +++ b/plugins/report/report_main.ml @@ -22,7 +22,7 @@ type tasks = slot String.Table.t let ping_frames = "|/-\\|/-\\" -let tasks = String.Table.create () +let tasks = Hashtbl.create (module String) let startup = Unix.gettimeofday () diff --git a/plugins/run/run_main.ml b/plugins/run/run_main.ml index f6b90c279..e32b263f4 100644 --- a/plugins/run/run_main.ml +++ b/plugins/run/run_main.ml @@ -145,10 +145,10 @@ let callgraph start prog = let all_subroutines ?(marked=false) prog = let entries = entry_points prog in let start = Tid.create () in - let roots = Tid.Set.of_list (start :: entries) in - let unmarked = if not marked then Tid.Set.empty else + let roots = Set.of_list (module Tid) (start :: entries) in + let unmarked = if not marked then (Set.empty (module Tid)) else Term.enum sub_t prog |> - Seq.fold ~init:Tid.Set.empty ~f:(fun unmarked sub -> + Seq.fold ~init:(Set.empty (module Tid)) ~f:(fun unmarked sub -> if Term.has_attr sub mark then unmarked else Set.add unmarked (Term.tid sub)) in let marked_non_root_to_entry t = diff --git a/plugins/strings/strings_main.ml b/plugins/strings/strings_main.ml index f11850517..3754499c3 100644 --- a/plugins/strings/strings_main.ml +++ b/plugins/strings/strings_main.ml @@ -22,7 +22,7 @@ let scan (mem,value) = | Error _ -> assert false | Ok n -> Some (Char.of_int_exn n) in Strings.Scanner.run ~read 0 |> - Seq.fold ~init:Addr.Map.empty ~f:(fun strs (off,str) -> + Seq.fold ~init:(Map.empty (module Addr)) ~f:(fun strs (off,str) -> Map.set strs ~key:(Addr.nsucc (Memory.min_addr mem) off) ~data:str) @@ -38,7 +38,7 @@ let union = Map.merge ~f:(fun ~key -> function let collect ~min_length proj = let ms = Project.memory proj |> Memmap.to_sequence in Seq.(ms >>| scan |> reduce ~f:union) |> function - | None -> Addr.Map.empty + | None -> (Map.empty (module Addr)) | Some strs -> Map.filteri strs ~f:(fun ~key ~data -> String.length data >= min_length) diff --git a/plugins/stub_resolver/stub_resolver.ml b/plugins/stub_resolver/stub_resolver.ml index 1b50f8751..a18068bdb 100644 --- a/plugins/stub_resolver/stub_resolver.ml +++ b/plugins/stub_resolver/stub_resolver.ml @@ -49,9 +49,9 @@ end let empty = { graph = G.empty; - names = String.Map.empty; - stubs = Tid.Set.empty; - units = Tid.Map.empty; + names = (Map.empty (module String)); + stubs = (Set.empty (module Tid)); + units = (Map.empty (module Tid)); } let in_file file f = @@ -115,7 +115,7 @@ let update_names t sub ~link_only ~no_link = let tid = Term.tid sub in let names = Set.fold aliases ~init:t.names ~f:(fun m a -> Map.update m a ~f:(function - | None -> Tid.Set.singleton tid + | None -> Set.singleton (module Tid) tid | Some s -> Set.add s tid)) in update_graph {t with names} (Sub.name sub) aliases else t @@ -127,7 +127,7 @@ let add t sub ~link_only ~no_link = let partition_group t group = Group.enum group |> - Seq.fold ~init:Tid.Set.empty ~f:(fun default name -> + Seq.fold ~init:(Set.empty (module Tid)) ~f:(fun default name -> Map.find t.names name |> Option.value_map ~default ~f:(Set.union default)) |> Set.partition_tf ~f:(Set.mem t.stubs) @@ -135,7 +135,7 @@ let partition_group t group = let find_pairs t = let pp = Group.pp String.pp in Graphlib.strong_components (module G) t.graph |> - Partition.groups |> Seq.fold ~init:Tid.Map.empty ~f:(fun init group -> + Partition.groups |> Seq.fold ~init:(Map.empty (module Tid)) ~f:(fun init group -> let stubs, reals = partition_group t group in match Set.length reals with | 1 -> @@ -195,8 +195,8 @@ let provide prog ~link_only ~no_link = KB.return obj let run - ?(link_only = String.Set.empty) - ?(no_link = String.Set.empty) + ?(link_only = Set.empty (module String)) + ?(no_link = Set.empty (module String)) prog = Toplevel.current () |> Knowledge.run Class.t (provide prog ~link_only ~no_link) |> function diff --git a/plugins/stub_resolver/stub_resolver_main.ml b/plugins/stub_resolver/stub_resolver_main.ml index d6a864bf0..f46877166 100644 --- a/plugins/stub_resolver/stub_resolver_main.ml +++ b/plugins/stub_resolver/stub_resolver_main.ml @@ -43,7 +43,7 @@ open Bap_core_theory open Bap_knowledge open Bap_main open KB.Syntax -module Sys = Caml.Sys +module Sys = Stdlib.Sys include Loggers() @@ -161,7 +161,7 @@ end = struct let stubs ctxt = List.fold (Extension.Configuration.get ctxt names) ~init:(Set.of_list (module String) known_stub_names) - ~f:(fun init -> List.fold ~init ~f:Set.add) + ~f:(fun init -> List.fold ~init ~f:(fun s x -> Set.add s x)) let create ctxt t doc = match Ogre.eval (collect t (stubs ctxt)) doc with | Ok plt -> plt @@ -232,7 +232,7 @@ end = struct let parse_file file = In_channel.read_lines file |> - List.foldi ~init:Word.Set.empty ~f:(fun number words line -> + List.foldi ~init:(Set.empty (module Word)) ~f:(fun number words line -> match parse_line line with | Empty | Comment -> words | Success word -> Set.add words word @@ -266,7 +266,7 @@ end = struct try Array.fold ~init:sigs (Sys.readdir folder) ~f:(fun sigs path -> add_file sigs (Filename.concat folder path)) with _ -> sigs in - List.fold ~init:Word.Set.empty paths ~f:(fun sigs path -> + List.fold ~init:(Set.empty (module Word)) paths ~f:(fun sigs path -> if Sys.file_exists path && Sys.is_directory path then add_files sigs path else add_file sigs path) @@ -364,10 +364,10 @@ let update prog ~link_only ~no_link = let resolver = Stub_resolver.run prog ~link_only ~no_link in let stubs = Stub_resolver.stubs resolver and links = Stub_resolver.links resolver in - let impls = Map.data links |> Tid.Set.of_list in + let impls = Map.data links |> Set.of_list (module Tid) in let stub_names = Term.enum sub_t prog |> - Seq.fold ~init:String.Set.empty ~f:(fun s sub -> + Seq.fold ~init:(Set.empty (module String)) ~f:(fun s sub -> if Set.mem stubs @@ Term.tid sub then Set.add s @@ Sub.name sub else s) in @@ -399,10 +399,10 @@ let update prog ~link_only ~no_link = let abi_pass ctxt = let link_only = - String.Set.of_list @@ + Set.of_list (module String) @@ Extension.Configuration.get ctxt link_only in let no_link = - String.Set.of_list @@ + Set.of_list (module String) @@ Extension.Configuration.get ctxt no_link in Project.map_program ~f:(update ~link_only ~no_link) diff --git a/plugins/thumb/thumb_branch.ml b/plugins/thumb/thumb_branch.ml index 16e933928..b0b92fbec 100644 --- a/plugins/thumb/thumb_branch.ml +++ b/plugins/thumb/thumb_branch.ml @@ -4,7 +4,7 @@ open KB.Syntax open Thumb_core -type eff = unit Theory.effect KB.t +type eff = unit Theory.eff0 KB.t let mask = W32.int32 0xffff_fffel diff --git a/plugins/thumb/thumb_branch.mli b/plugins/thumb/thumb_branch.mli index 932210e79..bbd9bed54 100644 --- a/plugins/thumb/thumb_branch.mli +++ b/plugins/thumb/thumb_branch.mli @@ -3,7 +3,7 @@ open Theory open Thumb_core open Thumb_opcodes -type eff = unit effect KB.t +type eff = unit Theory.eff0 KB.t module Make(CT : Theory.Core) : sig (** [b