aboutsummaryrefslogtreecommitdiff
path: root/plugins/extraction
diff options
context:
space:
mode:
Diffstat (limited to 'plugins/extraction')
-rw-r--r--plugins/extraction/ExtrHaskellString.v2
-rw-r--r--plugins/extraction/ExtrOcamlString.v1
-rw-r--r--plugins/extraction/extraction.ml24
3 files changed, 15 insertions, 12 deletions
diff --git a/plugins/extraction/ExtrHaskellString.v b/plugins/extraction/ExtrHaskellString.v
index ac1f6f9130..a4a40d3c5a 100644
--- a/plugins/extraction/ExtrHaskellString.v
+++ b/plugins/extraction/ExtrHaskellString.v
@@ -35,6 +35,8 @@ Extract Inductive ascii => "Prelude.Char"
(Data.Bits.testBit (Data.Char.ord a) 6)
(Data.Bits.testBit (Data.Char.ord a) 7))".
Extract Inlined Constant Ascii.ascii_dec => "(Prelude.==)".
+Extract Inlined Constant Ascii.eqb => "(Prelude.==)".
Extract Inductive string => "Prelude.String" [ "([])" "(:)" ].
Extract Inlined Constant String.string_dec => "(Prelude.==)".
+Extract Inlined Constant String.eqb => "(Prelude.==)".
diff --git a/plugins/extraction/ExtrOcamlString.v b/plugins/extraction/ExtrOcamlString.v
index 030b486b26..a2a6a8fe67 100644
--- a/plugins/extraction/ExtrOcamlString.v
+++ b/plugins/extraction/ExtrOcamlString.v
@@ -33,6 +33,7 @@ Extract Constant shift =>
"fun b c -> Char.chr (((Char.code c) lsl 1) land 255 + if b then 1 else 0)".
Extract Inlined Constant ascii_dec => "(=)".
+Extract Inlined Constant Ascii.eqb => "(=)".
Extract Inductive string => "char list" [ "[]" "(::)" ].
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index 71e09992cc..67c605ea1d 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -1065,13 +1065,13 @@ let extract_constant env kn cb =
(match cb.const_body with
| Undef _ -> warn_info (); mk_typ_ax ()
| Def c ->
- (match Environ.is_projection kn env with
- | false -> mk_typ (get_body c)
- | true ->
- let pb = lookup_projection (Projection.make kn false) env in
- let ind = pb.Declarations.proj_ind in
+ (match Recordops.find_primitive_projection kn with
+ | None -> mk_typ (get_body c)
+ | Some p ->
+ let p = Projection.make p false in
+ let ind = Projection.inductive p in
let bodies = Inductiveops.legacy_match_projection env ind in
- let body = bodies.(pb.Declarations.proj_arg) in
+ let body = bodies.(Projection.arg p) in
mk_typ (EConstr.of_constr body))
| OpaqueDef c ->
add_opaque r;
@@ -1081,13 +1081,13 @@ let extract_constant env kn cb =
(match cb.const_body with
| Undef _ -> warn_info (); mk_ax ()
| Def c ->
- (match Environ.is_projection kn env with
- | false -> mk_def (get_body c)
- | true ->
- let pb = lookup_projection (Projection.make kn false) env in
- let ind = pb.Declarations.proj_ind in
+ (match Recordops.find_primitive_projection kn with
+ | None -> mk_def (get_body c)
+ | Some p ->
+ let p = Projection.make p false in
+ let ind = Projection.inductive p in
let bodies = Inductiveops.legacy_match_projection env ind in
- let body = bodies.(pb.Declarations.proj_arg) in
+ let body = bodies.(Projection.arg p) in
mk_def (EConstr.of_constr body))
| OpaqueDef c ->
add_opaque r;