diff options
Diffstat (limited to 'plugins/extraction')
| -rw-r--r-- | plugins/extraction/ExtrHaskellString.v | 2 | ||||
| -rw-r--r-- | plugins/extraction/ExtrOcamlString.v | 1 | ||||
| -rw-r--r-- | plugins/extraction/extract_env.ml | 6 | ||||
| -rw-r--r-- | plugins/extraction/extraction.ml | 24 | ||||
| -rw-r--r-- | plugins/extraction/plugin_base.dune | 5 | ||||
| -rw-r--r-- | plugins/extraction/table.ml | 16 |
6 files changed, 31 insertions, 23 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/extract_env.ml b/plugins/extraction/extract_env.ml index 4ede11b5c9..5d3115d8d7 100644 --- a/plugins/extraction/extract_env.ml +++ b/plugins/extraction/extract_env.ml @@ -710,10 +710,10 @@ let structure_for_compute env sg c = init false false ~compute:true; let ast, mlt = Extraction.extract_constr env sg c in let ast = Mlutil.normalize ast in - let refs = ref Refset.empty in - let add_ref r = refs := Refset.add r !refs in + let refs = ref GlobRef.Set.empty in + let add_ref r = refs := GlobRef.Set.add r !refs in let () = ast_iter_references add_ref add_ref add_ref ast in - let refs = Refset.elements !refs in + let refs = GlobRef.Set.elements !refs in let struc = optimize_struct (refs,[]) (mono_environment refs []) in (flatten_structure struc), ast, mlt 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; diff --git a/plugins/extraction/plugin_base.dune b/plugins/extraction/plugin_base.dune new file mode 100644 index 0000000000..037b0d5053 --- /dev/null +++ b/plugins/extraction/plugin_base.dune @@ -0,0 +1,5 @@ +(library + (name extraction_plugin) + (public_name coq.plugins.extraction) + (synopsis "Coq's extraction plugin") + (libraries num coq.plugins.ltac)) diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml index c3f4cfe654..e05e82af6f 100644 --- a/plugins/extraction/table.ml +++ b/plugins/extraction/table.ml @@ -30,8 +30,8 @@ let capitalize = String.capitalize (** Sets and maps for [global_reference] that use the "user" [kernel_name] instead of the canonical one *) -module Refmap' = Refmap_env -module Refset' = Refset_env +module Refmap' = GlobRef.Map_env +module Refset' = GlobRef.Set_env (*S Utilities about [module_path] and [kernel_names] and [global_reference] *) @@ -213,12 +213,12 @@ let is_recursor = function (* NB: here, working modulo name equivalence is ok *) -let projs = ref (Refmap.empty : (inductive*int) Refmap.t) -let init_projs () = projs := Refmap.empty -let add_projection n kn ip = projs := Refmap.add (ConstRef kn) (ip,n) !projs -let is_projection r = Refmap.mem r !projs -let projection_arity r = snd (Refmap.find r !projs) -let projection_info r = Refmap.find r !projs +let projs = ref (GlobRef.Map.empty : (inductive*int) GlobRef.Map.t) +let init_projs () = projs := GlobRef.Map.empty +let add_projection n kn ip = projs := GlobRef.Map.add (ConstRef kn) (ip,n) !projs +let is_projection r = GlobRef.Map.mem r !projs +let projection_arity r = snd (GlobRef.Map.find r !projs) +let projection_info r = GlobRef.Map.find r !projs (*s Table of used axioms *) |