Skip to content

Commit

Permalink
Merge pull request #375 from toku-sa-n/support-extraction
Browse files Browse the repository at this point in the history
Support the extraction plugin
  • Loading branch information
ejgallego committed Feb 21, 2024
1 parent 5405ff0 commit 40a2a7a
Show file tree
Hide file tree
Showing 5 changed files with 65 additions and 2 deletions.
2 changes: 2 additions & 0 deletions CHANGES.md
Original file line number Diff line number Diff line change
@@ -1,6 +1,8 @@
## Version 0.19.1

- [serlib] Support `btauto` Coq plugin (@ejgallego, #362)
- [serlib] Support `extraction` Coq plugin (@ejgallego, @toku-sa-n,
#375, fixes #371)

## Version 0.19.0

Expand Down
2 changes: 1 addition & 1 deletion serlib/plugins/extraction/dune
Original file line number Diff line number Diff line change
Expand Up @@ -2,5 +2,5 @@
(name serlib_extraction)
(public_name coq-serapi.serlib.extraction)
(synopsis "Serialization Library for Coq Fundind Plugin")
(preprocess (staged_pps ppx_import ppx_sexp_conv))
(preprocess (staged_pps ppx_import ppx_sexp_conv ppx_deriving_yojson ppx_hash ppx_compare))
(libraries coq-core.plugins.extraction serlib))
48 changes: 48 additions & 0 deletions serlib/plugins/extraction/ser_g_extraction.ml
Original file line number Diff line number Diff line change
@@ -1,4 +1,52 @@
open Serlib

open Sexplib.Conv
open Ppx_compare_lib.Builtin
open Ppx_hash_lib.Std.Hash.Builtin

module Names = Ser_names

module Extraction_plugin = struct
module G_extraction = Extraction_plugin.G_extraction
module Table = struct
type int_or_id =
[%import: Extraction_plugin.Table.int_or_id]
[@@deriving sexp,yojson,hash,compare]
type lang =
[%import: Extraction_plugin.Table.lang]
[@@deriving sexp,yojson,hash,compare]
end
end

module WitII = struct
type t = Extraction_plugin.Table.int_or_id
[@@deriving sexp,yojson,hash,compare]
end

let ser_wit_int_or_id = let module M = Ser_genarg.GS0(WitII) in M.genser

module WitL = struct
type raw = Extraction_plugin.Table.lang
[@@deriving sexp,yojson,hash,compare]
type glb = unit
[@@deriving sexp,yojson,hash,compare]
type top = unit
[@@deriving sexp,yojson,hash,compare]
end

let ser_wit_language = let module M = Ser_genarg.GS(WitL) in M.genser

module WitMN = struct
type t = string
[@@deriving sexp,yojson,hash,compare]
end

let ser_wit_mlname = let module M = Ser_genarg.GS0(WitMN) in M.genser

let register () =
Ser_genarg.register_genser Extraction_plugin.G_extraction.wit_int_or_id ser_wit_int_or_id;
Ser_genarg.register_genser Extraction_plugin.G_extraction.wit_language ser_wit_language;
Ser_genarg.register_genser Extraction_plugin.G_extraction.wit_mlname ser_wit_mlname;
()

let _ = register ()
7 changes: 6 additions & 1 deletion tests/genarg/dune
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,7 @@
(run chmod +w test_roundtrip)
; We insert the digest of the binaries to force a rebuild of the
; test cases if the binary has been modified.
(bash "echo \"# $(md5sum ../../sertop/sercomp.exe)\" >> test_roundtrip"))))
(bash "for i in ../../sertop/sercomp.exe ../../serlib/plugins/*/*.cmxs; do echo \"# $(md5sum $i)\"; done >> test_roundtrip"))))

(rule
(alias runtest)
Expand Down Expand Up @@ -57,6 +57,11 @@
(deps (:input exists.v))
(action (run ./test_roundtrip %{input})))

(rule
(alias runtest)
(deps (:input extraction.v))
(action (run ./test_roundtrip %{input})))

(rule
(alias runtest)
(deps (:input firstorder.v))
Expand Down
8 changes: 8 additions & 0 deletions tests/genarg/extraction.v
Original file line number Diff line number Diff line change
@@ -0,0 +1,8 @@
Require Coq.extraction.Extraction.

Extraction Language Haskell.

Extraction Implicit pred [1].

Axiom Y : Set -> Set -> Set.
Extract Constant Y "'a" "'b" => " 'a * 'b ".

0 comments on commit 40a2a7a

Please sign in to comment.