From c02b80f6988415485b72d8f82fe5f21d696155bd Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Thu, 29 Aug 2024 16:12:17 +0200 Subject: [PATCH 01/38] [build] Fixup for result serapi problem. --- coq-lsp.opam | 3 +++ serlib_8_19/dune | 2 +- 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/coq-lsp.opam b/coq-lsp.opam index 917bdecb..2c1172ad 100644 --- a/coq-lsp.opam +++ b/coq-lsp.opam @@ -42,6 +42,9 @@ depends: [ "ocamlfind" {>= "1.8.1"} "zarith" {>= "1.11"} + # result dep, fixed in main, but kept for older releases + "result" { >= "1.5" } + # serlib deps: see what we need to keep for release "ppx_deriving" { >= "4.2.1" } "ppx_deriving_yojson" { >= "3.4" } diff --git a/serlib_8_19/dune b/serlib_8_19/dune index bd22ae5a..8d1620e4 100644 --- a/serlib_8_19/dune +++ b/serlib_8_19/dune @@ -9,4 +9,4 @@ ppx_hash ppx_compare ppx_deriving_yojson)) - (libraries coq-core.stm sexplib)) + (libraries result coq-core.stm sexplib)) From 99d59e8ebb0bff6c0660a53e5fec144ddf35c31d Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Thu, 29 Aug 2024 16:15:50 +0200 Subject: [PATCH 02/38] [build] Remove non-used serlib --- serlib_8_19/.ocamlformat | 1 - serlib_8_19/README.md | 105 --- serlib_8_19/dune | 12 - serlib_8_19/ide/ser_richpp.ml | 28 - serlib_8_19/ide/ser_richpp.mli | 27 - serlib_8_19/plugins/btauto/dune | 12 - serlib_8_19/plugins/cc/dune | 12 - serlib_8_19/plugins/extraction/dune | 12 - .../plugins/extraction/ser_g_extraction.ml | 60 -- serlib_8_19/plugins/firstorder/dune | 7 - .../plugins/firstorder/ser_g_ground.ml | 55 -- serlib_8_19/plugins/funind/dune | 7 - serlib_8_19/plugins/funind/ser_g_indfun.ml | 108 --- serlib_8_19/plugins/ltac/dune | 12 - serlib_8_19/plugins/ltac/ser_profile_ltac.ml | 43 - serlib_8_19/plugins/ltac/ser_profile_ltac.mli | 26 - serlib_8_19/plugins/ltac/ser_rewrite.ml | 43 - serlib_8_19/plugins/ltac/ser_rewrite.mli | 27 - serlib_8_19/plugins/ltac/ser_tacarg.ml | 478 ---------- serlib_8_19/plugins/ltac/ser_tacarg.mli | 20 - serlib_8_19/plugins/ltac/ser_tacentries.ml | 34 - serlib_8_19/plugins/ltac/ser_tacentries.mli | 23 - serlib_8_19/plugins/ltac/ser_tacenv.ml | 35 - serlib_8_19/plugins/ltac/ser_tacenv.mli | 26 - serlib_8_19/plugins/ltac/ser_tacexpr.ml | 828 ------------------ serlib_8_19/plugins/ltac/ser_tacexpr.mli | 272 ------ serlib_8_19/plugins/ltac2/dune | 12 - serlib_8_19/plugins/ltac2/ser_g_ltac2.ml | 47 - serlib_8_19/plugins/ltac2/ser_tac2env.ml | 89 -- serlib_8_19/plugins/ltac2/ser_tac2expr.ml | 197 ----- serlib_8_19/plugins/ltac2/ser_tac2quote.ml | 27 - serlib_8_19/plugins/micromega/dune | 12 - serlib_8_19/plugins/ring/dune | 7 - serlib_8_19/plugins/ring/ser_g_ring.ml | 93 -- serlib_8_19/plugins/ssr/dune | 17 - serlib_8_19/plugins/ssr/ser_ssrast.ml | 221 ----- serlib_8_19/plugins/ssr/ser_ssrequality.ml | 42 - serlib_8_19/plugins/ssr/ser_ssrparser.ml | 329 ------- serlib_8_19/plugins/ssr/wrap_ssrast.ml | 29 - serlib_8_19/plugins/ssrmatching/dune | 12 - .../plugins/ssrmatching/ser_ssrmatching.ml | 44 - serlib_8_19/plugins/syntax/dune | 12 - .../plugins/syntax/ser_g_number_syntax.ml | 81 -- serlib_8_19/plugins/syntax/ser_number.ml | 22 - serlib_8_19/plugins/tauto/dune | 12 - serlib_8_19/plugins/zify/dune | 12 - serlib_8_19/serType.ml | 199 ----- serlib_8_19/serType.mli | 91 -- serlib_8_19/ser_attributes.ml | 35 - serlib_8_19/ser_cAst.ml | 52 -- serlib_8_19/ser_cAst.mli | 24 - serlib_8_19/ser_cEphemeron.ml | 30 - serlib_8_19/ser_cMap.ml | 49 -- serlib_8_19/ser_cMap.mli | 32 - serlib_8_19/ser_cPrimitives.ml | 73 -- serlib_8_19/ser_cSet.ml | 46 - serlib_8_19/ser_cSet.mli | 30 - serlib_8_19/ser_cUnix.ml | 25 - serlib_8_19/ser_class_tactics.ml | 21 - serlib_8_19/ser_class_tactics.mli | 19 - serlib_8_19/ser_constr.ml | 255 ------ serlib_8_19/ser_constr.mli | 130 --- serlib_8_19/ser_constr_matching.ml | 23 - serlib_8_19/ser_constr_matching.mli | 24 - serlib_8_19/ser_constrexpr.ml | 186 ---- serlib_8_19/ser_constrexpr.mli | 109 --- serlib_8_19/ser_context.ml | 78 -- serlib_8_19/ser_context.mli | 65 -- serlib_8_19/ser_conv_oracle.ml | 34 - serlib_8_19/ser_conv_oracle.mli | 20 - serlib_8_19/ser_cooking.ml | 54 -- serlib_8_19/ser_cooking.mli | 19 - serlib_8_19/ser_coqargs.ml | 30 - serlib_8_19/ser_dAst.ml | 61 -- serlib_8_19/ser_dAst.mli | 21 - serlib_8_19/ser_declarations.ml | 196 ----- serlib_8_19/ser_declarations.mli | 104 --- serlib_8_19/ser_declaremods.ml | 39 - serlib_8_19/ser_declaremods.mli | 20 - serlib_8_19/ser_decls.ml | 33 - serlib_8_19/ser_deprecation.ml | 23 - serlib_8_19/ser_eConstr.ml | 49 -- serlib_8_19/ser_eConstr.mli | 40 - serlib_8_19/ser_entries.ml | 128 --- serlib_8_19/ser_environ.ml | 92 -- serlib_8_19/ser_environ.mli | 40 - serlib_8_19/ser_equality.ml | 25 - serlib_8_19/ser_evar.ml | 46 - serlib_8_19/ser_evar.mli | 23 - serlib_8_19/ser_evar_kinds.ml | 57 -- serlib_8_19/ser_evar_kinds.mli | 28 - serlib_8_19/ser_evd.ml | 41 - serlib_8_19/ser_evd.mli | 33 - serlib_8_19/ser_extend.ml | 55 -- serlib_8_19/ser_extend.mli | 45 - serlib_8_19/ser_feedback.ml | 46 - serlib_8_19/ser_feedback.mli | 53 -- serlib_8_19/ser_flags.ml | 18 - serlib_8_19/ser_flags.mli | 18 - serlib_8_19/ser_float64.ml | 28 - serlib_8_19/ser_future.ml | 22 - serlib_8_19/ser_genarg.ml | 372 -------- serlib_8_19/ser_genarg.mli | 96 -- serlib_8_19/ser_genintern.ml | 53 -- serlib_8_19/ser_genintern.mli | 35 - serlib_8_19/ser_geninterp.ml | 60 -- serlib_8_19/ser_geninterp.mli | 27 - serlib_8_19/ser_genredexpr.ml | 123 --- serlib_8_19/ser_genredexpr.mli | 45 - serlib_8_19/ser_glob_term.ml | 157 ---- serlib_8_19/ser_glob_term.mli | 59 -- serlib_8_19/ser_globnames.ml | 27 - serlib_8_19/ser_goal_select.ml | 27 - serlib_8_19/ser_goptions.ml | 45 - serlib_8_19/ser_goptions.mli | 39 - serlib_8_19/ser_gramlib.ml | 23 - serlib_8_19/ser_hints.ml | 51 -- serlib_8_19/ser_hints.mli | 32 - serlib_8_19/ser_impargs.ml | 70 -- serlib_8_19/ser_impargs.mli | 52 -- serlib_8_19/ser_int.ml | 26 - serlib_8_19/ser_int.mli | 20 - serlib_8_19/ser_inv.ml | 21 - serlib_8_19/ser_inv.mli | 20 - serlib_8_19/ser_lib.ml | 43 - serlib_8_19/ser_libnames.ml | 75 -- serlib_8_19/ser_libnames.mli | 20 - serlib_8_19/ser_libobject.ml | 73 -- serlib_8_19/ser_loadpath.ml | 24 - serlib_8_19/ser_loc.ml | 37 - serlib_8_19/ser_loc.mli | 26 - serlib_8_19/ser_locality.ml | 18 - serlib_8_19/ser_locus.ml | 84 -- serlib_8_19/ser_locus.mli | 79 -- serlib_8_19/ser_ltac_pretype.ml | 37 - serlib_8_19/ser_ltac_pretype.mli | 32 - serlib_8_19/ser_mod_subst.ml | 37 - serlib_8_19/ser_mod_subst.mli | 27 - serlib_8_19/ser_namegen.ml | 23 - serlib_8_19/ser_names.ml | 284 ------ serlib_8_19/ser_names.mli | 79 -- serlib_8_19/ser_nametab.ml | 23 - serlib_8_19/ser_nametab.mli | 20 - serlib_8_19/ser_nativevalues.ml | 57 -- serlib_8_19/ser_notation.ml | 25 - serlib_8_19/ser_notation.mli | 19 - serlib_8_19/ser_notation_gram.ml | 51 -- serlib_8_19/ser_notation_gram.mli | 43 - serlib_8_19/ser_notation_term.ml | 57 -- serlib_8_19/ser_notation_term.mli | 29 - serlib_8_19/ser_notationextern.ml | 32 - serlib_8_19/ser_notationextern.mli | 27 - serlib_8_19/ser_numTok.ml | 65 -- serlib_8_19/ser_opaqueproof.ml | 53 -- serlib_8_19/ser_opaqueproof.mli | 23 - serlib_8_19/ser_pattern.ml | 60 -- serlib_8_19/ser_pattern.mli | 29 - serlib_8_19/ser_pp.ml | 75 -- serlib_8_19/ser_pp.mli | 32 - serlib_8_19/ser_ppextend.ml | 49 -- serlib_8_19/ser_ppextend.mli | 41 - serlib_8_19/ser_pretype_errors.ml | 75 -- serlib_8_19/ser_pretype_errors.mli | 39 - serlib_8_19/ser_printer.ml | 22 - serlib_8_19/ser_proof_bullet.ml | 25 - serlib_8_19/ser_range.ml | 21 - serlib_8_19/ser_reduction.ml | 21 - serlib_8_19/ser_reduction.mli | 24 - serlib_8_19/ser_retroknowledge.ml | 32 - serlib_8_19/ser_retroknowledge.mli | 29 - serlib_8_19/ser_rtree.ml | 35 - serlib_8_19/ser_sList.ml | 42 - serlib_8_19/ser_safe_typing.ml | 83 -- serlib_8_19/ser_safe_typing.mli | 26 - serlib_8_19/ser_sorts.ml | 78 -- serlib_8_19/ser_sorts.mli | 36 - serlib_8_19/ser_stateid.ml | 28 - serlib_8_19/ser_stateid.mli | 19 - serlib_8_19/ser_stdarg.ml | 204 ----- serlib_8_19/ser_stdarg.mli | 18 - serlib_8_19/ser_stdlib.ml | 47 - serlib_8_19/ser_stm.ml | 35 - serlib_8_19/ser_stm.mli | 34 - serlib_8_19/ser_summary.ml | 26 - serlib_8_19/ser_tacred.ml | 24 - serlib_8_19/ser_tactics.ml | 36 - serlib_8_19/ser_tactics.mli | 25 - serlib_8_19/ser_tactypes.ml | 68 -- serlib_8_19/ser_tok.ml | 45 - serlib_8_19/ser_tok.mli | 28 - serlib_8_19/ser_type_errors.ml | 59 -- serlib_8_19/ser_type_errors.mli | 49 -- serlib_8_19/ser_typeclasses.ml | 25 - serlib_8_19/ser_typeclasses.mli | 19 - serlib_8_19/ser_uGraph.ml | 46 - serlib_8_19/ser_uGraph.mli | 36 - serlib_8_19/ser_uState.ml | 29 - serlib_8_19/ser_uint63.ml | 37 - serlib_8_19/ser_univ.ml | 102 --- serlib_8_19/ser_univ.mli | 37 - serlib_8_19/ser_univNames.ml | 31 - serlib_8_19/ser_universes.ml | 18 - serlib_8_19/ser_util.ml | 27 - serlib_8_19/ser_util.mli | 25 - serlib_8_19/ser_uvars.ml | 100 --- serlib_8_19/ser_uvars.mli | 35 - serlib_8_19/ser_vernacexpr.ml | 353 -------- serlib_8_19/ser_vernacexpr.mli | 293 ------- serlib_8_19/ser_vernacextend.ml | 52 -- serlib_8_19/ser_vmbytecodes.ml | 38 - serlib_8_19/ser_vmemitcodes.ml | 66 -- serlib_8_19/ser_vmemitcodes.mli | 25 - serlib_8_19/ser_vmvalues.ml | 63 -- serlib_8_19/ser_vmvalues.mli | 33 - serlib_8_19/ser_xml_datatype.ml | 28 - serlib_8_19/ser_xml_datatype.mli | 33 - serlib_8_19/serlib_base.ml | 52 -- serlib_8_19/serlib_base.mli | 34 - serlib_8_19/serlib_init.ml | 31 - serlib_8_19/serlib_init.mli | 27 - 220 files changed, 13083 deletions(-) delete mode 100644 serlib_8_19/.ocamlformat delete mode 100644 serlib_8_19/README.md delete mode 100644 serlib_8_19/dune delete mode 100644 serlib_8_19/ide/ser_richpp.ml delete mode 100644 serlib_8_19/ide/ser_richpp.mli delete mode 100644 serlib_8_19/plugins/btauto/dune delete mode 100644 serlib_8_19/plugins/cc/dune delete mode 100644 serlib_8_19/plugins/extraction/dune delete mode 100644 serlib_8_19/plugins/extraction/ser_g_extraction.ml delete mode 100644 serlib_8_19/plugins/firstorder/dune delete mode 100644 serlib_8_19/plugins/firstorder/ser_g_ground.ml delete mode 100644 serlib_8_19/plugins/funind/dune delete mode 100644 serlib_8_19/plugins/funind/ser_g_indfun.ml delete mode 100644 serlib_8_19/plugins/ltac/dune delete mode 100644 serlib_8_19/plugins/ltac/ser_profile_ltac.ml delete mode 100644 serlib_8_19/plugins/ltac/ser_profile_ltac.mli delete mode 100644 serlib_8_19/plugins/ltac/ser_rewrite.ml delete mode 100644 serlib_8_19/plugins/ltac/ser_rewrite.mli delete mode 100644 serlib_8_19/plugins/ltac/ser_tacarg.ml delete mode 100644 serlib_8_19/plugins/ltac/ser_tacarg.mli delete mode 100644 serlib_8_19/plugins/ltac/ser_tacentries.ml delete mode 100644 serlib_8_19/plugins/ltac/ser_tacentries.mli delete mode 100644 serlib_8_19/plugins/ltac/ser_tacenv.ml delete mode 100644 serlib_8_19/plugins/ltac/ser_tacenv.mli delete mode 100644 serlib_8_19/plugins/ltac/ser_tacexpr.ml delete mode 100644 serlib_8_19/plugins/ltac/ser_tacexpr.mli delete mode 100644 serlib_8_19/plugins/ltac2/dune delete mode 100644 serlib_8_19/plugins/ltac2/ser_g_ltac2.ml delete mode 100644 serlib_8_19/plugins/ltac2/ser_tac2env.ml delete mode 100644 serlib_8_19/plugins/ltac2/ser_tac2expr.ml delete mode 100644 serlib_8_19/plugins/ltac2/ser_tac2quote.ml delete mode 100644 serlib_8_19/plugins/micromega/dune delete mode 100644 serlib_8_19/plugins/ring/dune delete mode 100644 serlib_8_19/plugins/ring/ser_g_ring.ml delete mode 100644 serlib_8_19/plugins/ssr/dune delete mode 100644 serlib_8_19/plugins/ssr/ser_ssrast.ml delete mode 100644 serlib_8_19/plugins/ssr/ser_ssrequality.ml delete mode 100644 serlib_8_19/plugins/ssr/ser_ssrparser.ml delete mode 100644 serlib_8_19/plugins/ssr/wrap_ssrast.ml delete mode 100644 serlib_8_19/plugins/ssrmatching/dune delete mode 100644 serlib_8_19/plugins/ssrmatching/ser_ssrmatching.ml delete mode 100644 serlib_8_19/plugins/syntax/dune delete mode 100644 serlib_8_19/plugins/syntax/ser_g_number_syntax.ml delete mode 100644 serlib_8_19/plugins/syntax/ser_number.ml delete mode 100644 serlib_8_19/plugins/tauto/dune delete mode 100644 serlib_8_19/plugins/zify/dune delete mode 100644 serlib_8_19/serType.ml delete mode 100644 serlib_8_19/serType.mli delete mode 100644 serlib_8_19/ser_attributes.ml delete mode 100644 serlib_8_19/ser_cAst.ml delete mode 100644 serlib_8_19/ser_cAst.mli delete mode 100644 serlib_8_19/ser_cEphemeron.ml delete mode 100644 serlib_8_19/ser_cMap.ml delete mode 100644 serlib_8_19/ser_cMap.mli delete mode 100644 serlib_8_19/ser_cPrimitives.ml delete mode 100644 serlib_8_19/ser_cSet.ml delete mode 100644 serlib_8_19/ser_cSet.mli delete mode 100644 serlib_8_19/ser_cUnix.ml delete mode 100644 serlib_8_19/ser_class_tactics.ml delete mode 100644 serlib_8_19/ser_class_tactics.mli delete mode 100644 serlib_8_19/ser_constr.ml delete mode 100644 serlib_8_19/ser_constr.mli delete mode 100644 serlib_8_19/ser_constr_matching.ml delete mode 100644 serlib_8_19/ser_constr_matching.mli delete mode 100644 serlib_8_19/ser_constrexpr.ml delete mode 100644 serlib_8_19/ser_constrexpr.mli delete mode 100644 serlib_8_19/ser_context.ml delete mode 100644 serlib_8_19/ser_context.mli delete mode 100644 serlib_8_19/ser_conv_oracle.ml delete mode 100644 serlib_8_19/ser_conv_oracle.mli delete mode 100644 serlib_8_19/ser_cooking.ml delete mode 100644 serlib_8_19/ser_cooking.mli delete mode 100644 serlib_8_19/ser_coqargs.ml delete mode 100644 serlib_8_19/ser_dAst.ml delete mode 100644 serlib_8_19/ser_dAst.mli delete mode 100644 serlib_8_19/ser_declarations.ml delete mode 100644 serlib_8_19/ser_declarations.mli delete mode 100644 serlib_8_19/ser_declaremods.ml delete mode 100644 serlib_8_19/ser_declaremods.mli delete mode 100644 serlib_8_19/ser_decls.ml delete mode 100644 serlib_8_19/ser_deprecation.ml delete mode 100644 serlib_8_19/ser_eConstr.ml delete mode 100644 serlib_8_19/ser_eConstr.mli delete mode 100644 serlib_8_19/ser_entries.ml delete mode 100644 serlib_8_19/ser_environ.ml delete mode 100644 serlib_8_19/ser_environ.mli delete mode 100644 serlib_8_19/ser_equality.ml delete mode 100644 serlib_8_19/ser_evar.ml delete mode 100644 serlib_8_19/ser_evar.mli delete mode 100644 serlib_8_19/ser_evar_kinds.ml delete mode 100644 serlib_8_19/ser_evar_kinds.mli delete mode 100644 serlib_8_19/ser_evd.ml delete mode 100644 serlib_8_19/ser_evd.mli delete mode 100644 serlib_8_19/ser_extend.ml delete mode 100644 serlib_8_19/ser_extend.mli delete mode 100644 serlib_8_19/ser_feedback.ml delete mode 100644 serlib_8_19/ser_feedback.mli delete mode 100644 serlib_8_19/ser_flags.ml delete mode 100644 serlib_8_19/ser_flags.mli delete mode 100644 serlib_8_19/ser_float64.ml delete mode 100644 serlib_8_19/ser_future.ml delete mode 100644 serlib_8_19/ser_genarg.ml delete mode 100644 serlib_8_19/ser_genarg.mli delete mode 100644 serlib_8_19/ser_genintern.ml delete mode 100644 serlib_8_19/ser_genintern.mli delete mode 100644 serlib_8_19/ser_geninterp.ml delete mode 100644 serlib_8_19/ser_geninterp.mli delete mode 100644 serlib_8_19/ser_genredexpr.ml delete mode 100644 serlib_8_19/ser_genredexpr.mli delete mode 100644 serlib_8_19/ser_glob_term.ml delete mode 100644 serlib_8_19/ser_glob_term.mli delete mode 100644 serlib_8_19/ser_globnames.ml delete mode 100644 serlib_8_19/ser_goal_select.ml delete mode 100644 serlib_8_19/ser_goptions.ml delete mode 100644 serlib_8_19/ser_goptions.mli delete mode 100644 serlib_8_19/ser_gramlib.ml delete mode 100644 serlib_8_19/ser_hints.ml delete mode 100644 serlib_8_19/ser_hints.mli delete mode 100644 serlib_8_19/ser_impargs.ml delete mode 100644 serlib_8_19/ser_impargs.mli delete mode 100644 serlib_8_19/ser_int.ml delete mode 100644 serlib_8_19/ser_int.mli delete mode 100644 serlib_8_19/ser_inv.ml delete mode 100644 serlib_8_19/ser_inv.mli delete mode 100644 serlib_8_19/ser_lib.ml delete mode 100644 serlib_8_19/ser_libnames.ml delete mode 100644 serlib_8_19/ser_libnames.mli delete mode 100644 serlib_8_19/ser_libobject.ml delete mode 100644 serlib_8_19/ser_loadpath.ml delete mode 100644 serlib_8_19/ser_loc.ml delete mode 100644 serlib_8_19/ser_loc.mli delete mode 100644 serlib_8_19/ser_locality.ml delete mode 100644 serlib_8_19/ser_locus.ml delete mode 100644 serlib_8_19/ser_locus.mli delete mode 100644 serlib_8_19/ser_ltac_pretype.ml delete mode 100644 serlib_8_19/ser_ltac_pretype.mli delete mode 100644 serlib_8_19/ser_mod_subst.ml delete mode 100644 serlib_8_19/ser_mod_subst.mli delete mode 100644 serlib_8_19/ser_namegen.ml delete mode 100644 serlib_8_19/ser_names.ml delete mode 100644 serlib_8_19/ser_names.mli delete mode 100644 serlib_8_19/ser_nametab.ml delete mode 100644 serlib_8_19/ser_nametab.mli delete mode 100644 serlib_8_19/ser_nativevalues.ml delete mode 100644 serlib_8_19/ser_notation.ml delete mode 100644 serlib_8_19/ser_notation.mli delete mode 100644 serlib_8_19/ser_notation_gram.ml delete mode 100644 serlib_8_19/ser_notation_gram.mli delete mode 100644 serlib_8_19/ser_notation_term.ml delete mode 100644 serlib_8_19/ser_notation_term.mli delete mode 100644 serlib_8_19/ser_notationextern.ml delete mode 100644 serlib_8_19/ser_notationextern.mli delete mode 100644 serlib_8_19/ser_numTok.ml delete mode 100644 serlib_8_19/ser_opaqueproof.ml delete mode 100644 serlib_8_19/ser_opaqueproof.mli delete mode 100644 serlib_8_19/ser_pattern.ml delete mode 100644 serlib_8_19/ser_pattern.mli delete mode 100644 serlib_8_19/ser_pp.ml delete mode 100644 serlib_8_19/ser_pp.mli delete mode 100644 serlib_8_19/ser_ppextend.ml delete mode 100644 serlib_8_19/ser_ppextend.mli delete mode 100644 serlib_8_19/ser_pretype_errors.ml delete mode 100644 serlib_8_19/ser_pretype_errors.mli delete mode 100644 serlib_8_19/ser_printer.ml delete mode 100644 serlib_8_19/ser_proof_bullet.ml delete mode 100644 serlib_8_19/ser_range.ml delete mode 100644 serlib_8_19/ser_reduction.ml delete mode 100644 serlib_8_19/ser_reduction.mli delete mode 100644 serlib_8_19/ser_retroknowledge.ml delete mode 100644 serlib_8_19/ser_retroknowledge.mli delete mode 100644 serlib_8_19/ser_rtree.ml delete mode 100644 serlib_8_19/ser_sList.ml delete mode 100644 serlib_8_19/ser_safe_typing.ml delete mode 100644 serlib_8_19/ser_safe_typing.mli delete mode 100644 serlib_8_19/ser_sorts.ml delete mode 100644 serlib_8_19/ser_sorts.mli delete mode 100644 serlib_8_19/ser_stateid.ml delete mode 100644 serlib_8_19/ser_stateid.mli delete mode 100644 serlib_8_19/ser_stdarg.ml delete mode 100644 serlib_8_19/ser_stdarg.mli delete mode 100644 serlib_8_19/ser_stdlib.ml delete mode 100644 serlib_8_19/ser_stm.ml delete mode 100644 serlib_8_19/ser_stm.mli delete mode 100644 serlib_8_19/ser_summary.ml delete mode 100644 serlib_8_19/ser_tacred.ml delete mode 100644 serlib_8_19/ser_tactics.ml delete mode 100644 serlib_8_19/ser_tactics.mli delete mode 100644 serlib_8_19/ser_tactypes.ml delete mode 100644 serlib_8_19/ser_tok.ml delete mode 100644 serlib_8_19/ser_tok.mli delete mode 100644 serlib_8_19/ser_type_errors.ml delete mode 100644 serlib_8_19/ser_type_errors.mli delete mode 100644 serlib_8_19/ser_typeclasses.ml delete mode 100644 serlib_8_19/ser_typeclasses.mli delete mode 100644 serlib_8_19/ser_uGraph.ml delete mode 100644 serlib_8_19/ser_uGraph.mli delete mode 100644 serlib_8_19/ser_uState.ml delete mode 100644 serlib_8_19/ser_uint63.ml delete mode 100644 serlib_8_19/ser_univ.ml delete mode 100644 serlib_8_19/ser_univ.mli delete mode 100644 serlib_8_19/ser_univNames.ml delete mode 100644 serlib_8_19/ser_universes.ml delete mode 100644 serlib_8_19/ser_util.ml delete mode 100644 serlib_8_19/ser_util.mli delete mode 100644 serlib_8_19/ser_uvars.ml delete mode 100644 serlib_8_19/ser_uvars.mli delete mode 100644 serlib_8_19/ser_vernacexpr.ml delete mode 100644 serlib_8_19/ser_vernacexpr.mli delete mode 100644 serlib_8_19/ser_vernacextend.ml delete mode 100644 serlib_8_19/ser_vmbytecodes.ml delete mode 100644 serlib_8_19/ser_vmemitcodes.ml delete mode 100644 serlib_8_19/ser_vmemitcodes.mli delete mode 100644 serlib_8_19/ser_vmvalues.ml delete mode 100644 serlib_8_19/ser_vmvalues.mli delete mode 100644 serlib_8_19/ser_xml_datatype.ml delete mode 100644 serlib_8_19/ser_xml_datatype.mli delete mode 100644 serlib_8_19/serlib_base.ml delete mode 100644 serlib_8_19/serlib_base.mli delete mode 100644 serlib_8_19/serlib_init.ml delete mode 100644 serlib_8_19/serlib_init.mli diff --git a/serlib_8_19/.ocamlformat b/serlib_8_19/.ocamlformat deleted file mode 100644 index 593b6a1f..00000000 --- a/serlib_8_19/.ocamlformat +++ /dev/null @@ -1 +0,0 @@ -disable diff --git a/serlib_8_19/README.md b/serlib_8_19/README.md deleted file mode 100644 index 9edcbe8d..00000000 --- a/serlib_8_19/README.md +++ /dev/null @@ -1,105 +0,0 @@ -## Serlib README - -Welcome to `coq-serlib` README. - -`coq-serlib` is a library that declares missing serialization -functions (from/to JSON, sexp), comparison, and hash functions for -most Coq datatypes, allowing users to serialize full ASTs faithfully -for example, and many other interesting use cases. - -`coq-serlib` also includes support for [Coq's extensible syntax]() and -plugins. - -### Builtins and Configuration - -`serlib` provides some builtins and configuration values in the -`Serlib_base` and `Serlib_init` modules. - -### Serializing opaque and private types - -`serlib` uses `ppx_import` to retrieve the original type definitions -from Coq; when these are not available, we provide some helpers in the -`SerType` module. Current helpers are: - -- `Biject`: use when it is convenient to provide an isomorphic type to - the one that is "opaque". -- `Pierce`: use when it is not possible to access the type, you really - want to use a copy + `Obj.magic` -- `Opaque`: when you want to declare the type as non-serializable - -**note**: use of `Obj.magic` is now prohibited, all the type piercings -need to use the `Pierce` functor. - -### Serializing GADTS - -Unfortunately, it is not possible to easily serialize GADTS. For now, -we use a very ugly workaround: we basically copy the original Coq -datatype, in non-GADT version, then we pierce the type as their -representation is isomorphic. - -We will use an example from https://github.com/coq/coq/pull/17667#issuecomment-1714473449 : - -```ocaml -type _ gen_pattern = GPat : Genarg.glob_generic_argument -> [ `uninstantiated ] gen_pattern -``` - -In this case, we could indeed derive a serialization function (try -`[@@deriving of_sexp]` for example), however full serialization is -harder, so we may need to provide an alternative data-type: - -```ocaml -module GenPatternRep : SerType.Pierceable1 = struct - - type 'a t = 'a Pattern.gen_pattern - - type _ _t = GPat of Genarg.glob_generic_argument - [@@deriving sexp,yojson,hash,compare] -end - -module GenPatternSer = SerType.Pierce1(GenPatternRep) -type 'a gen_pattern = GenPatternSer.t [@@deriving sexp,yojson,hash,compare] -``` - -and here you go! The main problem with this approach is that it -requires a manual check for each use of `Pierce` and each Coq -version. Fortunately the numbers of `Pierce`'s so far have been very -low. - -### Pre-release checks - -Due to the above, when updating SerAPI for a new release to OPAM, we -must check that the definitions we are piercing are up to date. - -I perform this check with Emacs + Merlin for OCaml: - -- I do `vc-git-grep` for `Pierce(` and `Pierce1(` -- For each use, I use merlin to jump to the original type -- I compare update these types - -That's painful, but takes like 10 minutes, so for now it is doable a -couple of times a year. To illustrate, these are the current -occurrences to check: - -``` -serlib/plugins/ltac2/ser_tac2expr.ml:module T2E = Serlib.SerType.Pierce(T2ESpec) -serlib/plugins/ltac2/ser_tac2expr.ml:module GT2E = Serlib.SerType.Pierce(GT2ESpec) -serlib/ser_cooking.ml:module B_ = SerType.Pierce(CIP) -serlib/ser_environ.ml: include SerType.Pierce(PierceSpec) -serlib/ser_float64.ml:include SerType.Pierce(PierceSpec) -serlib/ser_impargs.ml:module B_ = SerType.Pierce(ISCPierceSpec) -serlib/ser_names.ml:include SerType.Pierce(MBIdBij) -serlib/ser_names.ml: include SerType.Pierce(PierceSpec) -serlib/ser_names.ml: include SerType.Pierce(PierceSpec) -serlib/ser_numTok.ml: include SerType.Pierce(PierceSpec) -serlib/ser_opaqueproof.ml:module B_ = SerType.Pierce(OP) -serlib/ser_opaqueproof.ml:module C_ = SerType.Pierce(OTSpec) -serlib/ser_rtree.ml:include SerType.Pierce1(RTreePierce) -serlib/ser_sList.ml:include SerType.Pierce1(SL) -serlib/ser_safe_typing.ml:module B_ = SerType.Pierce(PC) -serlib/ser_sorts.ml:include SerType.Pierce(PierceSpec) -serlib/ser_stateid.ml:include SerType.Pierce(SId) -serlib/ser_univ.ml: module PierceImp = SerType.Pierce(PierceSpec) -serlib/ser_univ.ml: include SerType.Pierce(PierceSpec) -serlib/ser_univ.ml: include SerType.Pierce(ACPierceDef) -serlib/ser_vmemitcodes.ml:module B = SerType.Pierce(PierceToPatch) -``` diff --git a/serlib_8_19/dune b/serlib_8_19/dune deleted file mode 100644 index 8d1620e4..00000000 --- a/serlib_8_19/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name serlib) - (public_name coq-lsp.serlib) - (synopsis "Serialization Library for Coq") - (preprocess - (staged_pps - ppx_import - ppx_sexp_conv - ppx_hash - ppx_compare - ppx_deriving_yojson)) - (libraries result coq-core.stm sexplib)) diff --git a/serlib_8_19/ide/ser_richpp.ml b/serlib_8_19/ide/ser_richpp.ml deleted file mode 100644 index df057313..00000000 --- a/serlib_8_19/ide/ser_richpp.ml +++ /dev/null @@ -1,28 +0,0 @@ -(************************************************************************) -(* v * The Coq Proof Assistant / The Coq Development Team *) -(* Richpp.richpp -val sexp_of_richpp : Richpp.richpp -> Sexp.t - -type 'a located = 'a Richpp.located - -val located_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a Richpp.located -val sexp_of_located : ('a -> Sexp.t) -> 'a Richpp.located -> Sexp.t diff --git a/serlib_8_19/plugins/btauto/dune b/serlib_8_19/plugins/btauto/dune deleted file mode 100644 index f29b7d50..00000000 --- a/serlib_8_19/plugins/btauto/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name serlib_btauto) - (public_name coq-lsp.serlib.btauto) - (synopsis "Serialization Library for Coq BTauto Plugin") - (preprocess - (staged_pps - ppx_import - ppx_sexp_conv - ppx_deriving_yojson - ppx_hash - ppx_compare)) - (libraries coq-core.plugins.btauto serlib sexplib)) diff --git a/serlib_8_19/plugins/cc/dune b/serlib_8_19/plugins/cc/dune deleted file mode 100644 index 28ca0e2d..00000000 --- a/serlib_8_19/plugins/cc/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name serlib_cc) - (public_name coq-lsp.serlib.cc) - (synopsis "Serialization Library for Coq Congruence Plugin") - (preprocess - (staged_pps - ppx_import - ppx_sexp_conv - ppx_deriving_yojson - ppx_hash - ppx_compare)) - (libraries coq-core.plugins.cc serlib sexplib)) diff --git a/serlib_8_19/plugins/extraction/dune b/serlib_8_19/plugins/extraction/dune deleted file mode 100644 index 2c19356c..00000000 --- a/serlib_8_19/plugins/extraction/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name serlib_extraction) - (public_name coq-lsp.serlib.extraction) - (synopsis "Serialization Library for Coq Fundind Plugin") - (preprocess - (staged_pps - ppx_import - ppx_sexp_conv - ppx_deriving_yojson - ppx_hash - ppx_compare)) - (libraries coq-core.plugins.extraction serlib)) diff --git a/serlib_8_19/plugins/extraction/ser_g_extraction.ml b/serlib_8_19/plugins/extraction/ser_g_extraction.ml deleted file mode 100644 index 85dc5caa..00000000 --- a/serlib_8_19/plugins/extraction/ser_g_extraction.ml +++ /dev/null @@ -1,60 +0,0 @@ -(************************************************************************) -(* SerAPI: Coq interaction protocol with bidirectional serialization *) -(************************************************************************) -(* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) -(* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) -(* Written by: Emilio J. Gallego Arias and others *) -(************************************************************************) - -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 () diff --git a/serlib_8_19/plugins/firstorder/dune b/serlib_8_19/plugins/firstorder/dune deleted file mode 100644 index ee351fc9..00000000 --- a/serlib_8_19/plugins/firstorder/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name serlib_firstorder) - (public_name coq-lsp.serlib.firstorder) - (synopsis "Serialization Library for Coq Firstorder Plugin") - (preprocess - (staged_pps ppx_import ppx_sexp_conv ppx_hash ppx_compare)) - (libraries coq-core.plugins.firstorder serlib sexplib)) diff --git a/serlib_8_19/plugins/firstorder/ser_g_ground.ml b/serlib_8_19/plugins/firstorder/ser_g_ground.ml deleted file mode 100644 index 06d54743..00000000 --- a/serlib_8_19/plugins/firstorder/ser_g_ground.ml +++ /dev/null @@ -1,55 +0,0 @@ -(************************************************************************) -(* SerAPI: Coq interaction protocol with bidirectional serialization *) -(************************************************************************) -(* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) -(* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) -(* Written by: Emilio J. Gallego Arias and others *) -(************************************************************************) - -open Serlib - -open Sexplib.Conv -open Ppx_compare_lib.Builtin -open Ppx_hash_lib.Std.Hash.Builtin - -module Loc = Ser_loc -module Names = Ser_names -module Libnames = Ser_libnames -module Locus = Ser_locus -(* module Globnames = Ser_globnames *) - -type h1 = Libnames.qualid list - [@@deriving sexp, hash, compare] - -type h2 = Names.GlobRef.t Loc.located Locus.or_var list -[@@deriving sexp, hash, compare] - -type h3 = Names.GlobRef.t list -[@@deriving sexp,hash,compare] - -let ser_wit_firstorder_using : - (Libnames.qualid list, - Names.GlobRef.t Loc.located Locus.or_var list, - Names.GlobRef.t list) Ser_genarg.gen_ser = - Ser_genarg.{ - raw_ser = sexp_of_h1 - ; raw_des = h1_of_sexp - ; raw_hash = hash_fold_h1 - ; raw_compare = compare_h1 - - ; glb_ser = sexp_of_h2 - ; glb_des = h2_of_sexp - ; glb_hash = hash_fold_h2 - ; glb_compare = compare_h2 - - ; top_ser = sexp_of_h3 - ; top_des = h3_of_sexp - ; top_hash = hash_fold_h3 - ; top_compare = compare_h3 - } - -let register () = - Ser_genarg.register_genser Firstorder_plugin.G_ground.wit_firstorder_using ser_wit_firstorder_using; - () - -let _ = register () diff --git a/serlib_8_19/plugins/funind/dune b/serlib_8_19/plugins/funind/dune deleted file mode 100644 index 591c0571..00000000 --- a/serlib_8_19/plugins/funind/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name serlib_funind) - (public_name coq-lsp.serlib.funind) - (synopsis "Serialization Library for Coq Fundind Plugin") - (preprocess - (staged_pps ppx_import ppx_sexp_conv ppx_hash ppx_compare)) - (libraries coq-core.plugins.funind serlib serlib_ltac sexplib)) diff --git a/serlib_8_19/plugins/funind/ser_g_indfun.ml b/serlib_8_19/plugins/funind/ser_g_indfun.ml deleted file mode 100644 index 05b6044a..00000000 --- a/serlib_8_19/plugins/funind/ser_g_indfun.ml +++ /dev/null @@ -1,108 +0,0 @@ -(************************************************************************) -(* SerAPI: Coq interaction protocol with bidirectional serialization *) -(************************************************************************) -(* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) -(* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) -(* Written by: Emilio J. Gallego Arias and others *) -(************************************************************************) - -open Serlib - -open Ppx_compare_lib.Builtin -open Ppx_hash_lib.Std.Hash.Builtin -open Sexplib.Conv - -module CAst = Ser_cAst -module Names = Ser_names -module Sorts = Ser_sorts -module Libnames = Ser_libnames -module Constrexpr = Ser_constrexpr -module Tactypes = Ser_tactypes -module Genintern = Ser_genintern -module EConstr = Ser_eConstr -module Tacexpr = Serlib_ltac.Ser_tacexpr - -module A1 = struct - -type h1 = Constrexpr.constr_expr Tactypes.intro_pattern_expr CAst.t option -[@@deriving sexp,hash,compare] -type h2 = Genintern.glob_constr_and_expr Tactypes.intro_pattern_expr CAst.t option -[@@deriving sexp,hash,compare] -type h3 = Tacexpr.intro_pattern option -[@@deriving sexp,hash,compare] - -end - -let ser_wit_with_names = - let open A1 in - Ser_genarg.{ - raw_ser = sexp_of_h1 - ; raw_des = h1_of_sexp - ; raw_hash = hash_fold_h1 - ; raw_compare = compare_h1 - - ; glb_ser = sexp_of_h2 - ; glb_des = h2_of_sexp - ; glb_hash = hash_fold_h2 - ; glb_compare = compare_h2 - - ; top_ser = sexp_of_h3 - ; top_des = h3_of_sexp - ; top_hash = hash_fold_h3 - ; top_compare = compare_h3 - } - -module WitFI = struct - type raw = Constrexpr.constr_expr Tactypes.with_bindings option - [@@deriving sexp,hash,compare] - type glb = Genintern.glob_constr_and_expr Tactypes.with_bindings option - [@@deriving sexp,hash,compare] - type top = EConstr.t Tactypes.with_bindings Ser_tactypes.delayed_open option - [@@deriving sexp,hash,compare] -end - -let ser_wit_fun_ind_using = let module M = Ser_genarg.GS(WitFI) in M.genser - -module WitFS = struct - type raw = Names.variable * Libnames.qualid * Sorts.family - [@@deriving sexp,hash,compare] - type glb = unit - [@@deriving sexp,hash,compare] - type top = unit - [@@deriving sexp,hash,compare] -end - -let ser_wit_fun_scheme_arg = let module M = Ser_genarg.GS(WitFS) in M.genser - -module Loc = Ser_loc -module Vernacexpr = Ser_vernacexpr - -module WFFD = struct - type t = Vernacexpr.fixpoint_expr Loc.located - [@@deriving sexp,hash,compare] -end - -let ser_wit_function_fix_definition = - let module M = Ser_genarg.GS0(WFFD) in M.genser - -module WAU = struct - type raw = Constrexpr.constr_expr list - [@@deriving sexp,hash,compare] - type glb = Genintern.glob_constr_and_expr list - [@@deriving sexp,hash,compare] - type top = EConstr.constr list - [@@deriving sexp,hash,compare] -end - -let ser_wit_auto_using' = let module M = Ser_genarg.GS(WAU) in M.genser - -let register () = - Ser_genarg.register_genser Funind_plugin.G_indfun.wit_auto_using' ser_wit_auto_using'; - Ser_genarg.register_genser Funind_plugin.G_indfun.wit_constr_comma_sequence' ser_wit_auto_using'; - Ser_genarg.register_genser Funind_plugin.G_indfun.wit_with_names ser_wit_with_names; - Ser_genarg.register_genser Funind_plugin.G_indfun.wit_fun_ind_using ser_wit_fun_ind_using; - Ser_genarg.register_genser Funind_plugin.G_indfun.wit_fun_scheme_arg ser_wit_fun_scheme_arg; - Ser_genarg.register_genser Funind_plugin.G_indfun.wit_function_fix_definition ser_wit_function_fix_definition; - () - -let _ = register () diff --git a/serlib_8_19/plugins/ltac/dune b/serlib_8_19/plugins/ltac/dune deleted file mode 100644 index b2668504..00000000 --- a/serlib_8_19/plugins/ltac/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name serlib_ltac) - (public_name coq-lsp.serlib.ltac) - (synopsis "Serialization Library for Coq [LTAC plugin]") - (preprocess - (staged_pps - ppx_import - ppx_sexp_conv - ppx_deriving_yojson - ppx_hash - ppx_compare)) - (libraries coq-core.plugins.ltac serlib sexplib)) diff --git a/serlib_8_19/plugins/ltac/ser_profile_ltac.ml b/serlib_8_19/plugins/ltac/ser_profile_ltac.ml deleted file mode 100644 index 2abec9e7..00000000 --- a/serlib_8_19/plugins/ltac/ser_profile_ltac.ml +++ /dev/null @@ -1,43 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* ITac.TacIntroPattern(a,b) - | Ltac_plugin.Tacexpr.TacApply (a,b,c,d) -> ITac.TacApply (a,b,c,d) - | Ltac_plugin.Tacexpr.TacElim (a,b,c) -> ITac.TacElim (a,b,c) - | Ltac_plugin.Tacexpr.TacCase (a,b) -> ITac.TacCase (a,b) - | Ltac_plugin.Tacexpr.TacMutualFix (a,b,c) -> ITac.TacMutualFix (a,b,c) - | Ltac_plugin.Tacexpr.TacMutualCofix (a,b) -> ITac.TacMutualCofix (a,b) - | Ltac_plugin.Tacexpr.TacAssert (a,b,c,d,e) -> ITac.TacAssert (a,b,c,d,e) - | Ltac_plugin.Tacexpr.TacGeneralize a -> ITac.TacGeneralize a - | Ltac_plugin.Tacexpr.TacLetTac (a,b,c,d,e,f) -> ITac.TacLetTac (a,b,c,d,e,f) - | Ltac_plugin.Tacexpr.TacInductionDestruct (a,b,c) -> ITac.TacInductionDestruct (a,b,c) - | Ltac_plugin.Tacexpr.TacReduce (a,b) -> ITac.TacReduce (a,b) - | Ltac_plugin.Tacexpr.TacChange (a,b,c,d) -> ITac.TacChange (a,b,c,d) - | Ltac_plugin.Tacexpr.TacRewrite (a,b,c,d) -> ITac.TacRewrite (a,b,c,d) - | Ltac_plugin.Tacexpr.TacInversion (a,b) -> ITac.TacInversion (a,b) -and _gen_tactic_arg_put (t : 'a Ltac_plugin.Tacexpr.gen_tactic_arg) : - ('t, 'dtrm, 'p, 'c, 'r, 'n, 'tacexpr, 'l) ITac.gen_tactic_arg = match t with - | Ltac_plugin.Tacexpr.TacGeneric (a,b) -> ITac.TacGeneric (a,b) - | Ltac_plugin.Tacexpr.ConstrMayEval a -> ITac.ConstrMayEval a - | Ltac_plugin.Tacexpr.Reference a -> ITac.Reference a - | Ltac_plugin.Tacexpr.TacCall l -> ITac.TacCall C.(map (fun (b,c) -> (b, List.map _gen_tactic_arg_put c)) l) - | Ltac_plugin.Tacexpr.TacFreshId a -> ITac.TacFreshId a - | Ltac_plugin.Tacexpr.Tacexp a -> ITac.Tacexp a - | Ltac_plugin.Tacexpr.TacPretype a -> ITac.TacPretype a - | Ltac_plugin.Tacexpr.TacNumgoals -> ITac.TacNumgoals -and _gen_tactic_expr_r_put (t : 'a Ltac_plugin.Tacexpr.gen_tactic_expr_r) : - ('t, 'dtrm, 'p, 'c, 'r, 'n, 'tacexpr, 'l) ITac.gen_tactic_expr_r = - let u x = _gen_tactic_expr_put x in - let uu x = List.map u x in - let ua x = Array.map u x in - match t with - | Ltac_plugin.Tacexpr.TacAtom l -> ITac.TacAtom (_gen_atomic_tactic_expr_put l) - | Ltac_plugin.Tacexpr.TacThen (a,b) -> ITac.TacThen (u a, u b) - | Ltac_plugin.Tacexpr.TacDispatch a -> ITac.TacDispatch (uu a) - | Ltac_plugin.Tacexpr.TacExtendTac (a,b,c) -> ITac.TacExtendTac (ua a, u b, ua c) - | Ltac_plugin.Tacexpr.TacThens (a,b) -> ITac.TacThens (u a, uu b) - | Ltac_plugin.Tacexpr.TacThens3parts (a,b,c,d) -> ITac.TacThens3parts (u a, ua b, u c, ua d) - | Ltac_plugin.Tacexpr.TacFirst a -> ITac.TacFirst (uu a) - | Ltac_plugin.Tacexpr.TacSolve a -> ITac.TacSolve (uu a) - | Ltac_plugin.Tacexpr.TacTry a -> ITac.TacTry (u a) - | Ltac_plugin.Tacexpr.TacOr (a,b) -> ITac.TacOr (u a, u b) - | Ltac_plugin.Tacexpr.TacOnce a -> ITac.TacOnce (u a) - | Ltac_plugin.Tacexpr.TacExactlyOnce a -> ITac.TacExactlyOnce (u a) - | Ltac_plugin.Tacexpr.TacIfThenCatch (a,b,c) -> ITac.TacIfThenCatch (u a,u b,u c) - | Ltac_plugin.Tacexpr.TacOrelse (a,b) -> ITac.TacOrelse (u a,u b) - | Ltac_plugin.Tacexpr.TacDo (a,b) -> ITac.TacDo (a,u b) - | Ltac_plugin.Tacexpr.TacTimeout (a,b) -> ITac.TacTimeout (a,u b) - | Ltac_plugin.Tacexpr.TacTime (a,b) -> ITac.TacTime (a,u b) - | Ltac_plugin.Tacexpr.TacRepeat a -> ITac.TacRepeat (u a) - | Ltac_plugin.Tacexpr.TacProgress a -> ITac.TacProgress (u a) - (* | Ltac_plugin.Tacexpr.TacShowHyps a -> ITac.TacShowHyps (u a) *) - | Ltac_plugin.Tacexpr.TacAbstract (a,b) -> ITac.TacAbstract (u a,b) - | Ltac_plugin.Tacexpr.TacId a -> ITac.TacId a - | Ltac_plugin.Tacexpr.TacFail (a,b,c) -> ITac.TacFail (a,b,c) - (* | Ltac_plugin.Tacexpr.TacInfo a -> ITac.TacInfo (u a) *) - (* | TacLetIn of rec_flag * *) - (* (Names.Id.t located * 'a gen_tactic_arg) list * *) - (* 'a gen_tactic_expr *) - | Ltac_plugin.Tacexpr.TacLetIn (a, l, t) -> - let _pt = List.map (fun (a,t) -> (a,_gen_tactic_arg_put t)) in - ITac.TacLetIn (a, _pt l, _gen_tactic_expr_put t) - (* | TacMatch of lazy_flag * *) - (* 'a gen_tactic_expr * *) - (* ('p,'a gen_tactic_expr) match_rule list *) - (* type ('a,'t) match_rule = *) - (* | Pat of 'a match_context_hyps list * 'a match_pattern * 't *) - (* | All of 't *) - | Ltac_plugin.Tacexpr.TacMatch (a, e, mr) -> - let _pmr = List.map (function - | Ltac_plugin.Tacexpr.Pat (a,b,t) -> Ltac_plugin.Tacexpr.Pat (a,b,_gen_tactic_expr_put t) - | Ltac_plugin.Tacexpr.All e -> Ltac_plugin.Tacexpr.All (_gen_tactic_expr_put e) - ) in - ITac.TacMatch(a, _gen_tactic_expr_put e, _pmr mr) - | Ltac_plugin.Tacexpr.TacMatchGoal (e, d, t) -> - let _pmr = List.map (function - | Ltac_plugin.Tacexpr.Pat (a,b,t) -> Ltac_plugin.Tacexpr.Pat (a,b,_gen_tactic_expr_put t) - | Ltac_plugin.Tacexpr.All e -> Ltac_plugin.Tacexpr.All (_gen_tactic_expr_put e) - ) in - ITac.TacMatchGoal(e, d, _pmr t) - | Ltac_plugin.Tacexpr.TacFun a -> ITac.TacFun (_gen_tactic_fun_ast_put a) - | Ltac_plugin.Tacexpr.TacArg l -> ITac.TacArg (_gen_tactic_arg_put l) - | Ltac_plugin.Tacexpr.TacSelect(gs,te) -> ITac.TacSelect(gs, _gen_tactic_expr_put te) - | Ltac_plugin.Tacexpr.TacML (l,m) -> ITac.TacML (l, List.map _gen_tactic_arg_put m) - | Ltac_plugin.Tacexpr.TacAlias (l,m) -> ITac.TacAlias (l, List.map _gen_tactic_arg_put m) -and _gen_tactic_expr_put (t : _ Ltac_plugin.Tacexpr.gen_tactic_expr) = - C.map _gen_tactic_expr_r_put t - -and _gen_tactic_fun_ast_put (t : 'a Ltac_plugin.Tacexpr.gen_tactic_fun_ast) : - ('t, 'dtrm, 'p, 'c, 'r, 'n, 'tacexpr, 'l) ITac.gen_tactic_fun_ast = - match t with - | (a,b) -> (a, _gen_tactic_expr_put b) - -let rec _gen_atom_tactic_expr_get (t : ('t, 'dtrm, 'p, 'c, 'r, 'n, 'tacexpr, 'l) ITac.gen_atomic_tactic_expr) : - 'a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr = match t with - | ITac.TacIntroPattern(a,b) -> Ltac_plugin.Tacexpr.TacIntroPattern(a,b) - | ITac.TacApply (a,b,c,d) -> Ltac_plugin.Tacexpr.TacApply (a,b,c,d) - | ITac.TacElim (a,b,c) -> Ltac_plugin.Tacexpr.TacElim (a,b,c) - | ITac.TacCase (a,b) -> Ltac_plugin.Tacexpr.TacCase (a,b) - | ITac.TacMutualFix (a,b,c) -> Ltac_plugin.Tacexpr.TacMutualFix (a,b,c) - | ITac.TacMutualCofix (a,b) -> Ltac_plugin.Tacexpr.TacMutualCofix (a,b) - | ITac.TacAssert (a,b,c,d,e) -> Ltac_plugin.Tacexpr.TacAssert (a,b,c,d,e) - | ITac.TacGeneralize a -> Ltac_plugin.Tacexpr.TacGeneralize a - | ITac.TacLetTac (a,b,c,d,e,f) -> Ltac_plugin.Tacexpr.TacLetTac (a,b,c,d,e,f) - | ITac.TacInductionDestruct (a,b,c) -> Ltac_plugin.Tacexpr.TacInductionDestruct (a,b,c) - | ITac.TacReduce (a,b) -> Ltac_plugin.Tacexpr.TacReduce (a,b) - | ITac.TacChange (a,b,c,d) -> Ltac_plugin.Tacexpr.TacChange (a,b,c,d) - | ITac.TacRewrite (a,b,c,d) -> Ltac_plugin.Tacexpr.TacRewrite (a,b,c,d) - | ITac.TacInversion (a,b) -> Ltac_plugin.Tacexpr.TacInversion (a,b) -and _gen_tactic_arg_get (t : ('t, 'dtrm, 'p, 'c, 'r, 'n, 'tacexpr, 'l) ITac.gen_tactic_arg) : - 'a Ltac_plugin.Tacexpr.gen_tactic_arg = match t with - | ITac.TacGeneric(a,b) -> Ltac_plugin.Tacexpr.TacGeneric (a,b) - | ITac.ConstrMayEval a -> Ltac_plugin.Tacexpr.ConstrMayEval a - | ITac.Reference a -> Ltac_plugin.Tacexpr.Reference a - | ITac.TacCall l -> Ltac_plugin.Tacexpr.TacCall C.(map (fun (b,c) -> (b, List.map _gen_tactic_arg_get c)) l) - | ITac.TacFreshId a -> Ltac_plugin.Tacexpr.TacFreshId a - | ITac.Tacexp a -> Ltac_plugin.Tacexpr.Tacexp a - | ITac.TacPretype a -> Ltac_plugin.Tacexpr.TacPretype a - | ITac.TacNumgoals -> Ltac_plugin.Tacexpr.TacNumgoals -and _gen_tactic_expr_r_get (t : ('t, 'dtrm, 'p, 'c, 'r, 'n, 'tacexpr, 'l) ITac.gen_tactic_expr_r) : - 'a Ltac_plugin.Tacexpr.gen_tactic_expr_r = - let u x = _gen_tactic_expr_get x in - let uu x = List.map u x in - let ua x = Array.map u x in - match t with - | ITac.TacAtom l -> Ltac_plugin.Tacexpr.TacAtom (_gen_atom_tactic_expr_get l) - | ITac.TacThen (a,b) -> Ltac_plugin.Tacexpr.TacThen (u a, u b) - | ITac.TacDispatch a -> Ltac_plugin.Tacexpr.TacDispatch (uu a) - | ITac.TacExtendTac (a,b,c) -> Ltac_plugin.Tacexpr.TacExtendTac (ua a, u b, ua c) - | ITac.TacThens (a,b) -> Ltac_plugin.Tacexpr.TacThens (u a, uu b) - | ITac.TacThens3parts (a,b,c,d) -> Ltac_plugin.Tacexpr.TacThens3parts (u a, ua b, u c, ua d) - | ITac.TacFirst a -> Ltac_plugin.Tacexpr.TacFirst (uu a) - | ITac.TacSolve a -> Ltac_plugin.Tacexpr.TacSolve (uu a) - | ITac.TacTry a -> Ltac_plugin.Tacexpr.TacTry (u a) - | ITac.TacOr (a,b) -> Ltac_plugin.Tacexpr.TacOr (u a, u b) - | ITac.TacOnce a -> Ltac_plugin.Tacexpr.TacOnce (u a) - | ITac.TacExactlyOnce a -> Ltac_plugin.Tacexpr.TacExactlyOnce (u a) - | ITac.TacIfThenCatch (a,b,c) -> Ltac_plugin.Tacexpr.TacIfThenCatch (u a,u b,u c) - | ITac.TacOrelse (a,b) -> Ltac_plugin.Tacexpr.TacOrelse (u a,u b) - | ITac.TacDo (a,b) -> Ltac_plugin.Tacexpr.TacDo (a,u b) - | ITac.TacTimeout (a,b) -> Ltac_plugin.Tacexpr.TacTimeout (a,u b) - | ITac.TacTime (a,b) -> Ltac_plugin.Tacexpr.TacTime (a,u b) - | ITac.TacRepeat a -> Ltac_plugin.Tacexpr.TacRepeat (u a) - | ITac.TacProgress a -> Ltac_plugin.Tacexpr.TacProgress (u a) - (* | ITac.TacShowHyps a -> Ltac_plugin.Tacexpr.TacShowHyps (u a) *) - | ITac.TacAbstract (a,b) -> Ltac_plugin.Tacexpr.TacAbstract (u a,b) - | ITac.TacId a -> Ltac_plugin.Tacexpr.TacId a - | ITac.TacFail (a,b,c) -> Ltac_plugin.Tacexpr.TacFail (a,b,c) - (* | ITac.TacInfo a -> Ltac_plugin.Tacexpr.TacInfo (u a) *) - | ITac.TacLetIn (a, l, t) -> - let _pt = List.map (fun (a,t) -> (a,_gen_tactic_arg_get t)) in - Ltac_plugin.Tacexpr.TacLetIn (a, _pt l, _gen_tactic_expr_get t) - | ITac.TacMatch (a,e,mr) -> - let _gmr = List.map (function - | Ltac_plugin.Tacexpr.Pat (a,b,t) -> Ltac_plugin.Tacexpr.Pat (a,b,_gen_tactic_expr_get t) - | Ltac_plugin.Tacexpr.All e -> Ltac_plugin.Tacexpr.All (_gen_tactic_expr_get e) - ) in - Ltac_plugin.Tacexpr.TacMatch(a, _gen_tactic_expr_get e, _gmr mr) - | ITac.TacMatchGoal (a,d,t) -> - let _gmr = List.map (function - | Ltac_plugin.Tacexpr.Pat (a,b,t) -> Ltac_plugin.Tacexpr.Pat (a,b,_gen_tactic_expr_get t) - | Ltac_plugin.Tacexpr.All e -> Ltac_plugin.Tacexpr.All (_gen_tactic_expr_get e) - ) in - Ltac_plugin.Tacexpr.TacMatchGoal(a,d, _gmr t) - | ITac.TacFun a -> Ltac_plugin.Tacexpr.TacFun (_gen_tactic_fun_ast_get a) - | ITac.TacArg l -> Ltac_plugin.Tacexpr.TacArg (_gen_tactic_arg_get l) - | ITac.TacSelect(gs,te) -> Ltac_plugin.Tacexpr.TacSelect(gs, _gen_tactic_expr_get te) - | ITac.TacML (l,m) -> Ltac_plugin.Tacexpr.TacML (l, List.map _gen_tactic_arg_get m) - | ITac.TacAlias (l,m) -> Ltac_plugin.Tacexpr.TacAlias (l, List.map _gen_tactic_arg_get m) - -and _gen_tactic_expr_get (t : ('t, 'dtrm, 'p, 'c, 'r, 'n, 'tacexpr, 'l) ITac.gen_tactic_expr) : - 'a Ltac_plugin.Tacexpr.gen_tactic_expr = - C.map _gen_tactic_expr_r_get t - -and _gen_tactic_fun_ast_get (t : ('t, 'dtrm, 'p, 'c, 'r, 'n, 'tacexpr, 'l) ITac.gen_tactic_fun_ast) : - 'a Ltac_plugin.Tacexpr.gen_tactic_fun_ast = - match t with - | (a,b) -> (a, _gen_tactic_expr_get b) - -type 'd gen_atomic_tactic_expr = 'd Ltac_plugin.Tacexpr.gen_atomic_tactic_expr - -(* Sexp part for generic functions *) - -let sexp_of_gen_atomic_tactic_expr - t d p c r n te l (tac : 'a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr) : Sexp.t = - ITac.sexp_of_gen_atomic_tactic_expr t d p c r n te l (_gen_atomic_tactic_expr_put tac) - -let sexp_of_gen_tactic_expr - t d p c r n te l (tac : 'a Ltac_plugin.Tacexpr.gen_tactic_expr) : Sexp.t = - ITac.sexp_of_gen_tactic_expr t d p c r n te l (_gen_tactic_expr_put tac) - -let sexp_of_gen_tactic_arg - t d p c r n te l (tac : 'a Ltac_plugin.Tacexpr.gen_tactic_arg) : Sexp.t = - ITac.sexp_of_gen_tactic_arg t d p c r n te l (_gen_tactic_arg_put tac) - -let sexp_of_gen_fun_ast - t d p c r n te l (tac : 'a Ltac_plugin.Tacexpr.gen_tactic_fun_ast) : Sexp.t = - ITac.sexp_of_gen_tactic_fun_ast t d p c r n te l (_gen_tactic_fun_ast_put tac) - -let gen_atomic_tactic_expr_of_sexp (tac : Sexp.t) - t d p c r n te l : 'a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr = - _gen_atom_tactic_expr_get (ITac.gen_atomic_tactic_expr_of_sexp t d p c r n te l tac) - -let gen_tactic_expr_of_sexp (tac : Sexp.t) - t d p c r n te l : 'a Ltac_plugin.Tacexpr.gen_tactic_expr = - _gen_tactic_expr_get (ITac.gen_tactic_expr_of_sexp t d p c r n te l tac) - -let gen_tactic_arg_of_sexp (tac : Sexp.t) - t d p c r n te l : 'a Ltac_plugin.Tacexpr.gen_tactic_arg = - _gen_tactic_arg_get (ITac.gen_tactic_arg_of_sexp t d p c r n te l tac) - -let gen_fun_ast_of_sexp (tac : Sexp.t) - t d p c r n te l : 'a Ltac_plugin.Tacexpr.gen_tactic_fun_ast = - _gen_tactic_fun_ast_get (ITac.gen_tactic_fun_ast_of_sexp t d p c r n te l tac) - -(* Yojson part for generic functions *) - -let gen_atomic_tactic_expr_to_yojson - t d p c r n te l (tac : 'a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr) : _ = - ITac.gen_atomic_tactic_expr_to_yojson t d p c r n te l (_gen_atomic_tactic_expr_put tac) - -let gen_tactic_expr_to_yojson - t d p c r n te l (tac : 'a Ltac_plugin.Tacexpr.gen_tactic_expr) : Yojson.Safe.t = - ITac.gen_tactic_expr_to_yojson t d p c r n te l (_gen_tactic_expr_put tac) - -let gen_tactic_expr_of_yojson tac - t d p c r n te l : ('a Ltac_plugin.Tacexpr.gen_tactic_expr, _) result = - Result.map _gen_tactic_expr_get (ITac.gen_tactic_expr_of_yojson t d p c r n te l tac) - -let gen_atomic_tactic_expr_of_yojson tac - t d p c r n te l : ('a Ltac_plugin.Tacexpr.gen_atomic_tactic_expr, _) result = - Result.map _gen_atom_tactic_expr_get (ITac.gen_atomic_tactic_expr_of_yojson t d p c r n te l tac) - -(* Hash part for generic functions *) - -let hash_fold_gen_tactic_expr t d p c r n te l st tac = - ITac.hash_fold_gen_tactic_expr t d p c r n te l st (_gen_tactic_expr_put tac) - -let hash_fold_gen_atomic_tactic_expr t d p c r n te l st tac = - ITac.hash_fold_gen_atomic_tactic_expr t d p c r n te l st (_gen_atomic_tactic_expr_put tac) - -(* Compare part for generic functions *) - -let compare_gen_tactic_expr t d p c r n te l t1 t2 : int = - ITac.compare_gen_tactic_expr t d p c r n te l (_gen_tactic_expr_put t1) (_gen_tactic_expr_put t2) - -let compare_gen_atomic_tactic_expr t d p c r n te l t1 t2 = - ITac.compare_gen_atomic_tactic_expr t d p c r n te l (_gen_atomic_tactic_expr_put t1) (_gen_atomic_tactic_expr_put t2) - -(************************************************************************) -(* Main tactics types, we follow tacexpr and provide glob,raw, and *) -(* atomic *) -(************************************************************************) - -(* Glob *) -type glob_tactic_expr = Ltac_plugin.Tacexpr.glob_tactic_expr -type glob_atomic_tactic_expr = Ltac_plugin.Tacexpr.glob_atomic_tactic_expr - -let rec glob_tactic_expr_of_sexp tac = - gen_tactic_expr_of_sexp - tac - Genintern.glob_constr_and_expr_of_sexp - Genintern.glob_constr_and_expr_of_sexp - Genintern.glob_constr_pattern_and_expr_of_sexp - (Locus.or_var_of_sexp (Genredexpr.and_short_name_of_sexp Tacred.evaluable_global_reference_of_sexp)) - (Locus.or_var_of_sexp (Loc.located_of_sexp ltac_constant_of_sexp)) - Names.lident_of_sexp - glob_tactic_expr_of_sexp - Genarg.glevel_of_sexp -and glob_atomic_tactic_expr_of_sexp tac = - gen_atomic_tactic_expr_of_sexp - tac - Genintern.glob_constr_and_expr_of_sexp - Genintern.glob_constr_and_expr_of_sexp - Genintern.glob_constr_pattern_and_expr_of_sexp - (Locus.or_var_of_sexp (Genredexpr.and_short_name_of_sexp Tacred.evaluable_global_reference_of_sexp)) - (Locus.or_var_of_sexp (Loc.located_of_sexp ltac_constant_of_sexp)) - Names.lident_of_sexp - glob_tactic_expr_of_sexp - Genarg.glevel_of_sexp - -let rec sexp_of_glob_tactic_expr (tac : glob_tactic_expr) = - sexp_of_gen_tactic_expr - Genintern.sexp_of_glob_constr_and_expr - Genintern.sexp_of_glob_constr_and_expr - Genintern.sexp_of_glob_constr_pattern_and_expr - (Locus.sexp_of_or_var (Genredexpr.sexp_of_and_short_name Tacred.sexp_of_evaluable_global_reference)) - (Locus.sexp_of_or_var (Loc.sexp_of_located sexp_of_ltac_constant)) - Names.sexp_of_lident - sexp_of_glob_tactic_expr - Genarg.sexp_of_glevel - tac -and sexp_of_glob_atomic_tactic_expr (tac : glob_atomic_tactic_expr) = - sexp_of_gen_atomic_tactic_expr - Genintern.sexp_of_glob_constr_and_expr - Genintern.sexp_of_glob_constr_and_expr - Genintern.sexp_of_glob_constr_pattern_and_expr - (Locus.sexp_of_or_var (Genredexpr.sexp_of_and_short_name Tacred.sexp_of_evaluable_global_reference)) - (Locus.sexp_of_or_var (Loc.sexp_of_located sexp_of_ltac_constant)) - Names.sexp_of_lident - sexp_of_glob_tactic_expr - Genarg.sexp_of_glevel - tac - -let rec glob_tactic_expr_of_yojson tac = - gen_tactic_expr_of_yojson - tac - Genintern.glob_constr_and_expr_of_yojson - Genintern.glob_constr_and_expr_of_yojson - Genintern.glob_constr_pattern_and_expr_of_yojson - (Locus.or_var_of_yojson (Genredexpr.and_short_name_of_yojson Tacred.evaluable_global_reference_of_yojson)) - (Locus.or_var_of_yojson (Loc.located_of_yojson ltac_constant_of_yojson)) - Names.lident_of_yojson - glob_tactic_expr_of_yojson - Genarg.glevel_of_yojson -and glob_atomic_tactic_expr_of_yojson tac = - gen_atomic_tactic_expr_of_yojson - tac - Genintern.glob_constr_and_expr_of_yojson - Genintern.glob_constr_and_expr_of_yojson - Genintern.glob_constr_pattern_and_expr_of_yojson - (Locus.or_var_of_yojson (Genredexpr.and_short_name_of_yojson Tacred.evaluable_global_reference_of_yojson)) - (Locus.or_var_of_yojson (Loc.located_of_yojson ltac_constant_of_yojson)) - Names.lident_of_yojson - glob_tactic_expr_of_yojson - Genarg.glevel_of_yojson - -let rec glob_tactic_expr_to_yojson tac = - gen_tactic_expr_to_yojson - Genintern.glob_constr_and_expr_to_yojson - Genintern.glob_constr_and_expr_to_yojson - Genintern.glob_constr_pattern_and_expr_to_yojson - (Locus.or_var_to_yojson (Genredexpr.and_short_name_to_yojson Tacred.evaluable_global_reference_to_yojson)) - (Locus.or_var_to_yojson (Loc.located_to_yojson ltac_constant_to_yojson)) - Names.lident_to_yojson - glob_tactic_expr_to_yojson - Genarg.glevel_to_yojson - tac -and glob_atomic_tactic_expr_to_yojson tac = - gen_atomic_tactic_expr_to_yojson - Genintern.glob_constr_and_expr_to_yojson - Genintern.glob_constr_and_expr_to_yojson - Genintern.glob_constr_pattern_and_expr_to_yojson - (Locus.or_var_to_yojson (Genredexpr.and_short_name_to_yojson Tacred.evaluable_global_reference_to_yojson)) - (Locus.or_var_to_yojson (Loc.located_to_yojson ltac_constant_to_yojson)) - Names.lident_to_yojson - glob_tactic_expr_to_yojson - Genarg.glevel_to_yojson - tac - -let rec hash_fold_glob_tactic_expr st tac = - hash_fold_gen_tactic_expr - Genintern.hash_fold_glob_constr_and_expr - Genintern.hash_fold_glob_constr_and_expr - Genintern.hash_fold_glob_constr_pattern_and_expr - (Locus.hash_fold_or_var (Genredexpr.hash_fold_and_short_name Tacred.hash_fold_evaluable_global_reference)) - (Locus.hash_fold_or_var (Loc.hash_fold_located hash_fold_ltac_constant)) - Names.hash_fold_lident - hash_fold_glob_tactic_expr - Genarg.hash_fold_glevel - st tac -and hash_fold_glob_atomic_tactic_expr st tac = - hash_fold_gen_atomic_tactic_expr - Genintern.hash_fold_glob_constr_and_expr - Genintern.hash_fold_glob_constr_and_expr - Genintern.hash_fold_glob_constr_pattern_and_expr - (Locus.hash_fold_or_var (Genredexpr.hash_fold_and_short_name Tacred.hash_fold_evaluable_global_reference)) - (Locus.hash_fold_or_var (Loc.hash_fold_located hash_fold_ltac_constant)) - Names.hash_fold_lident - hash_fold_glob_tactic_expr - Genarg.hash_fold_glevel - st tac - -let hash_glob_tactic_expr = Ppx_hash_lib.Std.Hash.of_fold hash_fold_glob_tactic_expr -let hash_glob_atomic_tactic_expr = Ppx_hash_lib.Std.Hash.of_fold hash_fold_glob_atomic_tactic_expr - -let rec compare_glob_tactic_expr tac = - compare_gen_tactic_expr - Genintern.compare_glob_constr_and_expr - Genintern.compare_glob_constr_and_expr - Genintern.compare_glob_constr_pattern_and_expr - (Locus.compare_or_var (Genredexpr.compare_and_short_name Tacred.compare_evaluable_global_reference)) - (Locus.compare_or_var (Loc.compare_located compare_ltac_constant)) - Names.compare_lident - compare_glob_tactic_expr - Genarg.compare_glevel - tac -and compare_glob_atomic_tactic_expr tac = - compare_gen_atomic_tactic_expr - Genintern.compare_glob_constr_and_expr - Genintern.compare_glob_constr_and_expr - Genintern.compare_glob_constr_pattern_and_expr - (Locus.compare_or_var (Genredexpr.compare_and_short_name Tacred.compare_evaluable_global_reference)) - (Locus.compare_or_var (Loc.compare_located compare_ltac_constant)) - Names.compare_lident - compare_glob_tactic_expr - Genarg.compare_glevel - tac - -(* Raw *) -type raw_tactic_expr = Ltac_plugin.Tacexpr.raw_tactic_expr -type raw_atomic_tactic_expr = Ltac_plugin.Tacexpr.raw_atomic_tactic_expr - -let rec raw_tactic_expr_of_sexp tac = - gen_tactic_expr_of_sexp - tac - Constrexpr.constr_expr_of_sexp - Constrexpr.constr_expr_of_sexp - Constrexpr.constr_pattern_expr_of_sexp - (Constrexpr.or_by_notation_of_sexp Libnames.qualid_of_sexp) - Libnames.qualid_of_sexp - Names.lident_of_sexp - raw_tactic_expr_of_sexp - Genarg.rlevel_of_sexp -and raw_atomic_tactic_expr_of_sexp tac = - gen_atomic_tactic_expr_of_sexp - tac - Constrexpr.constr_expr_of_sexp - Constrexpr.constr_expr_of_sexp - Constrexpr.constr_pattern_expr_of_sexp - (Constrexpr.or_by_notation_of_sexp Libnames.qualid_of_sexp) - Libnames.qualid_of_sexp - Names.lident_of_sexp - raw_tactic_expr_of_sexp - Genarg.rlevel_of_sexp - -let rec sexp_of_raw_tactic_expr (tac : raw_tactic_expr) = - sexp_of_gen_tactic_expr - Constrexpr.sexp_of_constr_expr - Constrexpr.sexp_of_constr_expr - Constrexpr.sexp_of_constr_pattern_expr - (Constrexpr.sexp_of_or_by_notation Libnames.sexp_of_qualid) - Libnames.sexp_of_qualid - Names.sexp_of_lident - sexp_of_raw_tactic_expr - Genarg.sexp_of_rlevel - tac -and sexp_of_raw_atomic_tactic_expr tac = - sexp_of_gen_atomic_tactic_expr - Constrexpr.sexp_of_constr_expr - Constrexpr.sexp_of_constr_expr - Constrexpr.sexp_of_constr_pattern_expr - (Constrexpr.sexp_of_or_by_notation Libnames.sexp_of_qualid) - Libnames.sexp_of_qualid - Names.sexp_of_lident - sexp_of_raw_tactic_expr - Genarg.sexp_of_rlevel - tac - -(* Yojson *) -let rec raw_tactic_expr_of_yojson tac = - gen_tactic_expr_of_yojson - tac - Constrexpr.constr_expr_of_yojson - Constrexpr.constr_expr_of_yojson - Constrexpr.constr_pattern_expr_of_yojson - (Constrexpr.or_by_notation_of_yojson Libnames.qualid_of_yojson) - Libnames.qualid_of_yojson - Names.lident_of_yojson - raw_tactic_expr_of_yojson - Genarg.rlevel_of_yojson -and raw_atomic_tactic_expr_of_yojson tac = - gen_atomic_tactic_expr_of_yojson - tac - Constrexpr.constr_expr_of_yojson - Constrexpr.constr_expr_of_yojson - Constrexpr.constr_pattern_expr_of_yojson - (Constrexpr.or_by_notation_of_yojson Libnames.qualid_of_yojson) - Libnames.qualid_of_yojson - Names.lident_of_yojson - raw_tactic_expr_of_yojson - Genarg.rlevel_of_yojson - -let rec raw_tactic_expr_to_yojson (tac : raw_tactic_expr) = - gen_tactic_expr_to_yojson - Constrexpr.constr_expr_to_yojson - Constrexpr.constr_expr_to_yojson - Constrexpr.constr_pattern_expr_to_yojson - (Constrexpr.or_by_notation_to_yojson Libnames.qualid_to_yojson) - Libnames.qualid_to_yojson - Names.lident_to_yojson - raw_tactic_expr_to_yojson - Genarg.rlevel_to_yojson - tac -and raw_atomic_tactic_expr_to_yojson tac = - gen_atomic_tactic_expr_to_yojson - Constrexpr.constr_expr_to_yojson - Constrexpr.constr_expr_to_yojson - Constrexpr.constr_pattern_expr_to_yojson - (Constrexpr.or_by_notation_to_yojson Libnames.qualid_to_yojson) - Libnames.qualid_to_yojson - Names.lident_to_yojson - raw_tactic_expr_to_yojson - Genarg.rlevel_to_yojson - tac - -let rec hash_fold_raw_tactic_expr st tac = - hash_fold_gen_tactic_expr - Constrexpr.hash_fold_constr_expr - Constrexpr.hash_fold_constr_expr - Constrexpr.hash_fold_constr_pattern_expr - (Constrexpr.hash_fold_or_by_notation Libnames.hash_fold_qualid) - Libnames.hash_fold_qualid - Names.hash_fold_lident - hash_fold_raw_tactic_expr - Genarg.hash_fold_rlevel - st tac -and hash_fold_raw_atomic_tactic_expr st tac = - hash_fold_gen_atomic_tactic_expr - Constrexpr.hash_fold_constr_expr - Constrexpr.hash_fold_constr_expr - Constrexpr.hash_fold_constr_pattern_expr - (Constrexpr.hash_fold_or_by_notation Libnames.hash_fold_qualid) - Libnames.hash_fold_qualid - Names.hash_fold_lident - hash_fold_raw_tactic_expr - Genarg.hash_fold_rlevel - st tac - -let hash_raw_tactic_expr = Ppx_hash_lib.Std.Hash.of_fold hash_fold_raw_tactic_expr -let hash_raw_atomic_tactic_expr = Ppx_hash_lib.Std.Hash.of_fold hash_fold_raw_atomic_tactic_expr - -let rec compare_raw_tactic_expr tac = - compare_gen_tactic_expr - Constrexpr.compare_constr_expr - Constrexpr.compare_constr_expr - Constrexpr.compare_constr_pattern_expr - (Constrexpr.compare_or_by_notation Libnames.compare_qualid) - Libnames.compare_qualid - Names.compare_lident - compare_raw_tactic_expr - Genarg.compare_rlevel - tac -and compare_raw_atomic_tactic_expr tac = - compare_gen_atomic_tactic_expr - Constrexpr.compare_constr_expr - Constrexpr.compare_constr_expr - Constrexpr.compare_constr_pattern_expr - (Constrexpr.compare_or_by_notation Libnames.compare_qualid) - Libnames.compare_qualid - Names.compare_lident - compare_raw_tactic_expr - Genarg.compare_rlevel - tac - -(* Atomic *) -type atomic_tactic_expr = Ltac_plugin.Tacexpr.atomic_tactic_expr - -let atomic_tactic_expr_of_sexp tac = - gen_atomic_tactic_expr_of_sexp tac - EConstr.t_of_sexp - Genintern.glob_constr_and_expr_of_sexp - Pattern.constr_pattern_of_sexp - Tacred.evaluable_global_reference_of_sexp - (Loc.located_of_sexp ltac_constant_of_sexp) - Names.Id.t_of_sexp - unit_of_sexp - Genarg.tlevel_of_sexp - -let sexp_of_atomic_tactic_expr tac = - sexp_of_gen_atomic_tactic_expr - EConstr.sexp_of_t - Genintern.sexp_of_glob_constr_and_expr - Pattern.sexp_of_constr_pattern - Tacred.sexp_of_evaluable_global_reference - (Loc.sexp_of_located sexp_of_ltac_constant) - Names.Id.sexp_of_t - sexp_of_unit - Genarg.sexp_of_tlevel - tac - -(* Helpers for raw_red_expr *) -type tacdef_body = - [%import: Ltac_plugin.Tacexpr.tacdef_body] - [@@deriving sexp,yojson,hash,compare] - -(* Unsupported serializers *) -type intro_pattern = - [%import: Ltac_plugin.Tacexpr.intro_pattern] - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/plugins/ltac/ser_tacexpr.mli b/serlib_8_19/plugins/ltac/ser_tacexpr.mli deleted file mode 100644 index 2d37a768..00000000 --- a/serlib_8_19/plugins/ltac/ser_tacexpr.mli +++ /dev/null @@ -1,272 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * INRIA, CNRS and contributors - Copyright 1999-2018 *) -(* direction_flag -val sexp_of_direction_flag : direction_flag -> Sexp.t - -type lazy_flag = Tacexpr.lazy_flag = General | Select | Once -val lazy_flag_of_sexp : Sexp.t -> lazy_flag -val sexp_of_lazy_flag : lazy_flag -> Sexp.t - -type global_flag = Tacexpr.global_flag = TacGlobal | TacLocal -val global_flag_of_sexp : Sexp.t -> global_flag -val sexp_of_global_flag : global_flag -> Sexp.t - -type evars_flag = bool -val evars_flag_of_sexp : Sexp.t -> evars_flag -val sexp_of_evars_flag : evars_flag -> Sexp.t - -type rec_flag = bool -val rec_flag_of_sexp : Sexp.t -> rec_flag -val sexp_of_rec_flag : rec_flag -> Sexp.t - -type advanced_flag = bool -val advanced_flag_of_sexp : Sexp.t -> advanced_flag -val sexp_of_advanced_flag : advanced_flag -> Sexp.t - -type letin_flag = bool -val letin_flag_of_sexp : Sexp.t -> letin_flag -val sexp_of_letin_flag : letin_flag -> Sexp.t - -type clear_flag = bool option -val clear_flag_of_sexp : Sexp.t -> clear_flag -val sexp_of_clear_flag : clear_flag -> Sexp.t - -(* type debug = Tacexpr.debug = Debug | Info | Off *) -(* val debug_of_sexp : Sexp.t -> debug *) -(* val sexp_of_debug : debug -> Sexp.t *) - -(* type goal_selector = Tacexpr.goal_selector *) -(* val goal_selector_of_sexp : Sexp.t -> goal_selector *) -(* val sexp_of_goal_selector : goal_selector -> Sexp.t *) - -type ('c, 'd, 'id) inversion_strength = ('c, 'd, 'id) Tacexpr.inversion_strength - -val inversion_strength_of_sexp : - (Sexp.t -> 'c) -> - (Sexp.t -> 'd) -> - (Sexp.t -> 'id) -> - Sexp.t -> ('c, 'd, 'id) inversion_strength - -val sexp_of_inversion_strength : - ('c -> Sexp.t) -> - ('d -> Sexp.t) -> - ('id -> Sexp.t) -> - ('c, 'd, 'id) inversion_strength -> Sexp.t - -type 'id message_token = 'id Tacexpr.message_token - -val message_token_of_sexp : - (Sexp.t -> 'id) -> Sexp.t -> 'id message_token - -val sexp_of_message_token : - ('id -> Sexp.t) -> 'id message_token -> Sexp.t - -type ('dconstr, 'id) induction_clause = ('dconstr, 'id) Tacexpr.induction_clause - -val induction_clause_of_sexp : - (Sexp.t -> 'dconstr) -> - (Sexp.t -> 'id) -> - Sexp.t -> ('dconstr, 'id) induction_clause - -val sexp_of_induction_clause : - ('dconstr -> Sexp.t) -> - ('id -> Sexp.t) -> - ('dconstr, 'id) induction_clause -> Sexp.t - - -type ('constr, 'dconstr, 'id) induction_clause_list = - ('constr, 'dconstr, 'id) Tacexpr.induction_clause_list - -val induction_clause_list_of_sexp : - (Sexp.t -> 'constr) -> - (Sexp.t -> 'dconstr) -> - (Sexp.t -> 'id) -> - Sexp.t -> ('constr, 'dconstr, 'id) induction_clause_list - -val sexp_of_induction_clause_list : - ('constr -> Sexp.t) -> - ('dconstr -> Sexp.t) -> - ('id -> Sexp.t) -> - ('constr, 'dconstr, 'id) induction_clause_list -> Sexp.t - -type 'a with_bindings_arg = 'a Tacexpr.with_bindings_arg - -val with_bindings_arg_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a with_bindings_arg -val sexp_of_with_bindings_arg : ('a -> Sexp.t) -> 'a with_bindings_arg -> Sexp.t - -(* type multi = Tacexpr.multi *) -(* val multi_of_sexp : Sexp.t -> multi *) -(* val sexp_of_multi : multi -> Sexp.t *) - -type 'a match_pattern = 'a Tacexpr.match_pattern - -val match_pattern_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a match_pattern -val sexp_of_match_pattern : ('a -> Sexp.t) -> 'a match_pattern -> Sexp.t - -type 'a match_context_hyps = 'a Tacexpr.match_context_hyps - -val match_context_hyps_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a match_context_hyps -val sexp_of_match_context_hyps : ('a -> Sexp.t) -> 'a match_context_hyps -> Sexp.t - -type ('a, 't) match_rule = ('a, 't) Tacexpr.match_rule - -val match_rule_of_sexp : - (Sexp.t -> 'a) -> - (Sexp.t -> 't) -> Sexp.t -> ('a, 't) match_rule -val sexp_of_match_rule : - ('a -> Sexp.t) -> - ('t -> Sexp.t) -> ('a, 't) match_rule -> Sexp.t - -type ml_tactic_name = Tacexpr.ml_tactic_name - -val ml_tactic_name_of_sexp : Sexp.t -> ml_tactic_name -val sexp_of_ml_tactic_name : ml_tactic_name -> Sexp.t - -type 'd gen_atomic_tactic_expr = 'd Tacexpr.gen_atomic_tactic_expr - -val sexp_of_gen_atomic_tactic_expr : - ('a -> Sexplib.Sexp.t) -> - ('c -> Sexplib.Sexp.t) -> - ('d -> Sexplib.Sexp.t) -> - ('e -> Sexplib.Sexp.t) -> - ('f -> Sexplib.Sexp.t) -> - ('g -> Sexplib.Sexp.t) -> - ('h -> Sexplib.Sexp.t) -> - ('i -> Sexplib.Sexp.t) -> - < constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; - reference : 'f; tacexpr : 'h; term : 'a > - Tacexpr.gen_atomic_tactic_expr -> Sexplib.Sexp.t -val sexp_of_gen_tactic_expr : - ('a -> Sexplib.Sexp.t) -> - ('c -> Sexplib.Sexp.t) -> - ('d -> Sexplib.Sexp.t) -> - ('e -> Sexplib.Sexp.t) -> - ('f -> Sexplib.Sexp.t) -> - ('g -> Sexplib.Sexp.t) -> - ('h -> Sexplib.Sexp.t) -> - ('i -> Sexplib.Sexp.t) -> - < constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; - reference : 'f; tacexpr : 'h; term : 'a > - Tacexpr.gen_tactic_expr -> Sexplib.Sexp.t -val sexp_of_gen_tactic_arg : - ('a -> Sexplib.Sexp.t) -> - ('c -> Sexplib.Sexp.t) -> - ('d -> Sexplib.Sexp.t) -> - ('e -> Sexplib.Sexp.t) -> - ('f -> Sexplib.Sexp.t) -> - ('g -> Sexplib.Sexp.t) -> - ('h -> Sexplib.Sexp.t) -> - ('i -> Sexplib.Sexp.t) -> - < constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; - reference : 'f; tacexpr : 'h; term : 'a > - Tacexpr.gen_tactic_arg -> Sexplib.Sexp.t -val sexp_of_gen_fun_ast : - ('a -> Sexplib.Sexp.t) -> - ('c -> Sexplib.Sexp.t) -> - ('d -> Sexplib.Sexp.t) -> - ('e -> Sexplib.Sexp.t) -> - ('f -> Sexplib.Sexp.t) -> - ('g -> Sexplib.Sexp.t) -> - ('h -> Sexplib.Sexp.t) -> - ('i -> Sexplib.Sexp.t) -> - < constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; - reference : 'f; tacexpr : 'h; term : 'a > - Tacexpr.gen_tactic_fun_ast -> Sexplib.Sexp.t - -val gen_atomic_tactic_expr_of_sexp : - Sexplib.Sexp.t -> - (Sexplib.Sexp.t -> 'a) -> - (Sexplib.Sexp.t -> 'c) -> - (Sexplib.Sexp.t -> 'd) -> - (Sexplib.Sexp.t -> 'e) -> - (Sexplib.Sexp.t -> 'f) -> - (Sexplib.Sexp.t -> 'g) -> - (Sexplib.Sexp.t -> 'h) -> - (Sexplib.Sexp.t -> 'i) -> - < constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; - reference : 'f; tacexpr : 'h; term : 'a > - Tacexpr.gen_atomic_tactic_expr - -val gen_tactic_expr_of_sexp : - Sexplib.Sexp.t -> - (Sexplib.Sexp.t -> 'a) -> - (Sexplib.Sexp.t -> 'c) -> - (Sexplib.Sexp.t -> 'd) -> - (Sexplib.Sexp.t -> 'e) -> - (Sexplib.Sexp.t -> 'f) -> - (Sexplib.Sexp.t -> 'g) -> - (Sexplib.Sexp.t -> 'h) -> - (Sexplib.Sexp.t -> 'i) -> - < constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; - reference : 'f; tacexpr : 'h; term : 'a > - Tacexpr.gen_tactic_expr - -val gen_tactic_arg_of_sexp : - Sexplib.Sexp.t -> - (Sexplib.Sexp.t -> 'a) -> - (Sexplib.Sexp.t -> 'c) -> - (Sexplib.Sexp.t -> 'd) -> - (Sexplib.Sexp.t -> 'e) -> - (Sexplib.Sexp.t -> 'f) -> - (Sexplib.Sexp.t -> 'g) -> - (Sexplib.Sexp.t -> 'h) -> - (Sexplib.Sexp.t -> 'i) -> - < constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; - reference : 'f; tacexpr : 'h; term : 'a > - Tacexpr.gen_tactic_arg - -val gen_fun_ast_of_sexp : - Sexplib.Sexp.t -> - (Sexplib.Sexp.t -> 'a) -> - (Sexplib.Sexp.t -> 'c) -> - (Sexplib.Sexp.t -> 'd) -> - (Sexplib.Sexp.t -> 'e) -> - (Sexplib.Sexp.t -> 'f) -> - (Sexplib.Sexp.t -> 'g) -> - (Sexplib.Sexp.t -> 'h) -> - (Sexplib.Sexp.t -> 'i) -> - < constant : 'e; dterm : 'c; level : 'i; name : 'g; pattern : 'd; - reference : 'f; tacexpr : 'h; term : 'a > - Tacexpr.gen_tactic_fun_ast - -type glob_tactic_expr = Tacexpr.glob_tactic_expr - [@@deriving sexp,yojson,hash,compare] - -type glob_atomic_tactic_expr = Tacexpr.glob_atomic_tactic_expr - [@@deriving sexp,yojson,hash,compare] - -type raw_tactic_expr = Tacexpr.raw_tactic_expr - [@@deriving sexp,yojson,hash,compare] - -type raw_atomic_tactic_expr = Tacexpr.raw_atomic_tactic_expr - [@@deriving sexp,yojson,hash,compare] - -type atomic_tactic_expr = Tacexpr.atomic_tactic_expr -val atomic_tactic_expr_of_sexp : Sexp.t -> atomic_tactic_expr -val sexp_of_atomic_tactic_expr : atomic_tactic_expr -> Sexp.t - -type tacdef_body = Tacexpr.tacdef_body - [@@deriving sexp,hash,compare] - -type intro_pattern = Tacexpr.intro_pattern - [@@deriving sexp,hash,compare] diff --git a/serlib_8_19/plugins/ltac2/dune b/serlib_8_19/plugins/ltac2/dune deleted file mode 100644 index fe468ad6..00000000 --- a/serlib_8_19/plugins/ltac2/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name serlib_ltac2) - (public_name coq-lsp.serlib.ltac2) - (synopsis "Serialization Library for Coq [LTAC2 plugin]") - (preprocess - (staged_pps - ppx_import - ppx_sexp_conv - ppx_deriving_yojson - ppx_hash - ppx_compare)) - (libraries coq-core.plugins.ltac2 serlib sexplib)) diff --git a/serlib_8_19/plugins/ltac2/ser_g_ltac2.ml b/serlib_8_19/plugins/ltac2/ser_g_ltac2.ml deleted file mode 100644 index 9d854f4f..00000000 --- a/serlib_8_19/plugins/ltac2/ser_g_ltac2.ml +++ /dev/null @@ -1,47 +0,0 @@ -(************************************************************************) -(* SerAPI: Coq interaction protocol with bidirectional serialization *) -(************************************************************************) -(* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) -(* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) -(* Written by: Emilio J. Gallego Arias and others *) -(************************************************************************) - -open Serlib -open Ltac2_plugin - -open Sexplib.Std -open Ppx_hash_lib.Std.Hash.Builtin -open Ppx_compare_lib.Builtin - -module Tac2expr = Ser_tac2expr - -(* val Ltac2_plugin.G_ltac2.wit_ltac2_entry: - (Ltac2_plugin.Tac2expr.strexpr, unit, unit) Genarg.genarg_type *) -module L2Entry = struct - type raw = Tac2expr.strexpr - [@@deriving sexp,hash,compare] - type glb = unit - [@@deriving sexp,hash,compare] - type top = unit - [@@deriving sexp,hash,compare] -end - -let ser_wit_ltac2_entry = let module M = Ser_genarg.GS(L2Entry) in M.genser - -module L2Expr = struct - type raw = Tac2expr.raw_tacexpr - [@@deriving sexp,hash,compare] - type glb = unit - [@@deriving sexp,hash,compare] - type top = unit - [@@deriving sexp,hash,compare] -end - -let ser_wit_ltac2_expr = let module M = Ser_genarg.GS(L2Expr) in M.genser - -let register () = - Ser_genarg.register_genser G_ltac2.wit_ltac2_entry ser_wit_ltac2_entry; - Ser_genarg.register_genser G_ltac2.wit_ltac2_expr ser_wit_ltac2_expr; - () - -let () = register () diff --git a/serlib_8_19/plugins/ltac2/ser_tac2env.ml b/serlib_8_19/plugins/ltac2/ser_tac2env.ml deleted file mode 100644 index c5d5dd0c..00000000 --- a/serlib_8_19/plugins/ltac2/ser_tac2env.ml +++ /dev/null @@ -1,89 +0,0 @@ -(************************************************************************) -(* SerAPI: Coq interaction protocol with bidirectional serialization *) -(************************************************************************) -(* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) -(* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) -(* Written by: Emilio J. Gallego Arias and others *) -(************************************************************************) - -open Serlib -open Ltac2_plugin - -open Sexplib.Std -open Ppx_hash_lib.Std.Hash.Builtin -open Ppx_compare_lib.Builtin - -module Util = Ser_util -module Loc = Ser_loc -module CAst = Ser_cAst -module Names = Ser_names -module Tac2expr = Ser_tac2expr - -module WL2in1 = struct - type raw = Tac2expr.uid CAst.t list * Tac2expr.raw_tacexpr - [@@deriving sexp,hash,compare] - type glb = Tac2expr.uid list * Tac2expr.glb_tacexpr - [@@deriving sexp,hash,compare] - type top = Util.Empty.t - [@@deriving sexp,hash,compare] -end - -let ser_wit_ltac2in1 = let module M = Ser_genarg.GS(WL2in1) in M.genser - -module WL2in1V = struct - type raw = Tac2expr.uid CAst.t list * Tac2expr.raw_tacexpr - [@@deriving sexp,hash,compare] - type glb = Tac2expr.glb_tacexpr - [@@deriving sexp,hash,compare] - type top = Util.Empty.t - [@@deriving sexp,hash,compare] -end - -let ser_wit_ltac2in1_val = let module M = Ser_genarg.GS(WL2in1V) in M.genser - -module WLC2 = struct - type raw = Tac2expr.raw_tacexpr - [@@deriving sexp,hash,compare] - type glb = Names.Id.Set.t * Tac2expr.glb_tacexpr - [@@deriving sexp,hash,compare] - type top = Util.Empty.t - [@@deriving sexp,hash,compare] -end - -let ser_wit_ltac2_constr = let module M = Ser_genarg.GS(WLC2) in M.genser - -type var_quotation_kind = - [%import: Ltac2_plugin.Tac2env.var_quotation_kind] - [@@deriving sexp,yojson,hash,compare] - -module WLQ2 = struct - type raw = Names.lident option * Names.lident - [@@deriving sexp,hash,compare] - type glb = var_quotation_kind * Names.Id.t - [@@deriving sexp,hash,compare] - type top = Util.Empty.t - [@@deriving sexp,hash,compare] -end - -let ser_wit_ltac2_var_quotation = let module M = Ser_genarg.GS(WLQ2) in M.genser - -module WLV2 = struct - type raw = Util.Empty.t - [@@deriving sexp,hash,compare] - type glb = unit - [@@deriving sexp,hash,compare] - type top = Util.Empty.t - [@@deriving sexp,hash,compare] -end - -let ser_wit_ltac2_val = let module M = Ser_genarg.GS(WLV2) in M.genser - -let register () = - Ser_genarg.register_genser Tac2env.wit_ltac2in1 ser_wit_ltac2in1; - Ser_genarg.register_genser Tac2env.wit_ltac2in1_val ser_wit_ltac2in1_val; - Ser_genarg.register_genser Tac2env.wit_ltac2_constr ser_wit_ltac2_constr; - Ser_genarg.register_genser Tac2env.wit_ltac2_var_quotation ser_wit_ltac2_var_quotation; - Ser_genarg.register_genser Tac2env.wit_ltac2_val ser_wit_ltac2_val; - () - -let () = register () diff --git a/serlib_8_19/plugins/ltac2/ser_tac2expr.ml b/serlib_8_19/plugins/ltac2/ser_tac2expr.ml deleted file mode 100644 index b087580d..00000000 --- a/serlib_8_19/plugins/ltac2/ser_tac2expr.ml +++ /dev/null @@ -1,197 +0,0 @@ -(************************************************************************) -(* SerAPI: Coq interaction protocol with bidirectional serialization *) -(************************************************************************) -(* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) -(* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) -(* Written by: Emilio J. Gallego Arias and others *) -(************************************************************************) - -open Serlib - -module Loc = Ser_loc -module CAst = Ser_cAst -module Names = Ser_names -module Libnames = Ser_libnames - -open Sexplib.Std -open Ppx_hash_lib.Std.Hash.Builtin -open Ppx_compare_lib.Builtin - -let hash_fold_array = hash_fold_array_frozen - -type mutable_flag = - [%import: Ltac2_plugin.Tac2expr.mutable_flag] - [@@deriving sexp,yojson,hash,compare] - -type uid = - [%import: Ltac2_plugin.Tac2expr.uid] - [@@deriving sexp,yojson,hash,compare] - -type lid = - [%import: Ltac2_plugin.Tac2expr.lid] - [@@deriving sexp,yojson,hash,compare] - -type rec_flag = - [%import: Ltac2_plugin.Tac2expr.rec_flag] - [@@deriving sexp,yojson,hash,compare] - -type redef_flag = - [%import: Ltac2_plugin.Tac2expr.redef_flag] - [@@deriving sexp,yojson,hash,compare] - -type 'a or_relid = - [%import: 'a Ltac2_plugin.Tac2expr.or_relid] - [@@deriving sexp,yojson,hash,compare] - -type 'a or_tuple = - [%import: 'a Ltac2_plugin.Tac2expr.or_tuple] - [@@deriving sexp,yojson,hash,compare] - -type type_constant = - [%import: Ltac2_plugin.Tac2expr.type_constant] - [@@deriving sexp,yojson,hash,compare] - -type raw_typexpr_r = - [%import: Ltac2_plugin.Tac2expr.raw_typexpr_r] - [@@deriving sexp,yojson,hash,compare] -and raw_typexpr = - [%import: Ltac2_plugin.Tac2expr.raw_typexpr] - [@@deriving sexp,yojson,hash,compare] - -type raw_typedef = - [%import: Ltac2_plugin.Tac2expr.raw_typedef] - [@@deriving sexp,yojson,hash,compare] - -type raw_quant_typedef = - [%import: Ltac2_plugin.Tac2expr.raw_quant_typedef] - [@@deriving sexp,yojson,hash,compare] - -type atom = - [%import: Ltac2_plugin.Tac2expr.atom] - [@@deriving sexp,yojson,hash,compare] - -type ltac_constant = - [%import: Ltac2_plugin.Tac2expr.ltac_constant] - [@@deriving sexp,yojson,hash,compare] - -type ltac_alias = - [%import: Ltac2_plugin.Tac2expr.ltac_alias] - [@@deriving sexp,yojson,hash,compare] - -type ltac_constructor = - [%import: Ltac2_plugin.Tac2expr.ltac_constructor] - [@@deriving sexp,yojson,hash,compare] - -type ltac_projection = - [%import: Ltac2_plugin.Tac2expr.ltac_projection] - [@@deriving sexp,yojson,hash,compare] - -type raw_patexpr = - [%import: Ltac2_plugin.Tac2expr.raw_patexpr] - [@@deriving sexp,yojson,hash,compare] -and raw_patexpr_r = - [%import: Ltac2_plugin.Tac2expr.raw_patexpr_r] - [@@deriving sexp,yojson,hash,compare] - -type tacref = - [%import: Ltac2_plugin.Tac2expr.tacref] - [@@deriving sexp,yojson,hash,compare] - -module ObjS = struct type t = Obj.t let name = "Obj.t" end -module Obj = SerType.Opaque(ObjS) - -module T2ESpec = struct - type t = Ltac2_plugin.Tac2expr.raw_tacexpr_r - open Ltac2_plugin.Tac2expr - type _t = - | CTacAtm of atom - | CTacRef of tacref or_relid - | CTacCst of ltac_constructor or_tuple or_relid - | CTacFun of raw_patexpr list * raw_tacexpr - | CTacApp of raw_tacexpr * raw_tacexpr list - | CTacSyn of (raw_patexpr * raw_tacexpr) list * Names.KerName.t - | CTacLet of rec_flag * (raw_patexpr * raw_tacexpr) list * raw_tacexpr - | CTacCnv of raw_tacexpr * raw_typexpr - | CTacSeq of raw_tacexpr * raw_tacexpr - | CTacIft of raw_tacexpr * raw_tacexpr * raw_tacexpr - | CTacCse of raw_tacexpr * raw_taccase list - | CTacRec of raw_tacexpr option * raw_recexpr - | CTacPrj of raw_tacexpr * ltac_projection or_relid - | CTacSet of raw_tacexpr * ltac_projection or_relid * raw_tacexpr - | CTacExt of int * Obj.t - - and raw_tacexpr = _t CAst.t - and raw_taccase = - [%import: Ltac2_plugin.Tac2expr.raw_taccase] - and raw_recexpr = - [%import: Ltac2_plugin.Tac2expr.raw_recexpr] - [@@deriving sexp,yojson,hash,compare] - -end - -module T2E = Serlib.SerType.Pierce(T2ESpec) -type raw_tacexpr_r = T2E.t - [@@deriving sexp,yojson,hash,compare] - -type raw_tacexpr = - [%import: Ltac2_plugin.Tac2expr.raw_tacexpr] - [@@deriving sexp,yojson,hash,compare] - -type ml_tactic_name = - [%import: Ltac2_plugin.Tac2expr.ml_tactic_name] - [@@deriving sexp,yojson,hash,compare] - -type sexpr = - [%import: Ltac2_plugin.Tac2expr.sexpr] - [@@deriving sexp,yojson,hash,compare] - -type strexpr = - [%import: Ltac2_plugin.Tac2expr.strexpr] - [@@deriving sexp,yojson,hash,compare] - -type ctor_indx = - [%import: Ltac2_plugin.Tac2expr.ctor_indx] - [@@deriving sexp,yojson,hash,compare] - -type ctor_data_for_patterns = - [%import: Ltac2_plugin.Tac2expr.ctor_data_for_patterns] - [@@deriving sexp,yojson,hash,compare] - -type glb_pat = - [%import: Ltac2_plugin.Tac2expr.glb_pat] - [@@deriving sexp,yojson,hash,compare] - -type case_info = - [%import: Ltac2_plugin.Tac2expr.case_info] - [@@deriving sexp,yojson,hash,compare] - -type 'a open_match = - [%import: 'a Ltac2_plugin.Tac2expr.open_match] - [@@deriving sexp,yojson,hash,compare] - -module GT2ESpec = struct - type t = Ltac2_plugin.Tac2expr.glb_tacexpr - open Ltac2_plugin.Tac2expr - type _t = - | GTacAtm of atom - | GTacVar of Names.Id.t - | GTacRef of ltac_constant - | GTacFun of Names.Name.t list * _t - | GTacApp of _t * _t list - | GTacLet of rec_flag * (Names.Name.t * _t) list * _t - | GTacCst of case_info * int * _t list - | GTacCse of _t * case_info * _t array * (Names.Name.t array * _t) array - | GTacPrj of type_constant * _t * int - | GTacSet of type_constant * _t * int * _t - | GTacOpn of ltac_constructor * _t list - | GTacWth of _t open_match - | GTacFullMatch of _t * (glb_pat * _t) list - | GTacExt of int * Obj.t - | GTacPrm of ml_tactic_name - [@@deriving sexp,yojson,hash,compare] - -end - -module GT2E = Serlib.SerType.Pierce(GT2ESpec) -type glb_tacexpr = GT2E.t - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/plugins/ltac2/ser_tac2quote.ml b/serlib_8_19/plugins/ltac2/ser_tac2quote.ml deleted file mode 100644 index 39008770..00000000 --- a/serlib_8_19/plugins/ltac2/ser_tac2quote.ml +++ /dev/null @@ -1,27 +0,0 @@ -(************************************************************************) -(* SerAPI: Coq interaction protocol with bidirectional serialization *) -(************************************************************************) -(* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) -(* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) -(* Written by: Emilio J. Gallego Arias and others *) -(************************************************************************) - -(* open Sexplib.Std *) -(* open Ppx_hash_lib.Std.Hash.Builtin *) -(* open Ppx_compare_lib.Builtin *) - -(* let b x = Obj.magic x *) - -(* These are all special ltac2 extensible objects, brrrr... *) -let register () = - (* Ser_genarg.register_genser Tac2quote.wit_constr (b()); *) - (* Ser_genarg.register_genser Tac2quote.wit_ident (b()); *) - (* Ser_genarg.register_genser Tac2quote.wit_ltac1 (b()); *) - (* Ser_genarg.register_genser Tac2quote.wit_ltac1val (b()); *) - (* Ser_genarg.register_genser Tac2quote.wit_open_constr (b()); *) - (* Ser_genarg.register_genser Tac2quote.wit_pattern (b()); *) - (* Ser_genarg.register_genser Tac2quote.wit_preterm (b()); *) - (* Ser_genarg.register_genser Tac2quote.wit_reference (b()); *) - () - -let () = register () diff --git a/serlib_8_19/plugins/micromega/dune b/serlib_8_19/plugins/micromega/dune deleted file mode 100644 index 9f0296e9..00000000 --- a/serlib_8_19/plugins/micromega/dune +++ /dev/null @@ -1,12 +0,0 @@ -(library - (name serlib_micromega) - (public_name coq-lsp.serlib.micromega) - (synopsis "Serialization Library for Coq Congruence Plugin") - (preprocess - (staged_pps - ppx_import - ppx_sexp_conv - ppx_deriving_yojson - ppx_hash - ppx_compare)) - (libraries coq-core.plugins.micromega serlib sexplib)) diff --git a/serlib_8_19/plugins/ring/dune b/serlib_8_19/plugins/ring/dune deleted file mode 100644 index 6b7b8e47..00000000 --- a/serlib_8_19/plugins/ring/dune +++ /dev/null @@ -1,7 +0,0 @@ -(library - (name serlib_ring) - (public_name coq-lsp.serlib.ring) - (synopsis "Serialization Library for Coq Setoid Newring Plugin") - (preprocess - (staged_pps ppx_import ppx_sexp_conv ppx_hash ppx_compare)) - (libraries coq-core.plugins.ring serlib serlib_ltac sexplib)) diff --git a/serlib_8_19/plugins/ring/ser_g_ring.ml b/serlib_8_19/plugins/ring/ser_g_ring.ml deleted file mode 100644 index 684a9985..00000000 --- a/serlib_8_19/plugins/ring/ser_g_ring.ml +++ /dev/null @@ -1,93 +0,0 @@ -(************************************************************************) -(* SerAPI: Coq interaction protocol with bidirectional serialization *) -(************************************************************************) -(* Copyright 2016-2019 MINES ParisTech -- License LGPL 2.1+ *) -(* Copyright 2019-2023 Inria -- License LGPL 2.1+ *) -(* Written by: Emilio J. Gallego Arias and others *) -(************************************************************************) - -open Sexplib.Conv -open Ppx_hash_lib.Std.Hash.Builtin -open Ppx_compare_lib.Builtin -open Serlib - -module CAst = Ser_cAst -module Libnames = Ser_libnames -module Constrexpr = Ser_constrexpr -module Tactypes = Ser_tactypes -module Genintern = Ser_genintern -module EConstr = Ser_eConstr -module Tacexpr = Serlib_ltac.Ser_tacexpr - -module Ltac_plugin = struct - module Tacexpr = Serlib_ltac.Ser_tacexpr -end - -type 'constr coeff_spec = - [%import: 'constr Ring_plugin.Ring_ast.coeff_spec] - [@@deriving sexp,hash,compare] - -type cst_tac_spec = - [%import: Ring_plugin.Ring_ast.cst_tac_spec] - [@@deriving sexp,hash,compare] - -type 'constr ring_mod = - [%import: 'constr Ring_plugin.Ring_ast.ring_mod] - [@@deriving sexp,hash,compare] - -type 'a field_mod = - [%import: 'a Ring_plugin.Ring_ast.field_mod] - [@@deriving sexp,hash,compare] - -module A0 = struct - type raw = Constrexpr.constr_expr field_mod - [@@deriving sexp,hash,compare] - type glb = unit - [@@deriving sexp,hash,compare] - type top = unit - [@@deriving sexp,hash,compare] -end - -let ser_wit_field_mod = let module M = Ser_genarg.GS(A0) in M.genser - -module A1 = struct - type raw = Constrexpr.constr_expr field_mod list - [@@deriving sexp,hash,compare] - type glb = unit - [@@deriving sexp,hash,compare] - type top = unit - [@@deriving sexp,hash,compare] -end - -let ser_wit_field_mods = let module M = Ser_genarg.GS(A1) in M.genser - -module A2 = struct - type raw = Constrexpr.constr_expr ring_mod - [@@deriving sexp,hash,compare] - type glb = unit - [@@deriving sexp,hash,compare] - type top = unit - [@@deriving sexp,hash,compare] -end - -let ser_wit_ring_mod = let module M = Ser_genarg.GS(A2) in M.genser - -module A3 = struct - type raw = Constrexpr.constr_expr ring_mod list - [@@deriving sexp,hash,compare] - type glb = unit - [@@deriving sexp,hash,compare] - type top = unit - [@@deriving sexp,hash,compare] -end - -let ser_wit_ring_mods = let module M = Ser_genarg.GS(A3) in M.genser - -let register () = - Ser_genarg.register_genser Ring_plugin.G_ring.wit_field_mod ser_wit_field_mod; - Ser_genarg.register_genser Ring_plugin.G_ring.wit_field_mods ser_wit_field_mods; - Ser_genarg.register_genser Ring_plugin.G_ring.wit_ring_mod ser_wit_ring_mod; - Ser_genarg.register_genser Ring_plugin.G_ring.wit_ring_mods ser_wit_ring_mods; - () - -let _ = register () diff --git a/serlib_8_19/plugins/ssr/dune b/serlib_8_19/plugins/ssr/dune deleted file mode 100644 index 277917c8..00000000 --- a/serlib_8_19/plugins/ssr/dune +++ /dev/null @@ -1,17 +0,0 @@ -(library - (name serlib_ssr) - (public_name coq-lsp.serlib.ssreflect) - (synopsis "Serialization Library for Coq [SSR plugin]") - (preprocess - (staged_pps - ppx_import - ppx_sexp_conv - ppx_deriving_yojson - ppx_hash - ppx_compare)) - (libraries - coq-core.plugins.ssreflect - serlib - serlib_ltac - serlib_ssrmatching - sexplib)) diff --git a/serlib_8_19/plugins/ssr/ser_ssrast.ml b/serlib_8_19/plugins/ssr/ser_ssrast.ml deleted file mode 100644 index 794c354b..00000000 --- a/serlib_8_19/plugins/ssr/ser_ssrast.ml +++ /dev/null @@ -1,221 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* t - val of_t : t -> _t - -end - -module Biject(M : Bijectable) : SJHC with type t = M.t = struct - - type t = M.t - - let sexp_of_t x = M.sexp_of__t (M.of_t x) - let t_of_sexp s = M.to_t (M._t_of_sexp s) - - let to_yojson p = M._t_to_yojson (M.of_t p) - let of_yojson p = M._t_of_yojson p |> Result.map M.to_t - - let hash x = M.hash__t (M.of_t x) - let hash_fold_t st x = M.hash_fold__t st (M.of_t x) - - let compare x1 x2 = M.compare__t (M.of_t x1) (M.of_t x2) -end - -(* Bijection with serializable types *) -module type Bijectable1 = sig - - (* Base Type *) - type 'a t - - (* Representation type *) - type 'a _t [@@deriving sexp,yojson,hash,compare] - - (* Need to be bijetive *) - val to_t : 'a _t -> 'a t - val of_t : 'a t -> 'a _t - -end - -module Biject1(M : Bijectable1) : SJHC1 with type 'a t = 'a M.t = struct - - type 'a t = 'a M.t - - let sexp_of_t f x = M.sexp_of__t f (M.of_t x) - let t_of_sexp f s = M.to_t (M._t_of_sexp f s) - - let to_yojson f p = M._t_to_yojson f (M.of_t p) - let of_yojson f p = M._t_of_yojson f p |> Result.map M.to_t - - let hash_fold_t f st x = M.hash_fold__t f st (M.of_t x) - - let compare f x1 x2 = M.compare__t f (M.of_t x1) (M.of_t x2) -end - -(* We do our own alias as to have better control *) -let _sercast = Obj.magic - -(* Obj.magic piercing *) -module type Pierceable = sig - - (* Type to pierce *) - type t - - (* Representation type *) - type _t [@@deriving sexp,yojson,hash,compare] -end - -module type Pierceable1 = sig - - (* Type to pierce *) - type 'a t - - (* Representation type *) - type 'a _t [@@deriving sexp,yojson,hash,compare] -end - -module Pierce(M : Pierceable) : SJHC with type t = M.t = struct - - type t = M.t - - let sexp_of_t x = M.sexp_of__t (_sercast x) - let t_of_sexp s = _sercast (M._t_of_sexp s) - - let to_yojson p = M._t_to_yojson (_sercast p) - let of_yojson p = M._t_of_yojson p |> Result.map _sercast - - let hash x = M.hash__t (_sercast x) - let hash_fold_t st x = M.hash_fold__t st (_sercast x) - - let compare x1 x2 = M.compare__t (_sercast x1) (_sercast x2) - -end - -module Pierce1(M : Pierceable1) : SJHC1 with type 'a t = 'a M.t = struct - - type 'a t = 'a M.t - - let sexp_of_t f x = M.sexp_of__t f (_sercast x) - let t_of_sexp f s = _sercast (M._t_of_sexp f s) - - let to_yojson f p = M._t_to_yojson f (_sercast p) - let of_yojson f p = M._t_of_yojson f p |> Result.map _sercast - - (* let hash x = M.hash__t (_sercast x) *) - let hash_fold_t f st x = M.hash_fold__t f st (_sercast x) - - let compare f x1 x2 = M.compare__t f (_sercast x1) (_sercast x2) - -end - -(* Unfortunately this doesn't really work for types that are named as - the functions would have to be sexp_of_name etc... Maybe fixme in - the future *) -module PierceAlt(M : Pierceable) : SJHC with type t := M.t = struct - - let sexp_of_t x = M.sexp_of__t (_sercast x) - let t_of_sexp s = _sercast (M._t_of_sexp s) - - let to_yojson p = M._t_to_yojson (_sercast p) - let of_yojson p = M._t_of_yojson p |> Result.map _sercast - - let hash x = M.hash__t (_sercast x) - let hash_fold_t st x = M.hash_fold__t st (_sercast x) - - let compare x1 x2 = M.compare__t (_sercast x1) (_sercast x2) - -end - -module type OpaqueDesc = sig type t val name : string end - -module Opaque(M : OpaqueDesc) : SJHC with type t = M.t = struct - - type t = M.t - let typ = M.name - - let sexp_of_t x = Serlib_base.sexp_of_opaque ~typ x - let t_of_sexp s = Serlib_base.opaque_of_sexp ~typ s - - let to_yojson p = Serlib_base.opaque_to_yojson ~typ p - let of_yojson p = Serlib_base.opaque_of_yojson ~typ p - - let hash x = Serlib_base.hash_opaque ~typ x - let hash_fold_t st x = Serlib_base.hash_fold_opaque ~typ st x - - let compare x1 x2 = Serlib_base.compare_opaque ~typ x1 x2 - -end - -module type OpaqueDesc1 = sig type 'a t val name : string end - -module Opaque1(M : OpaqueDesc1) : SJHC1 with type 'a t = 'a M.t = struct - - type 'a t = 'a M.t - let typ = M.name - - let sexp_of_t _ x = Serlib_base.sexp_of_opaque ~typ x - let t_of_sexp _ s = Serlib_base.opaque_of_sexp ~typ s - - let to_yojson _ p = Serlib_base.opaque_to_yojson ~typ p - let of_yojson _ p = Serlib_base.opaque_of_yojson ~typ p - - let hash_fold_t _ st x = Serlib_base.hash_fold_opaque ~typ st x - - let compare _ x1 x2 = Serlib_base.compare_opaque ~typ x1 x2 - -end diff --git a/serlib_8_19/serType.mli b/serlib_8_19/serType.mli deleted file mode 100644 index 5adb4980..00000000 --- a/serlib_8_19/serType.mli +++ /dev/null @@ -1,91 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* t - val of_t : t -> _t - -end - -module Biject(M : Bijectable) : SJHC with type t = M.t - -(* Bijection with serializable types *) -module type Bijectable1 = sig - - (* Base Type *) - type 'a t - - (* Representation type *) - type 'a _t [@@deriving sexp,yojson,hash,compare] - - (* Need to be bijetive *) - val to_t : 'a _t -> 'a t - val of_t : 'a t -> 'a _t - -end - -module Biject1(M : Bijectable1) : SJHC1 with type 'a t = 'a M.t - -module type Pierceable = sig - - (** Type to pierce *) - type t - - (** Representation type *) - type _t [@@deriving sexp,yojson,hash,compare] - -end - -module type Pierceable1 = sig - - (** Type to pierce *) - type 'a t - - (** Representation type *) - type 'a _t [@@deriving sexp,yojson,hash,compare] -end - -module Pierce(M : Pierceable) : SJHC with type t = M.t -module Pierce1(M : Pierceable1) : SJHC1 with type 'a t = 'a M.t - -module type OpaqueDesc = sig type t val name : string end -module Opaque(M : OpaqueDesc) : SJHC with type t = M.t - -module type OpaqueDesc1 = sig type 'a t val name : string end -module Opaque1(M : OpaqueDesc1) : SJHC1 with type 'a t = 'a M.t diff --git a/serlib_8_19/ser_attributes.ml b/serlib_8_19/ser_attributes.ml deleted file mode 100644 index 538f19de..00000000 --- a/serlib_8_19/ser_attributes.ml +++ /dev/null @@ -1,35 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* |= fun { L.v; loc } -> CAst.make ?loc:loc v) -let to_yojson f { CAst.v ; loc } = L.to_yojson f { L.v ; loc } - -let hash_fold_t f st { CAst.v; loc } = L.hash_fold_t f st { L.v; loc } - -let compare f { CAst.v = v1; loc = l1 } { CAst.v = v2; loc = l2 } = L.compare f { L.v = v1; loc = l1 } { L.v = v2; loc = l2 } - -let omit_att = ref false - -let sexp_of_t f x = - if !omit_att then f x.CAst.v else sexp_of_t f x - -(* let to_yojson f x = - if !omit_att then ... *) - diff --git a/serlib_8_19/ser_cAst.mli b/serlib_8_19/ser_cAst.mli deleted file mode 100644 index 60ea445a..00000000 --- a/serlib_8_19/ser_cAst.mli +++ /dev/null @@ -1,24 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* M.add k s e) M.empty l - let of_t = M.bindings - end - - include SerType.Biject1(BijectSpec) - -end diff --git a/serlib_8_19/ser_cMap.mli b/serlib_8_19/ser_cMap.mli deleted file mode 100644 index 6fa89e8b..00000000 --- a/serlib_8_19/ser_cMap.mli +++ /dev/null @@ -1,32 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* NoInvert - | CaseInvert { indices } -> - CaseInvert { indices = Array.map f indices } - -type 'constr pcase_branch = - [%import: 'constr Constr.pcase_branch] - [@@deriving sexp,yojson,hash,compare] - -let map_pcase_branch f (bi, c) = (bi, f c) - -type 'types pcase_return = - [%import: 'types Constr.pcase_return] - [@@deriving sexp,yojson,hash,compare] - -let map_pcase_return f (bi, c) = (bi, f c) - -type _constr = - | Rel of int - | Var of Names.Id.t - | Meta of int - | Evar of _constr pexistential - | Sort of Sorts.t - | Cast of _constr * cast_kind * _constr - | Prod of Names.Name.t Context.binder_annot * _constr * _constr - | Lambda of Names.Name.t Context.binder_annot * _constr * _constr - | LetIn of Names.Name.t Context.binder_annot * _constr * _constr * _constr - | App of _constr * _constr array - | Const of pconstant - | Ind of pinductive - | Construct of pconstructor - | Case of case_info * UVars.Instance.t * _constr array * _constr pcase_return * _constr pcase_invert * _constr * _constr pcase_branch array - | Fix of (_constr, _constr) pfixpoint - | CoFix of (_constr, _constr) pcofixpoint - | Proj of Names.Projection.t * Sorts.relevance * _constr - | Int of Uint63.t - | Float of Float64.t - | Array of UVars.Instance.t * _constr array * _constr * _constr -[@@deriving sexp,yojson,hash,compare] - -let rec _constr_put (c : Constr.t) : _constr = - let cr = _constr_put in - let crl = SList.map _constr_put in - let cra = Array.map _constr_put in - let crci = map_pcase_invert _constr_put in - let crcb = map_pcase_branch _constr_put in - let crcr = map_pcase_return _constr_put in - let module C = Constr in - match C.kind c with - | C.Rel i -> Rel(i) - | C.Var v -> Var(v) - | C.Meta(mv) -> Meta mv - | C.Evar(ek, csa) -> Evar (ek, crl csa) - | C.Sort(st) -> Sort (st) - | C.Cast(cs,k,ty) -> Cast(cr cs, k, cr ty) - | C.Prod(n,tya,tyr) -> Prod(n, cr tya, cr tyr) - | C.Lambda(n,ab,bd) -> Lambda(n, cr ab, cr bd) - | C.LetIn(n,u,ab,bd) -> LetIn(n, cr u, cr ab, cr bd) - | C.App(hd, al) -> App(cr hd, cra al) - | C.Const p -> Const p - | C.Ind(p,q) -> Ind (p,q) - | C.Construct(p) -> Construct (p) - | C.Case(ci, u, ca, (pr,r), pi, c, pb) -> - Case(ci, u, cra ca, (crcr pr,r), crci pi, cr c, Array.map crcb pb) - (* (int array * int) * (Name.t array * 'types array * 'constr array)) *) - | C.Fix(p,(na,u1,u2)) -> Fix(p, (na, cra u1, cra u2)) - | C.CoFix(p,(na,u1,u2)) -> CoFix(p, (na, cra u1, cra u2)) - | C.Proj(p,r,c) -> Proj(p, r, cr c) - | C.Int i -> Int i - | C.Float i -> Float i - | C.Array (u,a,e,t) -> Array(u, cra a, cr e, cr t) - -let rec _constr_get (c : _constr) : Constr.t = - let cr = _constr_get in - let crl = SList.map _constr_get in - let cra = Array.map _constr_get in - let crci = map_pcase_invert _constr_get in - let crcb = map_pcase_branch _constr_get in - let crcr = map_pcase_return _constr_get in - let module C = Constr in - match c with - | Rel i -> C.mkRel i - | Var v -> C.mkVar v - | Meta(mv) -> C.mkMeta mv - | Evar(ek, csa) -> C.mkEvar (ek, crl csa) - | Sort(st) -> C.mkSort (st) - | Cast(cs,k,ty) -> C.mkCast(cr cs, k, cr ty) - | Prod(n,tya,tyr) -> C.mkProd(n, cr tya, cr tyr) - | Lambda(n,ab,bd) -> C.mkLambda(n, cr ab, cr bd) - | LetIn(n,u,ab,bd) -> C.mkLetIn(n, cr u, cr ab, cr bd) - | App(hd, al) -> C.mkApp(cr hd, cra al) - | Const p -> C.mkConstU(p) - | Ind(p,q) -> C.mkIndU(p, q) - | Construct(p) -> C.mkConstructU(p) - | Case(ci, u, ca, (pr,r), pi, c, pb) -> C.mkCase (ci, u, cra ca, (crcr pr,r), crci pi, cr c, Array.map crcb pb) - | Fix (p,(na,u1,u2)) -> C.mkFix(p, (na, cra u1, cra u2)) - | CoFix(p,(na,u1,u2)) -> C.mkCoFix(p, (na, cra u1, cra u2)) - | Proj(p,r,c) -> C.mkProj(p, r, cr c) - | Int i -> C.mkInt i - | Float f -> C.mkFloat f - | Array (u,a,e,t) -> C.mkArray(u, cra a, cr e, cr t) - -module ConstrBij = struct - - type t = Constr.t - - type _t = _constr - [@@deriving sexp,yojson,hash,compare] - - let to_t = _constr_get - let of_t = _constr_put - -end - -module CC = SerType.Biject(ConstrBij) -type constr = CC.t - [@@deriving sexp,yojson,hash,compare] -type types = CC.t - [@@deriving sexp,yojson,hash,compare] - -type t = constr - [@@deriving sexp,yojson,hash,compare] - -type case_invert = - [%import: Constr.case_invert] - [@@deriving sexp,yojson] - -type rec_declaration = - [%import: Constr.rec_declaration] - [@@deriving sexp] - -type fixpoint = - [%import: Constr.fixpoint] - [@@deriving sexp] - -type cofixpoint = - [%import: Constr.cofixpoint] - [@@deriving sexp] - -type existential = - [%import: Constr.existential] - [@@deriving sexp] - -type sorts_family = Sorts.family -let sorts_family_of_sexp = Sorts.family_of_sexp -let sexp_of_sorts_family = Sorts.sexp_of_family - -type named_declaration = - [%import: Constr.named_declaration] - [@@deriving sexp,yojson,hash,compare] - -type named_context = - [%import: Constr.named_context] - [@@deriving sexp,yojson,hash,compare] - -type rel_declaration = - [%import: Constr.rel_declaration] - [@@deriving sexp,yojson,hash,compare] - -type rel_context = - [%import: Constr.rel_context] - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_constr.mli b/serlib_8_19/ser_constr.mli deleted file mode 100644 index 4877f888..00000000 --- a/serlib_8_19/ser_constr.mli +++ /dev/null @@ -1,130 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* metavariable -val sexp_of_metavariable : metavariable -> Sexp.t - -type pconstant = Constr.pconstant - -val pconstant_of_sexp : Sexp.t -> pconstant -val sexp_of_pconstant : pconstant -> Sexp.t - -type pinductive = Constr.pinductive - -val pinductive_of_sexp : Sexp.t -> pinductive -val sexp_of_pinductive : pinductive -> Sexp.t - -type pconstructor = Constr.pconstructor - -val pconstructor_of_sexp : Sexp.t -> pconstructor -val sexp_of_pconstructor : pconstructor -> Sexp.t - -type cast_kind = Constr.cast_kind [@@deriving sexp, yojson, hash,compare] -type case_style = Constr.case_style [@@deriving sexp, yojson, hash,compare] - -type case_printing = Constr.case_printing - -val case_printing_of_sexp : Sexp.t -> case_printing -val sexp_of_case_printing : case_printing -> Sexp.t - -type case_info = Constr.case_info - -val case_info_of_sexp : Sexp.t -> case_info -val sexp_of_case_info : case_info -> Sexp.t - -type rec_declaration = Constr.rec_declaration - -val rec_declaration_of_sexp : Sexp.t -> rec_declaration -val sexp_of_rec_declaration : rec_declaration -> Sexp.t - -type fixpoint = Constr.fixpoint - -val fixpoint_of_sexp : Sexp.t -> fixpoint -val sexp_of_fixpoint : fixpoint -> Sexp.t - -type cofixpoint = Constr.cofixpoint - -val cofixpoint_of_sexp : Sexp.t -> cofixpoint -val sexp_of_cofixpoint : cofixpoint -> Sexp.t - -type 'constr pexistential = 'constr Constr.pexistential - [@@deriving sexp, yojson, hash, compare] - -type ('constr, 'types) prec_declaration = ('constr, 'types) Constr.prec_declaration - -val prec_declaration_of_sexp : - (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> - Sexp.t -> ('constr, 'types) prec_declaration -val sexp_of_prec_declaration : - ('constr -> Sexp.t) -> ('types -> Sexp.t) -> - ('constr, 'types) prec_declaration -> Sexp.t - -type ('constr, 'types) pfixpoint = ('constr, 'types) Constr.pfixpoint - -val pfixpoint_of_sexp : - (Sexp.t -> 'constr) -> - (Sexp.t -> 'types) -> Sexp.t -> ('constr, 'types) pfixpoint - -val sexp_of_pfixpoint : - ('constr -> Sexp.t) -> - ('types -> Sexp.t) -> ('constr, 'types) pfixpoint -> Sexp.t - -type ('constr, 'types) pcofixpoint = ('constr, 'types) Constr.pcofixpoint - -val pcofixpoint_of_sexp : - (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> - Sexp.t -> ('constr, 'types) pcofixpoint - -val sexp_of_pcofixpoint : - ('constr -> Sexp.t) -> ('types -> Sexp.t) -> - ('constr, 'types) pcofixpoint -> Sexp.t - -type t = Constr.t - [@@deriving sexp,yojson,hash,compare] - -type constr = t - [@@deriving sexp,yojson,hash,compare] - -type types = constr - [@@deriving sexp,yojson,hash,compare] - -type existential = Constr.existential -val existential_of_sexp : Sexp.t -> existential -val sexp_of_existential : existential -> Sexp.t - -type sorts_family = Sorts.family -val sorts_family_of_sexp : Sexp.t -> sorts_family -val sexp_of_sorts_family : sorts_family -> Sexp.t - -type named_declaration = Constr.named_declaration -val named_declaration_of_sexp : Sexp.t -> named_declaration -val sexp_of_named_declaration : named_declaration -> Sexp.t - -type named_context = Constr.named_context - [@@deriving sexp,yojson,hash,compare] - -type rel_declaration = Constr.rel_declaration -val rel_declaration_of_sexp : Sexp.t -> rel_declaration -val sexp_of_rel_declaration : rel_declaration -> Sexp.t - -type rel_context = Constr.rel_context - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_constr_matching.ml b/serlib_8_19/ser_constr_matching.ml deleted file mode 100644 index b5b4771a..00000000 --- a/serlib_8_19/ser_constr_matching.ml +++ /dev/null @@ -1,23 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* binding_bound_vars -val sexp_of_binding_bound_vars : binding_bound_vars -> Sexp.t diff --git a/serlib_8_19/ser_constrexpr.ml b/serlib_8_19/ser_constrexpr.ml deleted file mode 100644 index 7be1b26a..00000000 --- a/serlib_8_19/ser_constrexpr.ml +++ /dev/null @@ -1,186 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* 'c) -> (Sexp.t -> 't) -> Sexp.t -> ('c,'t) pt - val sexp_of_pt : ('c -> Sexp.t) -> ('t -> Sexp.t) -> ('c,'t) pt -> Sexp.t - - end - - type ('c, 't) pt = ('c, 't) Context.Compacted.pt - val pt_of_sexp : (Sexp.t -> 'c) -> (Sexp.t -> 't) -> Sexp.t -> ('c,'t) pt - val sexp_of_pt : ('c -> Sexp.t) -> ('t -> Sexp.t) -> ('c,'t) pt -> Sexp.t - -end diff --git a/serlib_8_19/ser_conv_oracle.ml b/serlib_8_19/ser_conv_oracle.ml deleted file mode 100644 index 113b1670..00000000 --- a/serlib_8_19/ser_conv_oracle.ml +++ /dev/null @@ -1,34 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t) -> (b -> Sexp.t) -> (a,b) thunk -> Sexp.t = - fun f _ t -> match t with - | Value v -> f v - | Thunk t -> f (Lazy.force t) - -let thunk_of_sexp : type a b. (Sexp.t -> a) -> (Sexp.t -> b) -> Sexp.t -> (a,b) thunk = - fun f _ s -> Value (f s) - -let thunk_of_yojson : type a b. (Yojson.Safe.t -> (a, string) Result.result) -> (Yojson.Safe.t -> (b, string) Result.result) -> Yojson.Safe.t -> ((a,b) thunk, string) Result.result = - fun f _ s -> Result.map (fun s -> Value s) (f s) - -let thunk_to_yojson : type a b. (a -> Yojson.Safe.t) -> (b -> Yojson.Safe.t) -> (a,b) thunk -> Yojson.Safe.t = - fun f _ t -> match t with - | Value v -> f v - | Thunk t -> f (Lazy.force t) - -let _hash : type a b. (a -> int) -> (b -> int) -> (a,b) thunk -> int = - fun f _ t -> match t with - | Value v -> f v - | Thunk t -> f (Lazy.force t) - -let hash_fold_thunk : type a b. (a Ppx_hash_lib.Std.Hash.folder) -> (b Ppx_hash_lib.Std.Hash.folder) -> (a,b) thunk Ppx_hash_lib.Std.Hash.folder = - fun f _ st t -> match t with - | Value v -> f st v - | Thunk t -> f st (Lazy.force t) - -let compare_thunk : type a b. (a Ppx_compare_lib.compare) -> (b Ppx_compare_lib.compare) -> (a,b) thunk Ppx_compare_lib.compare = - fun f _ t1 t2 -> match t1,t2 with - | Value v1, Value v2 -> f v1 v2 - | Thunk t1, Value v2 -> f (Lazy.force t1) v2 - | Value v1, Thunk t2 -> f v1 (Lazy.force t2) - | Thunk t1, Thunk t2 -> f (Lazy.force t1) (Lazy.force t2) - -type ('a, 'b) t = - [%import: ('a, 'b) DAst.t] - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_dAst.mli b/serlib_8_19/ser_dAst.mli deleted file mode 100644 index 20b7a1a3..00000000 --- a/serlib_8_19/ser_dAst.mli +++ /dev/null @@ -1,21 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* template_arity -val sexp_of_template_arity : template_arity -> Sexp.t - -type ('a, 'b) declaration_arity = ('a, 'b) Declarations.declaration_arity - -val declaration_arity_of_sexp : - (Sexp.t -> 'a) -> - (Sexp.t -> 'b) -> - Sexp.t -> ('a, 'b) declaration_arity - -val sexp_of_declaration_arity : - ('a -> Sexp.t) -> - ('b -> Sexp.t) -> - ('a, 'b) declaration_arity -> Sexp.t - -type recarg = Declarations.recarg - [@@deriving sexp,yojson,hash,compare] - -type wf_paths = recarg Rtree.t - [@@deriving sexp,yojson,hash,compare] - -type regular_inductive_arity = Declarations.regular_inductive_arity - [@@deriving sexp,yojson,hash,compare] - -type inductive_arity = Declarations.inductive_arity - [@@deriving sexp,yojson,hash,compare] - -type one_inductive_body = Declarations.one_inductive_body - [@@deriving sexp,yojson,hash,compare] - -(* type set_predicativity = Declarations.set_predicativity - * val set_predicativity_of_sexp : Sexp.t -> set_predicativity - * val sexp_of_set_predicativity : set_predicativity -> Sexp.t *) - -(* type engagement = Declarations.engagement - * val engagement_of_sexp : Sexp.t -> engagement - * val sexp_of_engagement : engagement -> Sexp.t *) - -type typing_flags = Declarations.typing_flags - [@@deriving sexp,yojson,hash,compare] - -type inline = Declarations.inline - [@@deriving sexp,yojson,hash,compare] - -(* type work_list = Declarations.work_list *) - -(* type abstr_info = Declarations.abstr_info = { - * abstr_ctx : Constr.named_context; - * abstr_subst : Univ.Instance.t; - * abstr_uctx : Univ.AbstractContext.t; - * } - * - * type cooking_info = Declarations.cooking_info - * val sexp_of_cooking_info : cooking_info -> Sexp.t - * val cooking_info_of_sexp : Sexp.t -> cooking_info *) - -type 'a pconstant_body = 'a Declarations.pconstant_body - [@@deriving sexp,yojson,hash,compare] - -type constant_body = Declarations.constant_body - [@@deriving sexp,yojson,hash,compare] - -(* type record_body = Declarations.record_body - * val record_body_of_sexp : Sexp.t -> record_body - * val sexp_of_record_body : record_body -> Sexp.t *) - -type recursivity_kind = Declarations.recursivity_kind - [@@deriving sexp,yojson,hash,compare] - -type mutual_inductive_body = Declarations.mutual_inductive_body - [@@deriving sexp,yojson,hash,compare] - -type 'a module_alg_expr = 'a Declarations.module_alg_expr - [@@deriving sexp,yojson,hash,compare] - -type structure_body = Declarations.structure_body - [@@deriving sexp,yojson,hash,compare] - -type module_body = Declarations.module_body - [@@deriving sexp,yojson,hash,compare] - -type module_type_body = Declarations.module_type_body - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_declaremods.ml b/serlib_8_19/ser_declaremods.ml deleted file mode 100644 index faab1f64..00000000 --- a/serlib_8_19/ser_declaremods.ml +++ /dev/null @@ -1,39 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* env val sexp_of_env : env -> Sexp.t - -type ('constr, 'types) punsafe_judgment = ('constr, 'types) - Environ.punsafe_judgment - -val punsafe_judgment_of_sexp : (Sexp.t -> 'constr) -> (Sexp.t -> - 'types) -> Sexp.t -> ('constr, 'types) punsafe_judgment val - sexp_of_punsafe_judgment : ('constr -> Sexplib.Sexp.t) -> ('types - -> Sexplib.Sexp.t) -> ('constr, 'types) punsafe_judgment -> Sexp.t - -type unsafe_judgment = Environ.unsafe_judgment val - unsafe_judgment_of_sexp : Sexp.t -> unsafe_judgment val - sexp_of_unsafe_judgment : unsafe_judgment -> Sexp.t diff --git a/serlib_8_19/ser_equality.ml b/serlib_8_19/ser_equality.ml deleted file mode 100644 index d0780a00..00000000 --- a/serlib_8_19/ser_equality.ml +++ /dev/null @@ -1,25 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* |= _t_get) -let to_yojson level = _t_to_yojson (_t_put level) - -let hash x = hash__t (_t_put x) -let hash_fold_t st id = hash_fold__t st (_t_put id) - -let compare x y = compare__t (_t_put x) (_t_put y) - -end - -include Self - -module Set = Ser_cSet.Make(Evar.Set)(Self) diff --git a/serlib_8_19/ser_evar.mli b/serlib_8_19/ser_evar.mli deleted file mode 100644 index 131d0371..00000000 --- a/serlib_8_19/ser_evar.mli +++ /dev/null @@ -1,23 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* conv_pb -val sexp_of_conv_pb : conv_pb -> Sexp.t - -type evar_constraint = Evd.evar_constraint - -val evar_constraint_of_sexp : Sexp.t -> evar_constraint -val sexp_of_evar_constraint : evar_constraint -> Sexp.t - -type unsolvability_explanation = Evd.unsolvability_explanation - -val unsolvability_explanation_of_sexp : Sexp.t -> unsolvability_explanation -val sexp_of_unsolvability_explanation : unsolvability_explanation -> Sexp.t diff --git a/serlib_8_19/ser_extend.ml b/serlib_8_19/ser_extend.ml deleted file mode 100644 index 365f7511..00000000 --- a/serlib_8_19/ser_extend.ml +++ /dev/null @@ -1,55 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* production_position -val sexp_of_production_position : production_position -> Sexp.t - -type production_level = Extend.production_level [@@deriving sexp,yojson,hash,compare] - -type binder_entry_kind = Extend.binder_entry_kind -val binder_entry_kind_of_sexp : Sexp.t -> binder_entry_kind -val sexp_of_binder_entry_kind : binder_entry_kind -> Sexp.t - -type 'lev constr_entry_key_gen = 'lev Extend.constr_entry_key_gen -val constr_entry_key_gen_of_sexp : (Sexp.t -> 'lev) -> - Sexp.t -> 'lev constr_entry_key_gen -val sexp_of_constr_entry_key_gen : ('lev -> Sexp.t) -> - 'lev constr_entry_key_gen -> Sexp.t - -type constr_entry_key = Extend.constr_entry_key -val constr_entry_key_of_sexp : Sexp.t -> constr_entry_key -val sexp_of_constr_entry_key : constr_entry_key -> Sexp.t - -type constr_prod_entry_key = Extend.constr_prod_entry_key -val constr_prod_entry_key_of_sexp : Sexp.t -> constr_prod_entry_key -val sexp_of_constr_prod_entry_key : constr_prod_entry_key -> Sexp.t - -type simple_constr_prod_entry_key = Extend.simple_constr_prod_entry_key [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_feedback.ml b/serlib_8_19/ser_feedback.ml deleted file mode 100644 index 23fb4edc..00000000 --- a/serlib_8_19/ser_feedback.ml +++ /dev/null @@ -1,46 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* doc_id -val sexp_of_doc_id : doc_id -> Sexp.t -val doc_id_of_yojson : Yojson.Safe.t -> (doc_id, string) Result.result -val doc_id_to_yojson : doc_id -> Yojson.Safe.t - -type level = Feedback.level - -val level_of_sexp : Sexp.t -> level -val sexp_of_level : level -> Sexp.t -val level_of_yojson : Yojson.Safe.t -> (level, string) Result.result -val level_to_yojson : level -> Yojson.Safe.t - -type route_id = Feedback.route_id -val route_id_of_sexp : Sexp.t -> route_id -val sexp_of_route_id : route_id -> Sexp.t -val route_id_of_yojson : Yojson.Safe.t -> (route_id, string) Result.result -val route_id_to_yojson : route_id -> Yojson.Safe.t - -type feedback_content = Feedback.feedback_content - -val feedback_content_of_sexp : Sexp.t -> feedback_content -val sexp_of_feedback_content : feedback_content -> Sexp.t -val feedback_content_of_yojson : Yojson.Safe.t -> (feedback_content, string) Result.result -val feedback_content_to_yojson : feedback_content -> Yojson.Safe.t - -type feedback = Feedback.feedback - -val feedback_of_sexp : Sexp.t -> feedback -val sexp_of_feedback : feedback -> Sexp.t -val feedback_of_yojson : Yojson.Safe.t -> (feedback, string) Result.result -val feedback_to_yojson : feedback -> Yojson.Safe.t diff --git a/serlib_8_19/ser_flags.ml b/serlib_8_19/ser_flags.ml deleted file mode 100644 index d4e39eae..00000000 --- a/serlib_8_19/ser_flags.ml +++ /dev/null @@ -1,18 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t = fun at -> - match at with - | Rawwit w -> List [Atom "Rawwit"; sexp_of_genarg_type w] - | Glbwit w -> List [Atom "Glbwit"; sexp_of_genarg_type w] - | Topwit w -> List [Atom "Topwit"; sexp_of_genarg_type w] - -let rec argument_type_of_sexp : Sexp.t -> argument_type = fun sexp -> - match sexp with - | List [Atom "ExtraArg"; Atom tag] -> - begin match ArgT.name tag with - | None -> raise (Failure "SEXP Exception in argument_type") - | Some (ArgT.Any t) -> ArgumentType (ExtraArg t) - end - | List [Atom "ListArg"; s1] -> - let (ArgumentType t) = argument_type_of_sexp s1 in - ArgumentType (ListArg t) - | List [Atom "OptArg"; s1] -> - let (ArgumentType t) = argument_type_of_sexp s1 in - ArgumentType (OptArg t) - | List [Atom "PairArg"; s1; s2] -> - let (ArgumentType t1) = argument_type_of_sexp s1 in - let (ArgumentType t2) = argument_type_of_sexp s2 in - ArgumentType (PairArg(t1,t2)) - | _ -> raise (Failure "SEXP Exception") - -let hash_fold_abstract_argument_type : type lvl. ('o, lvl) abstract_argument_type Hash.folder = fun st at -> - match at with - | Rawwit w -> hash_tagged hash_fold_genarg_type st "raw" w - | Glbwit w -> hash_tagged hash_fold_genarg_type st "glb" w - | Topwit w -> hash_tagged hash_fold_genarg_type st "top" w - -type ('raw, 'glb, 'top) gen_ser = - { raw_ser : 'raw -> Sexp.t - ; raw_des : Sexp.t -> 'raw - ; raw_hash : 'raw Hash.folder - ; raw_compare : 'raw -> 'raw -> int - - ; glb_ser : 'glb -> Sexp.t - ; glb_des : Sexp.t -> 'glb - ; glb_hash : 'glb Hash.folder - ; glb_compare : 'glb -> 'glb -> int - - ; top_ser : 'top -> Sexp.t - ; top_des : Sexp.t -> 'top - ; top_hash : 'top Ppx_hash_lib.Std.Hash.folder - ; top_compare : 'top -> 'top -> int - } - -module T2_ = struct - type ('a, 'b) t = 'a * 'b [@@deriving hash, compare] -end - -let gen_ser_list : - ('raw, 'glb, 'top) gen_ser -> - ('raw list, 'glb list, 'top list) gen_ser = fun g -> - let open Sexplib.Conv in - { raw_ser = sexp_of_list g.raw_ser - ; raw_des = list_of_sexp g.raw_des - ; raw_hash = Hash.Builtin.hash_fold_list g.raw_hash - ; raw_compare = compare_list g.raw_compare - - ; glb_ser = sexp_of_list g.glb_ser - ; glb_des = list_of_sexp g.glb_des - ; glb_hash = Hash.Builtin.hash_fold_list g.glb_hash - ; glb_compare = compare_list g.glb_compare - - ; top_ser = sexp_of_list g.top_ser - ; top_des = list_of_sexp g.top_des - ; top_hash = Hash.Builtin.hash_fold_list g.top_hash - ; top_compare = compare_list g.top_compare - } - -let gen_ser_opt : - ('raw, 'glb, 'top) gen_ser -> - ('raw option, 'glb option, 'top option) gen_ser = fun g -> - let open Sexplib.Conv in - { raw_ser = sexp_of_option g.raw_ser - ; raw_des = option_of_sexp g.raw_des - ; raw_hash = Hash.Builtin.hash_fold_option g.raw_hash - ; raw_compare = compare_option g.raw_compare - - ; glb_ser = sexp_of_option g.glb_ser - ; glb_des = option_of_sexp g.glb_des - ; glb_hash = Hash.Builtin.hash_fold_option g.glb_hash - ; glb_compare = compare_option g.glb_compare - - ; top_ser = sexp_of_option g.top_ser - ; top_des = option_of_sexp g.top_des - ; top_hash = Hash.Builtin.hash_fold_option g.top_hash - ; top_compare = compare_option g.top_compare - } - -let gen_ser_pair : - ('raw1, 'glb1, 'top1) gen_ser -> - ('raw2, 'glb2, 'top2) gen_ser -> - (('raw1 * 'raw2), ('glb1 * 'glb2), ('top1 * 'top2)) gen_ser = fun g1 g2 -> - let open Sexplib.Conv in - { raw_ser = sexp_of_pair g1.raw_ser g2.raw_ser - ; raw_des = pair_of_sexp g1.raw_des g2.raw_des - ; raw_hash = T2_.hash_fold_t g1.raw_hash g2.raw_hash - ; raw_compare = T2_.compare g1.raw_compare g2.raw_compare - - ; glb_ser = sexp_of_pair g1.glb_ser g2.glb_ser - ; glb_des = pair_of_sexp g1.glb_des g2.glb_des - ; glb_hash = T2_.hash_fold_t g1.glb_hash g2.glb_hash - ; glb_compare = T2_.compare g1.glb_compare g2.glb_compare - - ; top_ser = sexp_of_pair g1.top_ser g2.top_ser - ; top_des = pair_of_sexp g1.top_des g2.top_des - ; top_hash = T2_.hash_fold_t g1.top_hash g2.top_hash - ; top_compare = T2_.compare g1.top_compare g2.top_compare - } - -module SerObj = struct - - type ('raw, 'glb, 'top) obj = ('raw, 'glb, 'top) gen_ser - - let sexp_of_gen typ ga = - let typ = typ ^ ": " ^ Sexp.to_string (sexp_of_genarg_type ga) in - Serlib_base.sexp_of_opaque ~typ - - let name = "ser_arg" - let default _ga = - Some - { - (* raw_ser = (fun _ -> Sexp.(List [Atom "[XXX ser_gen]"; Atom "raw"; sexp_of_genarg_type ga])); *) - raw_ser = sexp_of_gen "raw" _ga - ; raw_des = (Sexplib.Conv_error.no_matching_variant_found "raw_arg") - ; raw_hash = (fun st a -> Hash.fold_int st (Hashtbl.hash a)) - ; raw_compare = Stdlib.compare - - (* glb_ser = (fun _ -> Sexp.(List [Atom "[XXX ser_gen]"; Atom "glb"; sexp_of_genarg_type ga])); *) - ; glb_ser = sexp_of_gen "glb" _ga - ; glb_des = (Sexplib.Conv_error.no_matching_variant_found "glb_arg") - ; glb_hash = (fun st a -> Hash.fold_int st (Hashtbl.hash a)) - ; glb_compare = Stdlib.compare - - (* top_ser = (fun _ -> Sexp.(List [Atom "[XXX ser_gen]"; Atom "top"; sexp_of_genarg_type ga])); *) - ; top_ser = sexp_of_gen "top" _ga - ; top_des = (Sexplib.Conv_error.no_matching_variant_found "top_arg") - ; top_hash = (fun st a -> Hash.fold_int st (Hashtbl.hash a)) - ; top_compare = Stdlib.compare - } -end - -module SerGen = Register(SerObj) -let register_genser ty obj = SerGen.register0 ty obj - -let rec get_gen_ser_ty : type r g t. (r,g,t) Genarg.genarg_type -> (r,g,t) gen_ser = - fun gt -> match gt with - | Genarg.ExtraArg _ -> SerGen.obj gt - | Genarg.ListArg t -> gen_ser_list (get_gen_ser_ty t) - | Genarg.OptArg t -> gen_ser_opt (get_gen_ser_ty t) - | Genarg.PairArg(t1, t2) -> gen_ser_pair (get_gen_ser_ty t1) (get_gen_ser_ty t2) - -let get_gen_ser : type lvl. ('o,lvl) abstract_argument_type -> ('o -> 't) = fun aty -> - match aty with - | Genarg.Rawwit ty -> (get_gen_ser_ty ty).raw_ser - | Genarg.Glbwit ty -> (get_gen_ser_ty ty).glb_ser - | Genarg.Topwit ty -> (get_gen_ser_ty ty).top_ser - -let generic_des : type lvl. ('o,lvl) abstract_argument_type -> Sexp.t -> lvl generic_argument = fun ty s -> - match ty with - | Genarg.Rawwit w -> GenArg(ty, (get_gen_ser_ty w).raw_des s) - | Genarg.Glbwit w -> GenArg(ty, (get_gen_ser_ty w).glb_des s) - | Genarg.Topwit w -> GenArg(ty, (get_gen_ser_ty w).top_des s) - -let hash_fold_generic : type lvl. ('o,lvl) abstract_argument_type -> 'o Ppx_hash_lib.Std.Hash.folder = fun aty -> - match aty with - | Genarg.Rawwit ty -> (get_gen_ser_ty ty).raw_hash - | Genarg.Glbwit ty -> (get_gen_ser_ty ty).glb_hash - | Genarg.Topwit ty -> (get_gen_ser_ty ty).top_hash - -let compare_generic : type lvl. ('o,lvl) abstract_argument_type -> 'o Ppx_compare_lib.compare = fun aty -> - match aty with - | Genarg.Rawwit ty -> (get_gen_ser_ty ty).raw_compare - | Genarg.Glbwit ty -> (get_gen_ser_ty ty).glb_compare - | Genarg.Topwit ty -> (get_gen_ser_ty ty).top_compare - -(* We need to generalize this to use the proper printers for opt *) -let mk_sexparg st so = - Sexp.List [Atom "GenArg"; st; so] - -(* XXX: There is still some duplication here in the traversal of g_ty, but - we can live with that for now. *) -let sexp_of_genarg_val : type a. a generic_argument -> Sexp.t = - fun g -> match g with - | GenArg (g_ty, g_val) -> - mk_sexparg (sexp_of_abstract_argument_type g_ty) (get_gen_ser g_ty g_val) - -let sexp_of_generic_argument : type a. (a -> Sexp.t) -> a generic_argument -> Sexp.t = - fun _level_tag g -> - sexp_of_genarg_val g - -type rgen_argument = RG : 'lvl generic_argument -> rgen_argument - -let hash_fold_genarg_val : type a. a generic_argument Hash.folder = - fun st g -> match g with - | GenArg (g_ty, g_val) -> - let st = hash_fold_abstract_argument_type st g_ty in - hash_fold_generic g_ty st g_val - -let hash_fold_generic_argument : type a. a Hash.folder -> a generic_argument Hash.folder = - fun _level_tag g -> hash_fold_genarg_val g - -let compare_genarg_val : type a. a generic_argument Ppx_compare_lib.compare = - fun g1 g2 -> match g1 with - | GenArg (g1_ty, g1_val) -> - match g2 with - | GenArg (g2_ty, g2_val) -> - match Genarg.abstract_argument_type_eq g1_ty g2_ty with - | Some Refl -> - compare_generic g1_ty g1_val g2_val - (* XXX: Technically, we should implement our own compare so ordering works *) - | None -> 1 - -let compare_generic_argument : type a. a Ppx_compare_lib.compare -> a generic_argument Ppx_compare_lib.compare = - fun _level_tag g -> compare_genarg_val g - -let gen_abstype_of_sexp : Sexp.t -> rgen_argument = fun s -> - match s with - | List [Atom "GenArg"; List [ Atom "Rawwit"; sty]; sobj] -> - let (ArgumentType ty) = argument_type_of_sexp sty in - RG (generic_des (Rawwit ty) sobj) - | List [Atom "GenArg"; List [ Atom "Glbwit"; sty]; sobj] -> - let (ArgumentType ty) = argument_type_of_sexp sty in - RG (generic_des (Glbwit ty) sobj) - | List [Atom "GenArg"; List [ Atom "Topwit"; sty]; sobj] -> - let (ArgumentType ty) = argument_type_of_sexp sty in - RG (generic_des (Topwit ty) sobj) - | _ -> raise (Failure "SEXP Exception in abstype") - -let generic_argument_of_sexp _lvl sexp : 'a Genarg.generic_argument = - let (RG ga) = gen_abstype_of_sexp sexp in - Obj.magic ga - -let rec yojson_to_sexp json = match json with - | `String s -> Sexp.Atom s - | `List s -> Sexp.List (List.map yojson_to_sexp s) - | _ -> raise (Failure "ser_genarg: yojson_to_sexp") - -let rec sexp_to_yojson sexp : Yojson.Safe.t = - match sexp with - | Sexp.Atom s -> `String s - | List l -> `List (List.map sexp_to_yojson l) - -let generic_argument_of_yojson lvl json = - let sexp = yojson_to_sexp json in - Result.Ok (generic_argument_of_sexp lvl sexp) - -let generic_argument_to_yojson : type a. (a -> Yojson.Safe.t) -> a generic_argument -> Yojson.Safe.t = - fun _level_tag g -> - sexp_of_generic_argument (fun _ -> Atom "") g |> sexp_to_yojson - -type 'a generic_argument = 'a Genarg.generic_argument - -type glob_generic_argument = - [%import: Genarg.glob_generic_argument] - [@@deriving sexp,yojson,hash,compare] - -type raw_generic_argument = - [%import: Genarg.raw_generic_argument] - [@@deriving sexp,yojson,hash,compare] - -type typed_generic_argument = - [%import: Genarg.typed_generic_argument] - [@@deriving sexp,yojson,hash,compare] - -let mk_uniform pin pout phash pcompare = - { raw_ser = pin - ; raw_des = pout - ; raw_hash = phash - ; raw_compare = pcompare - - ; glb_ser = pin - ; glb_des = pout - ; glb_hash = phash - ; glb_compare = pcompare - - ; top_ser = pin - ; top_des = pout - ; top_hash = phash - ; top_compare = pcompare - } - -module type GenSer0 = sig - type t [@@deriving sexp,hash,compare] -end - -module GS0 (M : GenSer0) = struct - let genser = mk_uniform M.sexp_of_t M.t_of_sexp M.hash_fold_t M.compare -end - -module type GenSer = sig - type raw [@@deriving sexp,hash,compare] - type glb [@@deriving sexp,hash,compare] - type top [@@deriving sexp,hash,compare] -end - -module GS (M : GenSer) = struct - let genser = - { raw_ser = M.sexp_of_raw - ; raw_des = M.raw_of_sexp - ; raw_hash = M.hash_fold_raw - ; raw_compare = M.compare_raw - - ; glb_ser = M.sexp_of_glb - ; glb_des = M.glb_of_sexp - ; glb_hash = M.hash_fold_glb - ; glb_compare = M.compare_glb - - ; top_ser = M.sexp_of_top - ; top_des = M.top_of_sexp - ; top_hash = M.hash_fold_top - ; top_compare = M.compare_top - } -end diff --git a/serlib_8_19/ser_genarg.mli b/serlib_8_19/ser_genarg.mli deleted file mode 100644 index 083b82d4..00000000 --- a/serlib_8_19/ser_genarg.mli +++ /dev/null @@ -1,96 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t) ref *) -(* val sexp_of_tacdef_body : (Tacexpr.tacdef_body -> Sexp.t) ref *) - -(**********************************************************************) -(* GenArg *) -(**********************************************************************) - -type rlevel = Genarg.rlevel - [@@deriving sexp,yojson,hash,compare] -type glevel = Genarg.glevel - [@@deriving sexp,yojson,hash,compare] -type tlevel = Genarg.tlevel - [@@deriving sexp,yojson,hash,compare] - -type 'a generic_argument = 'a Genarg.generic_argument - [@@deriving sexp,yojson,hash,compare] - -type glob_generic_argument = Genarg.glob_generic_argument -[@@deriving sexp,yojson,hash,compare] - -type raw_generic_argument = Genarg.raw_generic_argument -[@@deriving sexp,yojson,hash,compare] - -type typed_generic_argument = Genarg.typed_generic_argument -val typed_generic_argument_of_sexp : Sexp.t -> Genarg.typed_generic_argument -val sexp_of_typed_generic_argument : Genarg.typed_generic_argument -> Sexp.t - -(* Registering serializing functions *) -type ('raw, 'glb, 'top) gen_ser = - { raw_ser : 'raw -> Sexp.t - ; raw_des : Sexp.t -> 'raw - ; raw_hash : 'raw Ppx_hash_lib.Std.Hash.folder - ; raw_compare : 'raw -> 'raw -> int - - ; glb_ser : 'glb -> Sexp.t - ; glb_des : Sexp.t -> 'glb - ; glb_hash : 'glb Ppx_hash_lib.Std.Hash.folder - ; glb_compare : 'glb -> 'glb -> int - - ; top_ser : 'top -> Sexp.t - ; top_des : Sexp.t -> 'top - ; top_hash : 'top Ppx_hash_lib.Std.Hash.folder - ; top_compare : 'top -> 'top -> int - } - -val register_genser : - ('raw, 'glb, 'top) Genarg.genarg_type -> - ('raw, 'glb, 'top) gen_ser -> unit - -val gen_ser_pair : - ('raw1, 'glb1, 'top1) gen_ser -> - ('raw2, 'glb2, 'top2) gen_ser -> - (('raw1 * 'raw2), ('glb1 * 'glb2), ('top1 * 'top2)) gen_ser - -val gen_ser_list : - ('raw, 'glb, 'top) gen_ser -> - ('raw list, 'glb list, 'top list) gen_ser - -val mk_uniform : ('t -> Sexp.t) -> (Sexp.t -> 't) -> - 't Ppx_hash_lib.Std.Hash.folder -> - 't Ppx_compare_lib.compare -> - ('t,'t,'t) gen_ser - -module type GenSer0 = sig - type t [@@deriving sexp,hash,compare] -end - -module GS0 (M : GenSer0) : sig val genser : (M.t,M.t,M.t) gen_ser end - -module type GenSer = sig - type raw [@@deriving sexp,hash,compare] - type glb [@@deriving sexp,hash,compare] - type top [@@deriving sexp,hash,compare] -end - -module GS (M : GenSer) : sig val genser : (M.raw,M.glb,M.top) gen_ser end diff --git a/serlib_8_19/ser_genintern.ml b/serlib_8_19/ser_genintern.ml deleted file mode 100644 index eef19d39..00000000 --- a/serlib_8_19/ser_genintern.ml +++ /dev/null @@ -1,53 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* glob_sign -val sexp_of_glob_sign : glob_sign -> Sexp.t - -type glob_constr_and_expr = Genintern.glob_constr_and_expr - [@@deriving sexp, yojson, hash, compare] - -type glob_constr_pattern_and_expr = Genintern.glob_constr_pattern_and_expr - [@@deriving sexp, yojson, hash, compare] diff --git a/serlib_8_19/ser_geninterp.ml b/serlib_8_19/ser_geninterp.ml deleted file mode 100644 index 5075a82b..00000000 --- a/serlib_8_19/ser_geninterp.ml +++ /dev/null @@ -1,60 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t -> 'a red_atom -val sexp_of_red_atom : ('a -> Sexp.t) -> 'a red_atom -> Sexp.t - -type 'a glob_red_flag = 'a Genredexpr.glob_red_flag - -val glob_red_flag_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a glob_red_flag -val sexp_of_glob_red_flag : ('a -> Sexp.t) -> 'a glob_red_flag -> Sexp.t -val glob_red_flag_of_yojson : (Yojson.Safe.t -> ('a, string) Result.result) -> Yojson.Safe.t -> ('a glob_red_flag, string) Result.result -val glob_red_flag_to_yojson : ('a -> Yojson.Safe.t) -> 'a glob_red_flag -> Yojson.Safe.t - -type ('a, 'b, 'c) red_expr_gen = ('a, 'b, 'c) Genredexpr.red_expr_gen - [@@deriving sexp,yojson,hash,compare] - -type ('a, 'b, 'c) may_eval = ('a, 'b, 'c) Genredexpr.may_eval - [@@deriving sexp,yojson,hash,compare] - -type raw_red_expr = Genredexpr.raw_red_expr [@@deriving sexp,yojson,hash,compare] - -type 'a and_short_name = 'a Genredexpr.and_short_name - [@@deriving sexp,yojson,hash,compare] - -type glob_red_expr = Genredexpr.glob_red_expr - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_glob_term.ml b/serlib_8_19/ser_glob_term.ml deleted file mode 100644 index 4d9acb57..00000000 --- a/serlib_8_19/ser_glob_term.ml +++ /dev/null @@ -1,157 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t -> 'a Glob_term.cast_type - * val sexp_of_cast_type : ('a -> Sexp.t) -> 'a Glob_term.cast_type -> Sexp.t - * val cast_type_of_yojson : (Yojson.Safe.t -> ('a,string) result ) -> Yojson.Safe.t -> ('a cast_type, string) Result.result - * val cast_type_to_yojson : ('a -> Yojson.Safe.t) -> 'a cast_type -> Yojson.Safe.t *) - -type glob_constraint = Glob_term.glob_constraint -val glob_constraint_of_sexp : Sexp.t -> Glob_term.glob_constraint -val sexp_of_glob_constraint : Glob_term.glob_constraint -> Sexp.t -val glob_constraint_of_yojson : Yojson.Safe.t -> (glob_constraint, string) Result.result -val glob_constraint_to_yojson : glob_constraint -> Yojson.Safe.t - -type existential_name = Glob_term.existential_name [@@deriving sexp,yojson,hash,compare] -type cases_pattern = Glob_term.cases_pattern - -type glob_constr = Glob_term.glob_constr -and glob_decl = Glob_term.glob_decl -and predicate_pattern = Glob_term.predicate_pattern -and tomatch_tuple = Glob_term.tomatch_tuple -and tomatch_tuples = Glob_term.tomatch_tuples -and cases_clause = Glob_term.cases_clause -and cases_clauses = Glob_term.cases_clauses - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_globnames.ml b/serlib_8_19/ser_globnames.ml deleted file mode 100644 index c0ee9569..00000000 --- a/serlib_8_19/ser_globnames.ml +++ /dev/null @@ -1,27 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* option_value -val sexp_of_option_value : option_value -> Sexp.t -val option_value_of_yojson : Yojson.Safe.t -> (option_value, string) Result.result -val option_value_to_yojson : option_value -> Yojson.Safe.t - -type option_state = Goptions.option_state - -val option_state_of_sexp : Sexp.t -> option_state -val sexp_of_option_state : option_state -> Sexp.t - -type table_value = Goptions.table_value [@@deriving sexp, yojson, hash,compare] diff --git a/serlib_8_19/ser_gramlib.ml b/serlib_8_19/ser_gramlib.ml deleted file mode 100644 index 0743815d..00000000 --- a/serlib_8_19/ser_gramlib.ml +++ /dev/null @@ -1,23 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* |= _t_get) -let qualid_r_to_yojson level = _t_to_yojson (_t_put level) - -(* let hash_qualid_r x = hash__t (_t_put x) *) -let hash_fold_qualid_r st x = hash_fold__t st (_t_put x) -let compare_qualid_r x y = compare__t (_t_put x) (_t_put y) - -(* qualid: private *) -type qualid = - [%import: Libnames.qualid] - [@@deriving sexp,yojson,hash,compare] - -module FP = struct - type _t = - { dirpath : Names.DirPath.t - ; basename : Names.Id.t } - [@@deriving sexp,yojson,hash,compare] - - let _t_get { dirpath; basename } = Libnames.make_path dirpath basename - let _t_put fp = let dirpath, basename = Libnames.repr_path fp in { dirpath; basename } -end - -open FP - -type full_path = Libnames.full_path -let full_path_of_sexp sexp = _t_get (_t_of_sexp sexp) -let sexp_of_full_path qid = sexp_of__t (_t_put qid) - -let full_path_of_yojson json = Ppx_deriving_yojson_runtime.(_t_of_yojson json >|= _t_get) -let full_path_to_yojson level = _t_to_yojson (_t_put level) - -let hash_full_path x = hash__t (_t_put x) -let hash_fold_full_path st x = hash_fold__t st (_t_put x) - -let compare_full_path x y = compare__t (_t_put x) (_t_put y) diff --git a/serlib_8_19/ser_libnames.mli b/serlib_8_19/ser_libnames.mli deleted file mode 100644 index 616c7e6a..00000000 --- a/serlib_8_19/ser_libnames.mli +++ /dev/null @@ -1,20 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t -> 'a occurrences_gen -val sexp_of_occurrences_gen : ('a -> Sexp.t) -> 'a occurrences_gen -> Sexp.t - -type occurrences_expr = Locus.occurrences_expr - -val occurrences_expr_of_sexp : Sexp.t -> occurrences_expr -val sexp_of_occurrences_expr : occurrences_expr -> Sexp.t - -type 'a with_occurrences = 'a Locus.with_occurrences [@@deriving sexp, yojson, hash,compare] - -type occurrences = Locus.occurrences -val occurrences_of_sexp : Sexp.t -> occurrences -val sexp_of_occurrences : occurrences -> Sexp.t - -type hyp_location_flag = Locus.hyp_location_flag - [@@deriving sexp,hash,compare] - -type 'a hyp_location_expr = 'a Locus.hyp_location_expr -val hyp_location_expr_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a hyp_location_expr -val sexp_of_hyp_location_expr : ('a -> Sexp.t) -> 'a hyp_location_expr -> Sexp.t - -type 'id clause_expr = 'id Locus.clause_expr - [@@deriving sexp,yojson,hash,compare] - -type clause = Locus.clause - -val clause_of_sexp : Sexp.t -> clause -val sexp_of_clause : clause -> Sexp.t - -type clause_atom = Locus.clause_atom - -val clause_atom_of_sexp : Sexp.t -> clause_atom -val sexp_of_clause_atom : clause_atom -> Sexp.t - -type concrete_clause = Locus.concrete_clause - -val concrete_clause_of_sexp : Sexp.t -> concrete_clause -val sexp_of_concrete_clause : concrete_clause -> Sexp.t - -type hyp_location = Locus.hyp_location - [@@deriving sexp,yojson,hash,compare] - -type goal_location = Locus.goal_location - -val goal_location_of_sexp : Sexp.t -> goal_location -val sexp_of_goal_location : goal_location -> Sexp.t - -type simple_clause = Locus.simple_clause -val simple_clause_of_sexp : Sexp.t -> simple_clause -val sexp_of_simple_clause : simple_clause -> Sexp.t - -type 'id or_like_first = 'id Locus.or_like_first - -val or_like_first_of_sexp : (Sexp.t -> 'id) -> Sexp.t -> 'id or_like_first -val sexp_of_or_like_first : ('id -> Sexp.t) -> 'id or_like_first -> Sexp.t diff --git a/serlib_8_19/ser_ltac_pretype.ml b/serlib_8_19/ser_ltac_pretype.ml deleted file mode 100644 index 6428150a..00000000 --- a/serlib_8_19/ser_ltac_pretype.ml +++ /dev/null @@ -1,37 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* closure -val sexp_of_closure : closure -> Sexp.t - -type closed_glob_constr = Ltac_pretype.closed_glob_constr - [@@deriving sexp,hash,compare] - -type constr_under_binders = Ltac_pretype.constr_under_binders - -val constr_under_binders_of_sexp : Sexp.t -> constr_under_binders -val sexp_of_constr_under_binders : constr_under_binders -> Sexp.t diff --git a/serlib_8_19/ser_mod_subst.ml b/serlib_8_19/ser_mod_subst.ml deleted file mode 100644 index 9dbb71ed..00000000 --- a/serlib_8_19/ser_mod_subst.ml +++ /dev/null @@ -1,37 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t) -> 'a substituted -> Sexp.t - * val substituted_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a substituted *) diff --git a/serlib_8_19/ser_namegen.ml b/serlib_8_19/ser_namegen.ml deleted file mode 100644 index c21d37a0..00000000 --- a/serlib_8_19/ser_namegen.ml +++ /dev/null @@ -1,23 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* |= _kername_get) -let to_yojson kn = _t_to_yojson (_t_put kn) - -let hash x = hash__t (_t_put x) -let hash_fold_t st id = hash_fold__t st (_t_put id) - -let compare x y = compare__t (_t_put x) (_t_put y) - -let equal = KerName.equal - -end - -module KNmap = Ser_cMap.Make(Names.KNmap)(KerName) - -module Constant = struct - -(* Constant.t: private *) -type t = [%import: Names.Constant.t] - -type _t = Constant of KerName.t * KerName.t option - [@@deriving sexp,yojson,hash,compare] - -let _t_put cs = - let cu, cc = Constant.(user cs, canonical cs) in - if KerName.equal cu cc then Constant (cu, None) else Constant (cu, Some cc) -let _t_get = function - | Constant (cu, None) -> Constant.make1 cu - | Constant (cu, Some cc) -> Constant.make cu cc - -let t_of_sexp sexp = _t_get (_t_of_sexp sexp) -let sexp_of_t dp = sexp_of__t (_t_put dp) - -let of_yojson json = Ppx_deriving_yojson_runtime.(_t_of_yojson json >|= _t_get) -let to_yojson level = _t_to_yojson (_t_put level) - -let hash x = hash__t (_t_put x) -let hash_fold_t st id = hash_fold__t st (_t_put id) - -let compare x y = compare__t (_t_put x) (_t_put y) - -end - -module Cset_env = Ser_cSet.Make(Cset_env)(Constant) - -module Cmap = Ser_cMap.Make(Cmap)(Constant) -module Cmap_env = Ser_cMap.Make(Cmap_env)(Constant) - -module MutInd = struct - -(* MutInd.t: private *) - module BijectSpec = struct - type t = [%import: Names.MutInd.t] - type _t = MutInd of KerName.t * KerName.t option - [@@deriving sexp,yojson,hash,compare] - - let of_t cs = - let cu, cc = MutInd.(user cs, canonical cs) in - if KerName.equal cu cc then MutInd (cu, None) else MutInd (cu, Some cc) - - let to_t = function - | MutInd (cu, None) -> MutInd.make1 cu - | MutInd (cu, Some cc) -> MutInd.make cu cc - end - - include SerType.Biject(BijectSpec) -end - -module Mindmap = Ser_cMap.Make(Mindmap)(MutInd) -module Mindmap_env = Ser_cMap.Make(Mindmap_env)(MutInd) - -type 'a tableKey = - [%import: 'a Names.tableKey] - [@@deriving sexp] - -type variable = - [%import: Names.variable] - [@@deriving sexp,yojson,hash,compare] - -(* Inductive and constructor = public *) -module Ind = struct - type t = - [%import: Names.Ind.t] - [@@deriving sexp,yojson,hash,compare] -end - -module Indset_env = Ser_cSet.Make(Indset_env)(Ind) -module Indmap_env = Ser_cMap.Make(Indmap_env)(Ind) - -type inductive = - [%import: Names.inductive] - [@@deriving sexp,yojson,hash,compare] - -module Construct = struct - type t = - [%import: Names.Construct.t] - [@@deriving sexp,yojson,hash,compare] - -end -type constructor = - [%import: Names.constructor] - [@@deriving sexp,yojson,hash,compare] - -(* Projection: private *) -module Projection = struct - - module Repr = struct - module PierceSpec = struct - type t = Names.Projection.Repr.t - type _t = - { proj_ind : inductive - ; proj_relevant : bool - ; proj_npars : int - ; proj_arg : int - ; proj_name : Label.t - } [@@deriving sexp,yojson,hash,compare] - end - include SerType.Pierce(PierceSpec) - end - - module PierceSpec = struct - type t = [%import: Names.Projection.t] - type _t = Repr.t * bool - [@@deriving sexp,yojson,hash,compare] - end - include SerType.Pierce(PierceSpec) -end - -module GlobRef = struct - -type t = [%import: Names.GlobRef.t] - [@@deriving sexp,yojson,hash,compare] - -end - -(* Evaluable global reference: public *) -(* type evaluable_global_reference = - * [%import: Names.evaluable_global_reference] - * [@@deriving sexp] *) - -type lident = - [%import: Names.lident] - [@@deriving sexp,yojson,hash,compare] - -type lname = - [%import: Names.lname] - [@@deriving sexp,yojson,hash,compare] - -type lstring = - [%import: Names.lstring] - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_names.mli b/serlib_8_19/ser_names.mli deleted file mode 100644 index 41ccfd79..00000000 --- a/serlib_8_19/ser_names.mli +++ /dev/null @@ -1,79 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t -> 'a tableKey -val sexp_of_tableKey : ('a -> Sexp.t) -> 'a tableKey -> Sexp.t - -type variable = Names.variable [@@deriving sexp, yojson, hash, compare] -type inductive = Names.inductive [@@deriving sexp, yojson, hash, compare] -type constructor = Names.constructor [@@deriving sexp, yojson, hash, compare] - -module Projection : sig - - include SerType.SJHC with type t = Projection.t - - module Repr : sig - include SerType.SJHC with type t = Projection.Repr.t - end - -end - -module GlobRef : SerType.SJHC with type t = Names.GlobRef.t - -type lident = Names.lident [@@deriving sexp,yojson,hash,compare] -type lname = Names.lname [@@deriving sexp,yojson,hash,compare] -type lstring = Names.lstring [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_nametab.ml b/serlib_8_19/ser_nametab.ml deleted file mode 100644 index 12ab6da4..00000000 --- a/serlib_8_19/ser_nametab.ml +++ /dev/null @@ -1,23 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* parenRelation - * val sexp_of_parenRelation : parenRelation -> Sexp.t - * - * type precedence = Notation_gram.precedence - * - * val precedence_of_sexp : Sexp.t -> precedence - * val sexp_of_precedence : precedence -> Sexp.t - * - * type tolerability = Notation_gram.tolerability - * - * val tolerability_of_sexp : Sexp.t -> tolerability - * val sexp_of_tolerability : tolerability -> Sexp.t *) - -type grammar_constr_prod_item = Notation_gram.grammar_constr_prod_item -val grammar_constr_prod_item_of_sexp : Sexp.t -> grammar_constr_prod_item -val sexp_of_grammar_constr_prod_item : grammar_constr_prod_item -> Sexp.t - -type notation_grammar = Notation_gram.notation_grammar -val notation_grammar_of_sexp : Sexp.t -> notation_grammar -val sexp_of_notation_grammar : notation_grammar -> Sexp.t - diff --git a/serlib_8_19/ser_notation_term.ml b/serlib_8_19/ser_notation_term.ml deleted file mode 100644 index 88cf6af6..00000000 --- a/serlib_8_19/ser_notation_term.ml +++ /dev/null @@ -1,57 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* case_info_pattern -val sexp_of_case_info_pattern : case_info_pattern -> Sexp.t - -type constr_pattern = Pattern.constr_pattern - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_pp.ml b/serlib_8_19/ser_pp.ml deleted file mode 100644 index 2499cfbe..00000000 --- a/serlib_8_19/ser_pp.ml +++ /dev/null @@ -1,75 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Pp_empty - | Ppcmd_string s -> Pp_string s - | Ppcmd_glue l -> Pp_glue (List.map from_t l) - | Ppcmd_box (bt,d) -> Pp_box(bt, from_t d) - | Ppcmd_tag (t,d) -> Pp_tag(t, from_t d) - | Ppcmd_print_break (n,m) -> Pp_print_break(n,m) - | Ppcmd_force_newline -> Pp_force_newline - | Ppcmd_comment s -> Pp_comment s - - let rec to_t (d : _t) : t = unrepr (match d with - | Pp_empty -> Ppcmd_empty - | Pp_string s -> Ppcmd_string s - | Pp_glue l -> Ppcmd_glue (List.map to_t l) - | Pp_box (bt,d) -> Ppcmd_box(bt, to_t d) - | Pp_tag (t,d) -> Ppcmd_tag(t, to_t d) - | Pp_print_break (n,m) -> Ppcmd_print_break(n,m) - | Pp_force_newline -> Ppcmd_force_newline - | Pp_comment s -> Ppcmd_comment s) - -end - -type t = Pp.t -let t_of_sexp s = P.(to_t (_t_of_sexp s)) -let sexp_of_t d = P.(sexp_of__t (from_t d)) - -let of_yojson json = Ppx_deriving_yojson_runtime.(P.(_t_of_yojson json >|= to_t)) -let to_yojson level = P.(_t_to_yojson (from_t level)) - -type doc_view = - [%import: Pp.doc_view] - [@@deriving sexp, yojson] diff --git a/serlib_8_19/ser_pp.mli b/serlib_8_19/ser_pp.mli deleted file mode 100644 index 3b8696eb..00000000 --- a/serlib_8_19/ser_pp.mli +++ /dev/null @@ -1,32 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* t -val sexp_of_t : t -> Sexp.t -val of_yojson : Yojson.Safe.t -> (t, string) Result.result -val to_yojson : t -> Yojson.Safe.t - -val doc_view_of_sexp : Sexp.t -> doc_view -val sexp_of_doc_view : doc_view -> Sexp.t -val doc_view_of_yojson : Yojson.Safe.t -> (doc_view, string) Result.result -val doc_view_to_yojson : doc_view -> Yojson.Safe.t diff --git a/serlib_8_19/ser_ppextend.ml b/serlib_8_19/ser_ppextend.ml deleted file mode 100644 index d2d1c2eb..00000000 --- a/serlib_8_19/ser_ppextend.ml +++ /dev/null @@ -1,49 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* ppbox -val sexp_of_ppbox : ppbox -> Sexp.t - -type ppcut = Ppextend.ppcut - -val ppcut_of_sexp : Sexp.t -> ppcut -val sexp_of_ppcut : ppcut -> Sexp.t - -(* type unparsing = Ppextend.unparsing - * val unparsing_of_sexp : Sexp.t -> unparsing - * val sexp_of_unparsing : unparsing -> Sexp.t *) - -type unparsing_rule = Ppextend.unparsing_rule -val unparsing_rule_of_sexp : Sexp.t -> unparsing_rule -val sexp_of_unparsing_rule : unparsing_rule -> Sexp.t - -type notation_printing_rules = Ppextend.notation_printing_rules -val notation_printing_rules_of_sexp : Sexp.t -> notation_printing_rules -val sexp_of_notation_printing_rules : notation_printing_rules -> Sexp.t diff --git a/serlib_8_19/ser_pretype_errors.ml b/serlib_8_19/ser_pretype_errors.ml deleted file mode 100644 index 1f2dfbc3..00000000 --- a/serlib_8_19/ser_pretype_errors.ml +++ /dev/null @@ -1,75 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* - NotClean (e, ee, c) - | ConversionFailed (_, c1, c2) -> - ConversionFailed (ee, c1, c2) - | IncompatibleInstances (_, e, c1, c2) -> - IncompatibleInstances (ee, e, c1, c2) - | InstanceNotSameType (e, _, t1, t2) -> - InstanceNotSameType (e, ee, t1, t2) - | CannotSolveConstraint (e, ue) -> - CannotSolveConstraint (e, (filter_ue ue)) - | ue -> ue - -let sexp_of_unification_error ue = - filter_ue ue |> sexp_of_unification_error - -type position = - [%import: Pretype_errors.position] - [@@deriving sexp] - -type position_reporting = - [%import: Pretype_errors.position_reporting] - [@@deriving sexp] - -type subterm_unification_error = - [%import: Pretype_errors.subterm_unification_error] - [@@deriving sexp] - -type type_error = - [%import: Pretype_errors.type_error] - [@@deriving sexp] - -type pretype_error = - [%import: Pretype_errors.pretype_error] - [@@deriving sexp] diff --git a/serlib_8_19/ser_pretype_errors.mli b/serlib_8_19/ser_pretype_errors.mli deleted file mode 100644 index fb783695..00000000 --- a/serlib_8_19/ser_pretype_errors.mli +++ /dev/null @@ -1,39 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* unification_error -val sexp_of_unification_error : unification_error -> Sexp.t - -type position = Pretype_errors.position -val position_of_sexp : Sexp.t -> position -val sexp_of_position : position -> Sexp.t - -type position_reporting = Pretype_errors.position_reporting -val position_reporting_of_sexp : Sexp.t -> position_reporting -val sexp_of_position_reporting : position_reporting -> Sexp.t - -type subterm_unification_error = Pretype_errors.subterm_unification_error -val subterm_unification_error_of_sexp : Sexp.t -> subterm_unification_error -val sexp_of_subterm_unification_error : subterm_unification_error -> Sexp.t - -type pretype_error = Pretype_errors.pretype_error -val pretype_error_of_sexp : Sexp.t -> pretype_error -val sexp_of_pretype_error : pretype_error -> Sexp.t diff --git a/serlib_8_19/ser_printer.ml b/serlib_8_19/ser_printer.ml deleted file mode 100644 index c8164b50..00000000 --- a/serlib_8_19/ser_printer.ml +++ /dev/null @@ -1,22 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* 'b) (x : 'a SList.t) : 'b SList.t = Obj.magic (_map f (Obj.magic x)) diff --git a/serlib_8_19/ser_safe_typing.ml b/serlib_8_19/ser_safe_typing.ml deleted file mode 100644 index 275a5b39..00000000 --- a/serlib_8_19/ser_safe_typing.ml +++ /dev/null @@ -1,83 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* 'a) (x : Sexp.t) : 'a effect_entry = - let open Sexp in - match x with - | Atom "PureEntry" -> - Obj__magic PureEntry - | Atom "EffectEntry" -> - Obj__magic EffectEntry - | _ -> - Sexplib.Conv_error.no_variant_match () -*) - -type global_declaration = - [%import: Safe_typing.global_declaration] - [@@deriving sexp] diff --git a/serlib_8_19/ser_safe_typing.mli b/serlib_8_19/ser_safe_typing.mli deleted file mode 100644 index 1613aad1..00000000 --- a/serlib_8_19/ser_safe_typing.mli +++ /dev/null @@ -1,26 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* global_declaration -val sexp_of_global_declaration : global_declaration -> Sexp.t diff --git a/serlib_8_19/ser_sorts.ml b/serlib_8_19/ser_sorts.ml deleted file mode 100644 index a40d6e30..00000000 --- a/serlib_8_19/ser_sorts.ml +++ /dev/null @@ -1,78 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* t -val sexp_of_t : t -> Sexp.t - -type 'c p = 'c Tok.p -val p_of_sexp : (Sexp.t -> 'c) -> Sexp.t -> 'c p -val sexp_of_p : ('c -> Sexp.t) -> 'c p -> Sexp.t diff --git a/serlib_8_19/ser_type_errors.ml b/serlib_8_19/ser_type_errors.ml deleted file mode 100644 index 82180116..00000000 --- a/serlib_8_19/ser_type_errors.ml +++ /dev/null @@ -1,59 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* guard_error -val sexp_of_guard_error : guard_error -> Sexp.t - -type ('c,'t) pcant_apply_bad_type = ('c, 't) Type_errors.pcant_apply_bad_type - -val pcant_apply_bad_type_of_sexp : - (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> - Sexp.t -> ('constr, 'types) pcant_apply_bad_type - -val sexp_of_pcant_apply_bad_type : - ('constr -> Sexp.t) -> - ('types -> Sexp.t) -> - ('constr, 'types) pcant_apply_bad_type -> Sexp.t - -type ('c, 't) ptype_error = ('c, 't) Type_errors.ptype_error -val ptype_error_of_sexp : - (Sexp.t -> 'constr) -> (Sexp.t -> 'types) -> - Sexp.t -> ('constr, 'types) ptype_error - -val sexp_of_ptype_error : - ('constr -> Sexp.t) -> - ('types -> Sexp.t) -> - ('constr, 'types) ptype_error -> Sexp.t - -type type_error = Type_errors.type_error -val type_error_of_sexp : Sexp.t -> type_error -val sexp_of_type_error : type_error -> Sexp.t - diff --git a/serlib_8_19/ser_typeclasses.ml b/serlib_8_19/ser_typeclasses.ml deleted file mode 100644 index c22cf055..00000000 --- a/serlib_8_19/ser_typeclasses.ml +++ /dev/null @@ -1,25 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* |= _t_get) -let to_yojson level = _t_to_yojson (_t_put level) - -let hash_fold_t st i = - Ppx_hash_lib.Std.Hash.Builtin.hash_fold_int64 st (Uint63.to_int64 i) - -let compare i1 i2 = - Ppx_compare_lib.Builtin.compare_int64 (Uint63.to_int64 i1) (Uint63.to_int64 i2) diff --git a/serlib_8_19/ser_univ.ml b/serlib_8_19/ser_univ.ml deleted file mode 100644 index 160f470d..00000000 --- a/serlib_8_19/ser_univ.ml +++ /dev/null @@ -1,102 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* univ_constraint -val sexp_of_univ_constraint : univ_constraint -> Sexp.t - -module Constraints : SerType.SJHC with type t = Univ.Constraints.t - -module ContextSet : SerType.SJHC with type t = Univ.ContextSet.t - -type 'a in_universe_context_set = 'a Univ.in_universe_context_set -val in_universe_context_set_of_sexp : (Sexp.t -> 'a) -> Sexp.t -> 'a in_universe_context_set -val sexp_of_in_universe_context_set : ('a -> Sexp.t) -> 'a in_universe_context_set -> Sexp.t diff --git a/serlib_8_19/ser_univNames.ml b/serlib_8_19/ser_univNames.ml deleted file mode 100644 index 21b0683f..00000000 --- a/serlib_8_19/ser_univNames.ml +++ /dev/null @@ -1,31 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* |= _instance_get) -let to_yojson level = _t_to_yojson (_instance_put level) - -let hash i = hash__t (Instance (UVars.Instance.to_array i)) -let hash_fold_t st i = hash_fold__t st (Instance (UVars.Instance.to_array i)) -let compare i1 i2 = compare__t (Instance (UVars.Instance.to_array i1)) (Instance (UVars.Instance.to_array i2)) - -end - -module UContext = struct - - module I = struct - type t = UVars.UContext.t - type _t = (Names.Name.t array * Names.Name.t array) * (Instance.t * Constraints.t) - [@@deriving sexp,yojson,hash,compare] - - let to_t (un, cs) = UVars.UContext.make un cs - let of_t uc = UVars.UContext.(names uc, (instance uc, constraints uc)) - end - - include SerType.Biject(I) - -end - -module AbstractContext = struct - - let hash_fold_array = hash_fold_array_frozen - module ACPierceDef = struct - - type t = UVars.AbstractContext.t - type _t = (Names.Name.t array * Names.Name.t array) * Constraints.t - [@@deriving sexp,yojson,hash,compare] - end - - include SerType.Pierce(ACPierceDef) - -end - -type 'a in_universe_context = - [%import: 'a UVars.in_universe_context] - [@@deriving sexp] - -type 'a puniverses = - [%import: 'a UVars.puniverses] - [@@deriving sexp, yojson, hash, compare] diff --git a/serlib_8_19/ser_uvars.mli b/serlib_8_19/ser_uvars.mli deleted file mode 100644 index c17f2fbb..00000000 --- a/serlib_8_19/ser_uvars.mli +++ /dev/null @@ -1,35 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t -> 'a in_universe_context -val sexp_of_in_universe_context : ('a -> Sexp.t) -> 'a in_universe_context -> Sexp.t - -type 'a puniverses = 'a * Instance.t - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_vernacexpr.ml b/serlib_8_19/ser_vernacexpr.ml deleted file mode 100644 index fe0a76e9..00000000 --- a/serlib_8_19/ser_vernacexpr.ml +++ /dev/null @@ -1,353 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t - * val to_patch_substituted_of_sexp : Sexp.t -> to_patch_substituted *) diff --git a/serlib_8_19/ser_vmvalues.ml b/serlib_8_19/ser_vmvalues.ml deleted file mode 100644 index 130d5549..00000000 --- a/serlib_8_19/ser_vmvalues.ml +++ /dev/null @@ -1,63 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* tag -val sexp_of_tag : tag -> Sexp.t - -type structured_constant = Vmvalues.structured_constant - [@@deriving sexp,yojson,hash,compare] - -type reloc_table = Vmvalues.reloc_table - [@@deriving sexp,yojson,hash,compare] - -type annot_switch = Vmvalues.annot_switch - [@@deriving sexp,yojson,hash,compare] diff --git a/serlib_8_19/ser_xml_datatype.ml b/serlib_8_19/ser_xml_datatype.ml deleted file mode 100644 index 7edc7f44..00000000 --- a/serlib_8_19/ser_xml_datatype.ml +++ /dev/null @@ -1,28 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* Sexp.t -> 'a gxml -val sexp_of_gxml : ('a -> Sexp.t) -> 'a gxml -> Sexp.t -val gxml_of_yojson : (Yojson.Safe.t -> ('a, string) Result.result) -> Yojson.Safe.t -> ('a gxml, string) Result.result -val gxml_to_yojson : ('a -> Yojson.Safe.t) -> 'a gxml -> Yojson.Safe.t - -type xml = Xml_datatype.xml - -val xml_of_sexp : Sexp.t -> xml -val sexp_of_xml : xml -> Sexp.t -val xml_of_yojson : Yojson.Safe.t -> (xml, string) Result.result -val xml_to_yojson : xml -> Yojson.Safe.t diff --git a/serlib_8_19/serlib_base.ml b/serlib_8_19/serlib_base.ml deleted file mode 100644 index df11d059..00000000 --- a/serlib_8_19/serlib_base.ml +++ /dev/null @@ -1,52 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* - Some Pp.(seq [str "Serlib Error: "; str msg]) - | _ -> - None) - -let opaque_of_sexp ~typ _obj = - raise (Ser_error ("["^typ^": ABSTRACT / cannot deserialize]")) - -let exn_on_opaque = ref true - -let sexp_of_opaque ~typ _exp = - let msg = "["^typ^": ABSTRACT]" in - if !exn_on_opaque then - raise (Ser_error msg) - else - Sexplib.Sexp.Atom ("["^typ^": ABSTRACT]") - -let opaque_of_yojson ~typ _obj = - raise (Ser_error ("["^typ^": ABSTRACT / cannot deserialize]")) - -let opaque_to_yojson ~typ _obj = - let msg = "["^typ^": ABSTRACT]" in - if !exn_on_opaque then - raise (Ser_error msg) - else - `String ("["^typ^": ABSTRACT]") - -let hash_opaque ~typ:_ x = Hashtbl.hash x -let hash_fold_opaque ~typ st x = Ppx_hash_lib.Std.Hash.Builtin.hash_fold_int st (hash_opaque ~typ x) -let compare_opaque ~typ:_ x y = Stdlib.compare x y - diff --git a/serlib_8_19/serlib_base.mli b/serlib_8_19/serlib_base.mli deleted file mode 100644 index 66f728da..00000000 --- a/serlib_8_19/serlib_base.mli +++ /dev/null @@ -1,34 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* 'a -> Sexp.t -val opaque_of_sexp : typ:string -> Sexp.t -> 'a - -val opaque_of_yojson : typ:string -> Yojson.Safe.t -> ('a, string) Result.t -val opaque_to_yojson : typ:string -> 'a -> Yojson.Safe.t - -val hash_opaque : typ:string -> 'a -> Ppx_hash_lib.Std.Hash.hash_value -val hash_fold_opaque : typ:string -> Ppx_hash_lib.Std.Hash.state -> 'a -> Ppx_hash_lib.Std.Hash.state - -val compare_opaque : typ:string -> 'a -> 'a -> int diff --git a/serlib_8_19/serlib_init.ml b/serlib_8_19/serlib_init.ml deleted file mode 100644 index d80ff40a..00000000 --- a/serlib_8_19/serlib_init.ml +++ /dev/null @@ -1,31 +0,0 @@ -(************************************************************************) -(* * The Coq Proof Assistant / The Coq Development Team *) -(* v * Copyright INRIA, CNRS and contributors *) -(* unit - From fab5732cd0b7a9ff2931dfb5f4f7cc82d40ee77d Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Thu, 29 Aug 2024 16:17:01 +0200 Subject: [PATCH 03/38] [build] Fixup for result in serlib --- serlib_8_18/serlib/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/serlib_8_18/serlib/dune b/serlib_8_18/serlib/dune index d95c6778..70b49ecd 100644 --- a/serlib_8_18/serlib/dune +++ b/serlib_8_18/serlib/dune @@ -3,5 +3,5 @@ (public_name coq-lsp.serlib) (synopsis "Serialization Library for Coq") (preprocess (staged_pps ppx_import ppx_sexp_conv ppx_hash ppx_compare ppx_deriving_yojson)) - (libraries coq-core.stm sexplib)) + (libraries result coq-core.stm sexplib)) From d3b77acb7ce752b893639cb94698f7d89e25d130 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Fri, 30 Aug 2024 17:15:34 +0200 Subject: [PATCH 04/38] [petanque] Update README --- petanque/README.md | 1 + 1 file changed, 1 insertion(+) diff --git a/petanque/README.md b/petanque/README.md index cdb47056..e3f40fd0 100644 --- a/petanque/README.md +++ b/petanque/README.md @@ -14,6 +14,7 @@ an OCaml API (`agent.mli`) which is then exposed via some form of RPC. - Guilaume Baudart (Inria) - Emilio J. Gallego Arias (Inria) +- Marc Lelarge (Inria) - Laetitia Teodorescu (Inria) ## Acknowledgments From c1236756609f30c9f8b83b0cc10da65eab7f53ec Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Fri, 30 Aug 2024 21:23:20 +0200 Subject: [PATCH 05/38] [nix] [build] Update flake to more modern ppx packages. --- .github/workflows/build.yml | 4 ++-- flake.lock | 48 ++++++++++++++++--------------------- flake.nix | 5 ++-- 3 files changed, 25 insertions(+), 32 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 7faca7df..e45be040 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -133,10 +133,10 @@ jobs: submodules: recursive - name: ❄️ Setup Nix - uses: cachix/install-nix-action@v22 + uses: cachix/install-nix-action@v27 - name: 🧱 Build coq-lsp - run: nix build .?submodules=1 + run: nix build '.?submodules=1#' client-compile: runs-on: ubuntu-latest diff --git a/flake.lock b/flake.lock index 4d6681c3..54efa01d 100644 --- a/flake.lock +++ b/flake.lock @@ -21,11 +21,11 @@ "nixpkgs-lib": "nixpkgs-lib" }, "locked": { - "lastModified": 1712014858, - "narHash": "sha256-sB4SWl2lX95bExY2gMFG5HIzvva5AVMJd4Igm+GpZNw=", + "lastModified": 1725024810, + "narHash": "sha256-ODYRm8zHfLTH3soTFWE452ydPYz2iTvr9T8ftDMUQ3E=", "owner": "hercules-ci", "repo": "flake-parts", - "rev": "9126214d0a59633752a136528f5f3b9aa8565b7d", + "rev": "af510d4a62d071ea13925ce41c95e3dec816c01d", "type": "github" }, "original": { @@ -57,11 +57,11 @@ "nixpkgs": "nixpkgs" }, "locked": { - "lastModified": 1703102458, - "narHash": "sha256-3pOV731qi34Q2G8e2SqjUXqnftuFrbcq+NdagEZXISo=", + "lastModified": 1717929455, + "narHash": "sha256-BiI5xWygriOJuNISnGAeL0KYxrEMnjgpg+7wDskVBhI=", "owner": "nix-community", "repo": "napalm", - "rev": "edcb26c266ca37c9521f6a97f33234633cbec186", + "rev": "e1babff744cd278b56abe8478008b4a9e23036cf", "type": "github" }, "original": { @@ -88,29 +88,23 @@ }, "nixpkgs-lib": { "locked": { - "dir": "lib", - "lastModified": 1711703276, - "narHash": "sha256-iMUFArF0WCatKK6RzfUJknjem0H9m4KgorO/p3Dopkk=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "d8fe5e6c92d0d190646fb9f1056741a229980089", - "type": "github" + "lastModified": 1722555339, + "narHash": "sha256-uFf2QeW7eAHlYXuDktm9c25OxOyCoUOQmh5SZ9amE5Q=", + "type": "tarball", + "url": "https://github.com/NixOS/nixpkgs/archive/a5d394176e64ab29c852d03346c1fc9b0b7d33eb.tar.gz" }, "original": { - "dir": "lib", - "owner": "NixOS", - "ref": "nixos-unstable", - "repo": "nixpkgs", - "type": "github" + "type": "tarball", + "url": "https://github.com/NixOS/nixpkgs/archive/a5d394176e64ab29c852d03346c1fc9b0b7d33eb.tar.gz" } }, "nixpkgs_2": { "locked": { - "lastModified": 1714058985, - "narHash": "sha256-gD/Ya/oXic+vbQGvmqxm8qaWmOx3HnrKHQtSL6oRW0E=", + "lastModified": 1724999960, + "narHash": "sha256-LB3jqSGW5u1ZcUcX6vO/qBOq5oXHlmOCxsTXGMEitp4=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "bf182c39d9439811484aad0d241ea89619b44bc7", + "rev": "b96f849e725333eb2b1c7f1cb84ff102062468ba", "type": "github" }, "original": { @@ -122,11 +116,11 @@ }, "nixpkgs_3": { "locked": { - "lastModified": 1708475490, - "narHash": "sha256-g1v0TsWBQPX97ziznfJdWhgMyMGtoBFs102xSYO4syU=", + "lastModified": 1723637854, + "narHash": "sha256-med8+5DSWa2UnOqtdICndjDAEjxr5D7zaIiK4pn0Q7c=", "owner": "nixos", "repo": "nixpkgs", - "rev": "0e74ca98a74bc7270d28838369593635a5db3260", + "rev": "c3aa7b8938b17aebd2deecf7be0636000d62a2b9", "type": "github" }, "original": { @@ -165,11 +159,11 @@ "nixpkgs": "nixpkgs_3" }, "locked": { - "lastModified": 1714058656, - "narHash": "sha256-Qv4RBm4LKuO4fNOfx9wl40W2rBbv5u5m+whxRYUMiaA=", + "lastModified": 1724833132, + "narHash": "sha256-F4djBvyNRAXGusJiNYInqR6zIMI3rvlp6WiKwsRISos=", "owner": "numtide", "repo": "treefmt-nix", - "rev": "c6aaf729f34a36c445618580a9f95a48f5e4e03f", + "rev": "3ffd842a5f50f435d3e603312eefa4790db46af5", "type": "github" }, "original": { diff --git a/flake.nix b/flake.nix index 6783a2d6..0b4f98d6 100644 --- a/flake.nix +++ b/flake.nix @@ -30,18 +30,17 @@ ... }: let l = lib // builtins; - coqpkg = pkgs.coqPackages_8_18; + coqpkg = pkgs.coqPackages_8_20; coqPackages = coqpkg.coqPackages; ocamlPackages = coqpkg.coq.ocamlPackages; in { packages.default = config.packages.coq-lsp; - # NOTE(2023-06-02): Nix does not support top-level self submodules (yet) packages.coq-lsp = ocamlPackages.buildDunePackage { duneVersion = "3"; pname = "coq-lsp"; - version = "${self.lastModifiedDate}+8.18-rc1"; + version = "${self.lastModifiedDate}+8.20-rc1"; src = self.outPath; From 6219d342d5026634f101f2339ee254d08f295181 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Thu, 29 Aug 2024 18:17:11 +0200 Subject: [PATCH 06/38] [build] [deps] Bump ppxlib toolchain to 0.26.0. It is time to clean up this old compat setup once that #698 has been completed; old `ppx_import` is giving us too much trouble with `petanque`. --- CHANGES.md | 8 ++++ coq-lsp.opam | 20 ++++----- lsp/jLang.ml | 23 ++++++++++ lsp/jLang.mli | 6 +++ lsp/jStdlib.ml | 5 +++ petanque/json/jAgent.ml | 63 +++------------------------ petanque/json_shell/protocol_shell.ml | 4 +- 7 files changed, 61 insertions(+), 68 deletions(-) create mode 100644 lsp/jStdlib.ml diff --git a/CHANGES.md b/CHANGES.md index bcc7ad96..dacded90 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -1,3 +1,11 @@ +# unreleased +------------ + + - [deps] Bump toolchain so minimal `ppxlib` is 0.26, in order to fix + some `ppx_import` oddities. This means our lower bound for the Jane + Street packages is now `v0.15`, which should be fine for the + foreseeable future (@ejgallego, #813) + # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/coq-lsp.opam b/coq-lsp.opam index cf4ddd26..950f6166 100644 --- a/coq-lsp.opam +++ b/coq-lsp.opam @@ -34,23 +34,23 @@ depends: [ "menhir" { >= "20220210" } # unit testing - "ppx_inline_test" { >= "0.14.1" } + "ppx_inline_test" { >= "v0.15.0" } # Uncomment this for releases # "coq" { >= "8.17" < "8.18" } # coq deps: remove this for releases - "ocamlfind" {>= "1.8.1"} - "zarith" {>= "1.11"} + "ocamlfind" {>= "1.9.1"} + "zarith" {>= "1.13"} # serlib deps: see what we need to keep for release - "ppx_deriving" { >= "4.2.1" } - "ppx_deriving_yojson" { >= "3.4" } - "ppx_import" { >= "1.5-3" } - "sexplib" { >= "v0.13.0" & < "v0.18" } - "ppx_sexp_conv" { >= "v0.13.0" & < "v0.18" } - "ppx_compare" { >= "v0.13.0" & < "v0.18" } - "ppx_hash" { >= "v0.13.0" & < "v0.18" } + "ppx_deriving" { >= "5.2" } + "ppx_deriving_yojson" { >= "3.7.0" } + "ppx_import" { >= "1.11.0" } + "sexplib" { >= "v0.15.0" & < "v0.18" } + "ppx_sexp_conv" { >= "v0.15.0" & < "v0.18" } + "ppx_compare" { >= "v0.15.0" & < "v0.18" } + "ppx_hash" { >= "v0.15.0" & < "v0.18" } ] depopts: ["lwt" "logs"] diff --git a/lsp/jLang.ml b/lsp/jLang.ml index 7df98eb9..e5490703 100644 --- a/lsp/jLang.ml +++ b/lsp/jLang.ml @@ -88,3 +88,26 @@ module Diagnostic = struct let message = Pp.to_string message in _t_to_yojson { range; severity; message; data } end + +module Stdlib = JStdlib + +module With_range = struct + type 'a t = [%import: ('a Lang.With_range.t[@with Lang.Range.t := Range.t])] + [@@deriving yojson] +end + +module Ast = struct + module Name = struct + type t = [%import: Lang.Ast.Name.t] [@@deriving yojson] + end + + module Info = struct + type t = + [%import: + (Lang.Ast.Info.t + [@with + Lang.Range.t := Range.t; + Lang.With_range.t := With_range.t])] + [@@deriving yojson] + end +end diff --git a/lsp/jLang.mli b/lsp/jLang.mli index 3aba7f17..2b59f7b8 100644 --- a/lsp/jLang.mli +++ b/lsp/jLang.mli @@ -38,3 +38,9 @@ module Diagnostic : sig [@@deriving yojson] end end + +module Ast : sig + module Info : sig + type t = Lang.Ast.Info.t [@@deriving yojson] + end +end diff --git a/lsp/jStdlib.ml b/lsp/jStdlib.ml new file mode 100644 index 00000000..5995cbaf --- /dev/null +++ b/lsp/jStdlib.ml @@ -0,0 +1,5 @@ +module Result = struct + include Stdlib.Result + + type ('a, 'e) t = [%import: ('a, 'e) Stdlib.Result.t] [@@deriving yojson] +end diff --git a/petanque/json/jAgent.ml b/petanque/json/jAgent.ml index dac37aa8..58c39789 100644 --- a/petanque/json/jAgent.ml +++ b/petanque/json/jAgent.ml @@ -8,22 +8,6 @@ module Inspect = struct end (* The typical protocol dance *) - -(* What a mess result stuff is, we need this in case result is installed, as - then the types below will be referenced as plain result ... *) -module Stdlib = struct - module Result = struct - include Stdlib.Result - - type ('a, 'e) t = [%import: ('a, 'e) Stdlib.Result.t] [@@deriving yojson] - end -end - -module Result = Stdlib.Result - -(* ppx_import < 1.10 hack, for some reason it gets confused with the aliases. *) -module Result_ = Stdlib.Result - module Error = struct type t = [%import: Petanque.Agent.Error.t] [@@deriving yojson] end @@ -36,57 +20,24 @@ module Run_result = struct type 'a t = [%import: 'a Petanque.Agent.Run_result.t] [@@deriving yojson] end +(* Both are needed as of today *) +module Stdlib = Lsp.JStdlib +module Result = Stdlib.Result + module R = struct - type 'a t = - [%import: - ('a Petanque.Agent.R.t - [@with - Stdlib.Result.t := Result_.t; - Result.t := Result_.t])] - [@@deriving yojson] + type 'a t = [%import: 'a Petanque.Agent.R.t] [@@deriving yojson] end module Goals = struct type t = string Lsp.JCoq.Goals.reified_pp option [@@deriving yojson] end -module Lang = struct - module Range = struct - type t = Lsp.JLang.Range.t [@@deriving yojson] - end - - module With_range = struct - type 'a t = [%import: ('a Lang.With_range.t[@with Lang.Range.t := Range.t])] - [@@deriving yojson] - end - - module Ast = struct - module Name = struct - type t = [%import: Lang.Ast.Name.t] [@@deriving yojson] - end - - module Info = struct - type t = - [%import: - (Lang.Ast.Info.t - [@with - Lang.Range.t := Range.t; - Lang.With_range.t := With_range.t])] - [@@deriving yojson] - end - end -end +module Lang = Lsp.JLang module Premise = struct module Info = struct type t = [%import: Petanque.Agent.Premise.Info.t] [@@deriving yojson] end - type t = - [%import: - (Petanque.Agent.Premise.t - [@with - Stdlib.Result.t := Result_.t; - Result.t := Result_.t])] - [@@deriving yojson] + type t = [%import: Petanque.Agent.Premise.t] [@@deriving yojson] end diff --git a/petanque/json_shell/protocol_shell.ml b/petanque/json_shell/protocol_shell.ml index 4f4bb4d7..12acda71 100644 --- a/petanque/json_shell/protocol_shell.ml +++ b/petanque/json_shell/protocol_shell.ml @@ -6,7 +6,6 @@ (************************************************************************) open Petanque_json -open JAgent (** [set_workspace { debug; root }] sets the current workspace to the directory specified in [root] *) @@ -47,7 +46,8 @@ module TableOfContents = struct end module Response = struct - type t = (string * Lang.Ast.Info.t list option) list [@@deriving yojson] + type t = (string * Lsp.JLang.Ast.Info.t list option) list + [@@deriving yojson] end module Handler = struct From 2180402e4af0096b1a3419f1d7783bea7ec9d43f Mon Sep 17 00:00:00 2001 From: Pierre Roux Date: Fri, 19 Jul 2024 09:59:27 +0200 Subject: [PATCH 07/38] [coq] Adapt to https://github.com/coq/coq/pull/19310 --- coq/workspace.ml | 2 +- test/CoqProject/_CoqProject | 2 +- test/compiler/basic/run.t | 26 +++++++++++++------------- test/compiler/exit_code/run.t | 2 +- test/compiler/long_file/run.t | 2 +- test/serlib/genarg/extraction.v | 2 +- test/serlib/genarg/libTactics.v | 14 +++++++------- vendor/coq | 2 +- 8 files changed, 26 insertions(+), 26 deletions(-) diff --git a/coq/workspace.ml b/coq/workspace.ml index 175550e4..585f577a 100644 --- a/coq/workspace.ml +++ b/coq/workspace.ml @@ -156,7 +156,7 @@ let make ~cmdline ~implicit ~kind ~debug = in let require_libs = let rq_list = - if init then ((None, "Coq.Init.Prelude") :: require_libraries) @ libs + if init then ((None, "Stdlib.Init.Prelude") :: require_libraries) @ libs else require_libraries @ libs in List.map mk_require_from rq_list diff --git a/test/CoqProject/_CoqProject b/test/CoqProject/_CoqProject index 3bf09db5..73b8c6f8 100644 --- a/test/CoqProject/_CoqProject +++ b/test/CoqProject/_CoqProject @@ -3,6 +3,6 @@ -arg -w -arg -local-declaration -arg -w -arg +non-primitive-record --arg -rifrom -arg Coq.Lists -arg List +-arg -rifrom -arg Stdlib.Lists -arg List test.v diff --git a/test/compiler/basic/run.t b/test/compiler/basic/run.t index 92387815..7f39aa5c 100644 --- a/test/compiler/basic/run.t +++ b/test/compiler/basic/run.t @@ -6,7 +6,7 @@ Describe the project [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -17,7 +17,7 @@ Compile a single file, don't generate a `.vo` file: [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -33,7 +33,7 @@ Compile a single file, generate a .vo file [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -53,7 +53,7 @@ Compile a dependent file [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -73,7 +73,7 @@ Compile both files [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -94,7 +94,7 @@ Compile a dependent file without the dep being built [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -131,7 +131,7 @@ Compile a file with all messages: [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -142,7 +142,7 @@ Compile a file with all messages: [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -172,7 +172,7 @@ Use two workspaces [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -180,7 +180,7 @@ Use two workspaces [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -197,7 +197,7 @@ Load the example plugin [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -210,7 +210,7 @@ Load the astdump plugin [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] @@ -235,7 +235,7 @@ We do the same for the goaldump plugin: [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] diff --git a/test/compiler/exit_code/run.t b/test/compiler/exit_code/run.t index c7127987..d27c7722 100644 --- a/test/compiler/exit_code/run.t +++ b/test/compiler/exit_code/run.t @@ -7,7 +7,7 @@ Describe the environment: [message] Configuration loaded from ./_CoqProject - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 3 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] diff --git a/test/compiler/long_file/run.t b/test/compiler/long_file/run.t index f94b793b..83302ca7 100644 --- a/test/compiler/long_file/run.t +++ b/test/compiler/long_file/run.t @@ -10,7 +10,7 @@ We now compile the challenging file: [message] Configuration loaded from Command-line arguments - coqlib is at: [TEST_PATH] + coqcorelib is at: [TEST_PATH] - - Modules [Coq.Init.Prelude] will be loaded by default + - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - ocamlpath wasn't overriden + findlib config: [TEST_PATH] diff --git a/test/serlib/genarg/extraction.v b/test/serlib/genarg/extraction.v index ec92c845..a771e714 100644 --- a/test/serlib/genarg/extraction.v +++ b/test/serlib/genarg/extraction.v @@ -1,4 +1,4 @@ -Require Coq.extraction.Extraction. +Require Stdlib.extraction.Extraction. Extraction Language Haskell. diff --git a/test/serlib/genarg/libTactics.v b/test/serlib/genarg/libTactics.v index 451a77ad..5f895f69 100644 --- a/test/serlib/genarg/libTactics.v +++ b/test/serlib/genarg/libTactics.v @@ -44,7 +44,7 @@ Set Implicit Arguments. -Require Import Coq.Lists.List. +Require Import Stdlib.Lists.List. (* ********************************************************************** *) @@ -370,7 +370,7 @@ Ltac fast_rm_inside E := Note: the tactic [number_to_nat] is extended in [LibInt] to take into account the [int] type, alias for [Z]. *) -Require Coq.Numbers.BinNums Coq.ZArith.BinInt. +Require Stdlib.Numbers.BinNums Stdlib.ZArith.BinInt. Definition ltac_int_to_nat (x:BinInt.Z) : nat := match x with @@ -2519,7 +2519,7 @@ Tactic Notation "subst_eq" constr(E) := (* ---------------------------------------------------------------------- *) (** ** Tactics to work with proof irrelevance *) -Require Import Coq.Logic.ProofIrrelevance. +Require Import Stdlib.Logic.ProofIrrelevance. (** [pi_rewrite E] replaces [E] of type [Prop] with a fresh unification variable, and is thus a practical way to @@ -3098,7 +3098,7 @@ Tactic Notation "cases_if'" := [inductions E gen X1 .. XN] is a shorthand for [dependent induction E generalizing X1 .. XN]. *) -Require Import Coq.Program.Equality. +Require Import Stdlib.Program.Equality. Ltac inductions_post := unfold eq' in *. @@ -3189,7 +3189,7 @@ Tactic Notation "induction_wf" ":" constr(E) ident(X) := judgment that includes a counter for the maximal height (see LibTacticsDemos for an example) *) -Require Import Coq.Arith.Compare_dec. +Require Import Stdlib.Arith.Compare_dec. Require Import Lia. Lemma induct_height_max2 : forall n1 n2 : nat, @@ -4166,7 +4166,7 @@ Tactic Notation "exists" "~" constr(T1) "," constr(T2) "," constr(T3) "," same as for light automation. Exception: use [subs*] instead of [subst*] if you - import the library [Coq.Classes.Equivalence]. *) + import the library [Stdlib.Classes.Equivalence]. *) Tactic Notation "equates" "*" constr(E) := equates E; auto_star. @@ -5007,7 +5007,7 @@ Open Scope nat_scope. (** [exists T1 ... TN, P] is a shorthand for [exists T1, ..., exists TN, P]. Note that - [Coq.Program.Syntax] already defines exists + [Stdlib.Program.Syntax] already defines exists for arity up to 4. *) Notation "'exists' x1 ',' P" := diff --git a/vendor/coq b/vendor/coq index 6a2431e6..7fec4bd9 160000 --- a/vendor/coq +++ b/vendor/coq @@ -1 +1 @@ -Subproject commit 6a2431e6fa1f4a0bbee6d98c3b709aca781061d5 +Subproject commit 7fec4bd91f2873f98541b5ecf640e83369768c99 From 22935b62e13bde0c4cb0fb271ce9021f3cce3ddb Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sat, 14 Sep 2024 15:27:44 +0200 Subject: [PATCH 08/38] [workspace] [coq] Support _CoqProject arguments `-type-in-type` and `-allow-rewrite-rules` (for 8.20) --- CHANGES.md | 2 ++ coq/workspace.ml | 27 ++++++++++++++++++++------- coq/workspace.mli | 6 ++++-- 3 files changed, 26 insertions(+), 9 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index dacded90..5450502d 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -5,6 +5,8 @@ some `ppx_import` oddities. This means our lower bound for the Jane Street packages is now `v0.15`, which should be fine for the foreseeable future (@ejgallego, #813) + - [workspace] [coq] Support _CoqProject arguments `-type-in-type` and + `-allow-rewrite-rules` (for 8.20) (@ejgallego, #) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/coq/workspace.ml b/coq/workspace.ml index 585f577a..3aa2b62a 100644 --- a/coq/workspace.ml +++ b/coq/workspace.ml @@ -19,15 +19,24 @@ module Flags_ = Flags module Flags = struct type t = - { indices_matter : bool - ; impredicative_set : bool + { impredicative_set : bool + ; indices_matter : bool + ; type_in_type : bool + ; rewrite_rules : bool } - let default = { indices_matter = false; impredicative_set = false } + let default = + { impredicative_set = false + ; indices_matter = false + ; type_in_type = false + ; rewrite_rules = false + } - let apply { indices_matter; impredicative_set } = + let apply { impredicative_set; indices_matter; type_in_type; rewrite_rules } = + Global.set_impredicative_set impredicative_set; Global.set_indices_matter indices_matter; - Global.set_impredicative_set impredicative_set + Global.set_check_universes (not type_in_type); + Global.set_rewrite_rules_allowed rewrite_rules end module Warning : sig @@ -95,10 +104,14 @@ let rec parse_args args init boot libs f w = | [] -> (init, boot, List.rev libs, f, List.rev w) | "-rifrom" :: from :: lib :: rest -> parse_args rest init boot ((Some from, lib) :: libs) f w - | "-indices-matter" :: rest -> - parse_args rest init boot libs { f with Flags.indices_matter = true } w | "-impredicative-set" :: rest -> parse_args rest init boot libs { f with Flags.impredicative_set = true } w + | "-indices-matter" :: rest -> + parse_args rest init boot libs { f with Flags.indices_matter = true } w + | "-type-in-type" :: rest -> + parse_args rest init boot libs { f with Flags.type_in_type = true } w + | "-allow-rewrite-rules" :: rest -> + parse_args rest init boot libs { f with Flags.rewrite_rules = true } w | "-noinit" :: rest -> parse_args rest false boot libs f w | "-boot" :: rest -> parse_args rest init true libs f w | "-w" :: warn :: rest -> diff --git a/coq/workspace.mli b/coq/workspace.mli index fb5b461f..74670083 100644 --- a/coq/workspace.mli +++ b/coq/workspace.mli @@ -17,8 +17,10 @@ module Flags : sig type t = private - { indices_matter : bool - ; impredicative_set : bool + { impredicative_set : bool + ; indices_matter : bool + ; type_in_type : bool + ; rewrite_rules : bool } end From 1130aabeb326be81104dc5c3bb7587d44a32617a Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Mon, 16 Sep 2024 22:26:51 +0200 Subject: [PATCH 09/38] [serlib] Support for ltac2_ltac1 plugin --- CHANGES.md | 3 ++- coq/loader.ml | 1 + serlib/plugins/ltac2_ltac1/dune | 12 ++++++++++++ serlib/plugins/ltac2_ltac1/ser_tac2quote_ltac1.ml | 1 + 4 files changed, 16 insertions(+), 1 deletion(-) create mode 100644 serlib/plugins/ltac2_ltac1/dune create mode 100644 serlib/plugins/ltac2_ltac1/ser_tac2quote_ltac1.ml diff --git a/CHANGES.md b/CHANGES.md index 5450502d..9b7570bb 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -6,7 +6,8 @@ Street packages is now `v0.15`, which should be fine for the foreseeable future (@ejgallego, #813) - [workspace] [coq] Support _CoqProject arguments `-type-in-type` and - `-allow-rewrite-rules` (for 8.20) (@ejgallego, #) + `-allow-rewrite-rules` (for 8.20) (@ejgallego, #819) + - [serlib] Support for ltac2_ltac1 plugin (@ejgallego, #820) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/coq/loader.ml b/coq/loader.ml index 134c9fb8..6ac4ec19 100644 --- a/coq/loader.ml +++ b/coq/loader.ml @@ -48,6 +48,7 @@ let map_serlib fl_pkg = | "coq-core.plugins.funind" (* funind *) | "coq-core.plugins.ltac" (* ltac *) | "coq-core.plugins.ltac2" (* ltac2 *) + | "coq-core.plugins.ltac2_ltac1" (* ltac2_ltac1 *) | "coq-core.plugins.micromega" (* micromega *) | "coq-core.plugins.micromega_core" (* micromega_core *) | "coq-core.plugins.ring" (* ring *) diff --git a/serlib/plugins/ltac2_ltac1/dune b/serlib/plugins/ltac2_ltac1/dune new file mode 100644 index 00000000..151da43d --- /dev/null +++ b/serlib/plugins/ltac2_ltac1/dune @@ -0,0 +1,12 @@ +(library + (name serlib_btauto) + (public_name coq-lsp.serlib.ltac2_ltac1) + (synopsis "Serialization Library for Coq Ltac2_ltac1 Plugin") + (preprocess + (staged_pps + ppx_import + ppx_sexp_conv + ppx_deriving_yojson + ppx_hash + ppx_compare)) + (libraries coq-core.plugins.ltac2_ltac1 serlib sexplib)) diff --git a/serlib/plugins/ltac2_ltac1/ser_tac2quote_ltac1.ml b/serlib/plugins/ltac2_ltac1/ser_tac2quote_ltac1.ml new file mode 100644 index 00000000..d0eb012f --- /dev/null +++ b/serlib/plugins/ltac2_ltac1/ser_tac2quote_ltac1.ml @@ -0,0 +1 @@ +(* empty until we support Ltac2 genargs *) From a9e38e0a20ae210b07fafbd5edb2bc54d02a09c0 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Mon, 16 Sep 2024 22:30:50 +0200 Subject: [PATCH 10/38] [serlib] Fix wrong piercing of Ltac2 AST + test case Thanks to Jim Portegies for testing, report, and test case. --- CHANGES.md | 2 + examples/ItHolds.v | 233 +++++++++++++++++++++++++++ serlib/plugins/ltac2/ser_tac2expr.ml | 2 +- test/serlib/genarg/ItHolds.v | 233 +++++++++++++++++++++++++++ test/serlib/genarg/dune | 8 + 5 files changed, 477 insertions(+), 1 deletion(-) create mode 100644 examples/ItHolds.v create mode 100644 test/serlib/genarg/ItHolds.v diff --git a/CHANGES.md b/CHANGES.md index 9b7570bb..fe00cd85 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -8,6 +8,8 @@ - [workspace] [coq] Support _CoqProject arguments `-type-in-type` and `-allow-rewrite-rules` (for 8.20) (@ejgallego, #819) - [serlib] Support for ltac2_ltac1 plugin (@ejgallego, #820) + - [serlib] Fix Ltac2 AST piercing bug, add test case that should help + in the future (@ejgallego, jim-portegies, #821) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/examples/ItHolds.v b/examples/ItHolds.v new file mode 100644 index 00000000..e9c32a78 --- /dev/null +++ b/examples/ItHolds.v @@ -0,0 +1,233 @@ +(******************************************************************************) +(* This file is part of Waterproof-lib. *) +(* *) +(* Waterproof-lib is free software: you can redistribute it and/or modify *) +(* it under the terms of the GNU General Public License as published by *) +(* the Free Software Foundation, either version 3 of the License, or *) +(* (at your option) any later version. *) +(* *) +(* Waterproof-lib is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) +(* GNU General Public License for more details. *) +(* *) +(* You should have received a copy of the GNU General Public License *) +(* along with Waterproof-lib. If not, see . *) +(* *) +(******************************************************************************) + +Require Import Ltac2.Ltac2. +Require Import Ltac2.Message. +Local Ltac2 concat_list (ls : message list) : message := + List.fold_right concat ls (of_string ""). + +(** Tries to make the assertion [True] with label [label]. + Throws an error if this fails, i.e. if the label is already used + for another one of the hypotheses. + + This check was separated out from the 'assert'-tactics below because the + '[label] is already used error' would otherwise be caught in + the code meant to catch [AutomationFailure] errors. *) + +Local Ltac2 try_out_label (label : ident) := + match Control.case (fun () => + assert True as $label by exact I) + with + | Err exn => Control.zero exn + | Val _ => clear $label + end. + +(* For making tests independent of WaterProof *) +Ltac2 warn : message -> unit := fun _ => (). +Ltac2 throw : message -> unit := fun _ => (). +Ltac2 waterprove (_depth: int) (_shield: bool) (_db_type: 'a) := (). +Ltac2 rwaterprove (_depth: int) (_shield: bool) (_db_type: 'a) (_ : constr) := (). +Ltac2 suggest_how_to_use (_x : constr) (_label : ident option) := (). +Ltac2 Type exn ::= [ FailedToProve(constr) ]. +Ltac2 correct_type_by_wrapping (t: constr): constr := t. +Ltac2 wrapper_core_by_tactic (_by_tactic : constr -> unit) (_xtr_lemma : constr) := (). +Ltac2 panic_if_goal_wrapped () := (). +Ltac2 since_framework (_by_tactic : constr -> unit) (_claimed_cause : constr) := (). + +(** Attempts to assert that [claim] holds, if succesful [claim] is added to the local + hypotheses. If [label] is specified [claim] is given [label] as its identifier, otherwise an + identifier starting with '_H' is generated. + + Additionally, if argument [postpone] is [true], actually proving the claim is postponed. + The claim is asserted and the proof is shelved using an evar. + *) +Local Ltac2 wp_assert (claim : constr) (label : ident option) (postpone : bool):= + let err_msg (g : constr) := concat_list + [of_string "Could not verify that "; of_constr g; of_string "."] in + let id := + match label with + | None => Fresh.in_goal @_H + | Some label => try_out_label label; label + end + in + let claim := claim in + if postpone + then + (* Assert claim and proof using shelved evar *) + (* (using 'admit' would have shown a confusing warning message) *) + assert $claim as $id; + Control.focus 1 1 (fun () => + let evar_id := Fresh.in_goal @_Hpostpone in + ltac1:(id claim |- evar (id : claim)) (Ltac1.of_ident evar_id) (Ltac1.of_constr claim); + let evar := Control.hyp evar_id in + exact $evar + ); + warn (concat_list [of_string "Please come back later to provide an actual proof of "; + of_constr claim; of_string "."]) + + else + (* Assert claim and attempt to prove automatically *) + match Control.case (fun () => + assert $claim as $id by + (waterprove 5 true 99)) + with + | Val _ => () + | Err (FailedToProve g) => throw (err_msg g) + | Err exn => Control.zero exn + end; + (* Print suggestion on how to use new statement. *) + suggest_how_to_use claim label. + +(** Attempts to assert that [claim] holds, if succesful [claim] is added to the local + hypotheses. If [label] is specified [claim] is given [label] as its identifier, otherwise an + identifier starting with '_H' is generated. + [xtr_lemma] has to be used in the proof that [claim] holds. + *) +Local Ltac2 core_wp_assert_by (claim : constr) (label : ident option) (xtr_lemma : constr) := + let err_msg (g : constr) := concat_list + [of_string "Could not verify that "; of_constr g; of_string "."] in + let id := + match label with + | None => Fresh.in_goal @_H + | Some label => try_out_label label; label + end + in + let claim := correct_type_by_wrapping claim in + match Control.case (fun () => + assert $claim as $id by + (rwaterprove 5 true 19 xtr_lemma)) + with + | Val _ => () + | Err (FailedToProve g) => throw (err_msg g) + | Err exn => Control.zero exn (* includes FailedToUse error *) + end. + +(** Adaptation of [core_wp_assert_by] that turns the [FailedToUse] errors + which might be thrown into user readable errors. *) +Local Ltac2 wp_assert_by (claim : constr) (label : ident option) (xtr_lemma : constr) := + wrapper_core_by_tactic (core_wp_assert_by claim label) xtr_lemma; + (* Print suggestion on how to use new statement. *) + suggest_how_to_use claim label. + +(** Adaptation of [core_wp_assert_by] that allows user to use mathematical statements themselves + instead of references to them as extra information for the automation system. + Uses the code in [Since.v]. *) +Local Ltac2 wp_assert_since (claim : constr) (label : ident option) (xtr_claim : constr) := + since_framework (core_wp_assert_by claim label) xtr_claim; + (* Print suggestion on how to use new statement. *) + suggest_how_to_use claim label. + + +(** + Attempts to assert a claim and proves it automatically using a specified lemma, + this lemma has to be used. + + Arguments: + - [xtr_lemma: constr], reference to a lemma used to prove the claim (via [rwaterprove]). + - [label: ident option], optional name for the claim. + If the proof succeeds, it will become a hypothesis (bearing [label] as name). + - [claim: constr], the actual content of the claim to prove. + + Raises exception: + - (fatal) if [rwaterprove] fails to prove the claim using the specified lemma. + - [[label] is already used], if there is already another hypothesis with identifier [label]. +*) +Ltac2 Notation "By" xtr_lemma(constr) "it" "holds" "that" claim(constr) label(opt(seq("(", ident, ")"))) := + panic_if_goal_wrapped (); + wp_assert_by claim label xtr_lemma. + +Ltac2 Notation "Since" xtr_claim(constr) "it" "holds" "that" claim(constr) label(opt(seq("(", ident, ")"))) := + panic_if_goal_wrapped (); + wp_assert_since claim label xtr_claim. + + +(** * It holds that ... (...) + Attempts to assert a claim and proves it automatically. + Removes [StateHyp.Wrapper] wrapper from the goal (proving claim by automation not necessary). + + Arguments: + - [label: ident option], optional name for the claim. + If the proof succeeds, it will become a hypothesis (bearing [label] as name). + - [claim: constr], the actual content of the claim to prove. + + Raises exception: + - (fatal) if [rwaterprove] fails to prove the claim using the specified lemma. + - [[label] is already used], if there is already another hypothesis with identifier [label]. + - (fatal) If goal is wrapped in [StateHyp.Wrapper] and the wrong statement is specified. +*) +Inductive Wrapper (A : Type) (h : A) (G : Type) : Type := + | wrap : G -> Wrapper A h G. +Ltac2 check_constr_equal (_a: constr) (_b: constr) := false. + +Local Ltac2 wp_assert_with_unwrap (claim : constr) (label : ident option) := + (* Try out label first. + Code results in wrong error if done inside repeated match.. *) + match label with | None => () | Some label => try_out_label label end; + + match! goal with + | [h : ?s |- Wrapper ?s ?h_spec _] => + let h_constr := Control.hyp h in + (* sanity check "h = h_spec" *) + if check_constr_equal h_constr h_spec + then () + else fail; + let w := match label with + | None => Fresh.fresh (Fresh.Free.of_goal ()) @_H + | Some label => label + end in + if check_constr_equal s claim + then + match Control.case (fun () => assert $claim as $w by exact $h_constr) with + | Val _ => (* If claims are definitionally equal, go with the + version that is supplied as argument to "It holds that ..." *) + apply (wrap $s); + Std.clear [h] + | Err exn => print (of_string "Exception occurred"); print (of_exn exn) + end + else throw (of_string "Wrong statement specified.") + (* rename ident generated in specialize with user-specified label*) + (* match label with + | None => () + | Some label => Std.rename [(w, label)] + end *) + | [|- _] => + panic_if_goal_wrapped (); + wp_assert claim label false + end. + +Ltac2 Notation "It" "holds" "that" claim(constr) label(opt(seq("(", ident, ")"))) := + wp_assert_with_unwrap claim label. + + +(** * By magic it holds that ... (...) + Asserts a claim and proves it using a shelved evar. + + Arguments: + - [label: ident option], optional name for the claim. + - [claim: constr], the actual content of the claim to prove. + + Raises exception: + - [[label] is already used], if there is already another hypothesis with identifier [label]. + + Raises warning: + - [Please come back later to provide an actual proof of [claim].], always. +*) + +Ltac2 Notation "By" "magic" "it" "holds" "that" claim(constr) label(opt(seq("(", ident, ")"))) := + panic_if_goal_wrapped (); + wp_assert claim label true. \ No newline at end of file diff --git a/serlib/plugins/ltac2/ser_tac2expr.ml b/serlib/plugins/ltac2/ser_tac2expr.ml index 65eb5a41..dd25268c 100644 --- a/serlib/plugins/ltac2/ser_tac2expr.ml +++ b/serlib/plugins/ltac2/ser_tac2expr.ml @@ -169,7 +169,7 @@ module T2ESpec = struct | CTacFun of raw_patexpr list * raw_tacexpr | CTacApp of raw_tacexpr * raw_tacexpr list | CTacSyn of (Names.lname * raw_tacexpr) list * Names.KerName.t - | CTacLet of rec_flag * (raw_patexpr * raw_tacexpr) list * Names.KerName.t + | CTacLet of rec_flag * (raw_patexpr * raw_tacexpr) list * raw_tacexpr | CTacCnv of raw_tacexpr * raw_typexpr | CTacSeq of raw_tacexpr * raw_tacexpr | CTacIft of raw_tacexpr * raw_tacexpr * raw_tacexpr diff --git a/test/serlib/genarg/ItHolds.v b/test/serlib/genarg/ItHolds.v new file mode 100644 index 00000000..e9c32a78 --- /dev/null +++ b/test/serlib/genarg/ItHolds.v @@ -0,0 +1,233 @@ +(******************************************************************************) +(* This file is part of Waterproof-lib. *) +(* *) +(* Waterproof-lib is free software: you can redistribute it and/or modify *) +(* it under the terms of the GNU General Public License as published by *) +(* the Free Software Foundation, either version 3 of the License, or *) +(* (at your option) any later version. *) +(* *) +(* Waterproof-lib is distributed in the hope that it will be useful, *) +(* but WITHOUT ANY WARRANTY; without even the implied warranty of *) +(* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) +(* GNU General Public License for more details. *) +(* *) +(* You should have received a copy of the GNU General Public License *) +(* along with Waterproof-lib. If not, see . *) +(* *) +(******************************************************************************) + +Require Import Ltac2.Ltac2. +Require Import Ltac2.Message. +Local Ltac2 concat_list (ls : message list) : message := + List.fold_right concat ls (of_string ""). + +(** Tries to make the assertion [True] with label [label]. + Throws an error if this fails, i.e. if the label is already used + for another one of the hypotheses. + + This check was separated out from the 'assert'-tactics below because the + '[label] is already used error' would otherwise be caught in + the code meant to catch [AutomationFailure] errors. *) + +Local Ltac2 try_out_label (label : ident) := + match Control.case (fun () => + assert True as $label by exact I) + with + | Err exn => Control.zero exn + | Val _ => clear $label + end. + +(* For making tests independent of WaterProof *) +Ltac2 warn : message -> unit := fun _ => (). +Ltac2 throw : message -> unit := fun _ => (). +Ltac2 waterprove (_depth: int) (_shield: bool) (_db_type: 'a) := (). +Ltac2 rwaterprove (_depth: int) (_shield: bool) (_db_type: 'a) (_ : constr) := (). +Ltac2 suggest_how_to_use (_x : constr) (_label : ident option) := (). +Ltac2 Type exn ::= [ FailedToProve(constr) ]. +Ltac2 correct_type_by_wrapping (t: constr): constr := t. +Ltac2 wrapper_core_by_tactic (_by_tactic : constr -> unit) (_xtr_lemma : constr) := (). +Ltac2 panic_if_goal_wrapped () := (). +Ltac2 since_framework (_by_tactic : constr -> unit) (_claimed_cause : constr) := (). + +(** Attempts to assert that [claim] holds, if succesful [claim] is added to the local + hypotheses. If [label] is specified [claim] is given [label] as its identifier, otherwise an + identifier starting with '_H' is generated. + + Additionally, if argument [postpone] is [true], actually proving the claim is postponed. + The claim is asserted and the proof is shelved using an evar. + *) +Local Ltac2 wp_assert (claim : constr) (label : ident option) (postpone : bool):= + let err_msg (g : constr) := concat_list + [of_string "Could not verify that "; of_constr g; of_string "."] in + let id := + match label with + | None => Fresh.in_goal @_H + | Some label => try_out_label label; label + end + in + let claim := claim in + if postpone + then + (* Assert claim and proof using shelved evar *) + (* (using 'admit' would have shown a confusing warning message) *) + assert $claim as $id; + Control.focus 1 1 (fun () => + let evar_id := Fresh.in_goal @_Hpostpone in + ltac1:(id claim |- evar (id : claim)) (Ltac1.of_ident evar_id) (Ltac1.of_constr claim); + let evar := Control.hyp evar_id in + exact $evar + ); + warn (concat_list [of_string "Please come back later to provide an actual proof of "; + of_constr claim; of_string "."]) + + else + (* Assert claim and attempt to prove automatically *) + match Control.case (fun () => + assert $claim as $id by + (waterprove 5 true 99)) + with + | Val _ => () + | Err (FailedToProve g) => throw (err_msg g) + | Err exn => Control.zero exn + end; + (* Print suggestion on how to use new statement. *) + suggest_how_to_use claim label. + +(** Attempts to assert that [claim] holds, if succesful [claim] is added to the local + hypotheses. If [label] is specified [claim] is given [label] as its identifier, otherwise an + identifier starting with '_H' is generated. + [xtr_lemma] has to be used in the proof that [claim] holds. + *) +Local Ltac2 core_wp_assert_by (claim : constr) (label : ident option) (xtr_lemma : constr) := + let err_msg (g : constr) := concat_list + [of_string "Could not verify that "; of_constr g; of_string "."] in + let id := + match label with + | None => Fresh.in_goal @_H + | Some label => try_out_label label; label + end + in + let claim := correct_type_by_wrapping claim in + match Control.case (fun () => + assert $claim as $id by + (rwaterprove 5 true 19 xtr_lemma)) + with + | Val _ => () + | Err (FailedToProve g) => throw (err_msg g) + | Err exn => Control.zero exn (* includes FailedToUse error *) + end. + +(** Adaptation of [core_wp_assert_by] that turns the [FailedToUse] errors + which might be thrown into user readable errors. *) +Local Ltac2 wp_assert_by (claim : constr) (label : ident option) (xtr_lemma : constr) := + wrapper_core_by_tactic (core_wp_assert_by claim label) xtr_lemma; + (* Print suggestion on how to use new statement. *) + suggest_how_to_use claim label. + +(** Adaptation of [core_wp_assert_by] that allows user to use mathematical statements themselves + instead of references to them as extra information for the automation system. + Uses the code in [Since.v]. *) +Local Ltac2 wp_assert_since (claim : constr) (label : ident option) (xtr_claim : constr) := + since_framework (core_wp_assert_by claim label) xtr_claim; + (* Print suggestion on how to use new statement. *) + suggest_how_to_use claim label. + + +(** + Attempts to assert a claim and proves it automatically using a specified lemma, + this lemma has to be used. + + Arguments: + - [xtr_lemma: constr], reference to a lemma used to prove the claim (via [rwaterprove]). + - [label: ident option], optional name for the claim. + If the proof succeeds, it will become a hypothesis (bearing [label] as name). + - [claim: constr], the actual content of the claim to prove. + + Raises exception: + - (fatal) if [rwaterprove] fails to prove the claim using the specified lemma. + - [[label] is already used], if there is already another hypothesis with identifier [label]. +*) +Ltac2 Notation "By" xtr_lemma(constr) "it" "holds" "that" claim(constr) label(opt(seq("(", ident, ")"))) := + panic_if_goal_wrapped (); + wp_assert_by claim label xtr_lemma. + +Ltac2 Notation "Since" xtr_claim(constr) "it" "holds" "that" claim(constr) label(opt(seq("(", ident, ")"))) := + panic_if_goal_wrapped (); + wp_assert_since claim label xtr_claim. + + +(** * It holds that ... (...) + Attempts to assert a claim and proves it automatically. + Removes [StateHyp.Wrapper] wrapper from the goal (proving claim by automation not necessary). + + Arguments: + - [label: ident option], optional name for the claim. + If the proof succeeds, it will become a hypothesis (bearing [label] as name). + - [claim: constr], the actual content of the claim to prove. + + Raises exception: + - (fatal) if [rwaterprove] fails to prove the claim using the specified lemma. + - [[label] is already used], if there is already another hypothesis with identifier [label]. + - (fatal) If goal is wrapped in [StateHyp.Wrapper] and the wrong statement is specified. +*) +Inductive Wrapper (A : Type) (h : A) (G : Type) : Type := + | wrap : G -> Wrapper A h G. +Ltac2 check_constr_equal (_a: constr) (_b: constr) := false. + +Local Ltac2 wp_assert_with_unwrap (claim : constr) (label : ident option) := + (* Try out label first. + Code results in wrong error if done inside repeated match.. *) + match label with | None => () | Some label => try_out_label label end; + + match! goal with + | [h : ?s |- Wrapper ?s ?h_spec _] => + let h_constr := Control.hyp h in + (* sanity check "h = h_spec" *) + if check_constr_equal h_constr h_spec + then () + else fail; + let w := match label with + | None => Fresh.fresh (Fresh.Free.of_goal ()) @_H + | Some label => label + end in + if check_constr_equal s claim + then + match Control.case (fun () => assert $claim as $w by exact $h_constr) with + | Val _ => (* If claims are definitionally equal, go with the + version that is supplied as argument to "It holds that ..." *) + apply (wrap $s); + Std.clear [h] + | Err exn => print (of_string "Exception occurred"); print (of_exn exn) + end + else throw (of_string "Wrong statement specified.") + (* rename ident generated in specialize with user-specified label*) + (* match label with + | None => () + | Some label => Std.rename [(w, label)] + end *) + | [|- _] => + panic_if_goal_wrapped (); + wp_assert claim label false + end. + +Ltac2 Notation "It" "holds" "that" claim(constr) label(opt(seq("(", ident, ")"))) := + wp_assert_with_unwrap claim label. + + +(** * By magic it holds that ... (...) + Asserts a claim and proves it using a shelved evar. + + Arguments: + - [label: ident option], optional name for the claim. + - [claim: constr], the actual content of the claim to prove. + + Raises exception: + - [[label] is already used], if there is already another hypothesis with identifier [label]. + + Raises warning: + - [Please come back later to provide an actual proof of [claim].], always. +*) + +Ltac2 Notation "By" "magic" "it" "holds" "that" claim(constr) label(opt(seq("(", ident, ")"))) := + panic_if_goal_wrapped (); + wp_assert claim label true. \ No newline at end of file diff --git a/test/serlib/genarg/dune b/test/serlib/genarg/dune index d4a74cda..dab2a151 100644 --- a/test/serlib/genarg/dune +++ b/test/serlib/genarg/dune @@ -143,6 +143,14 @@ (action (bash "./%{script} %{input}"))) +(rule + (alias runtest) + (deps + (:script test_roundtrip) + (:input ItHolds.v)) + (action + (bash "./%{script} %{input}"))) + (rule (alias runtest) (deps From fe6ce0ebb3c531e25ab036bcfcf12ae6402681ac Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Tue, 17 Sep 2024 18:55:39 +0200 Subject: [PATCH 11/38] [serlib] Fix wrong pack name for ltac2_ltac1 plugin. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Bug introduced in #820 Co-authored-by: Gaëtan Gilbert --- serlib/plugins/ltac2_ltac1/dune | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/serlib/plugins/ltac2_ltac1/dune b/serlib/plugins/ltac2_ltac1/dune index 151da43d..58952247 100644 --- a/serlib/plugins/ltac2_ltac1/dune +++ b/serlib/plugins/ltac2_ltac1/dune @@ -1,5 +1,5 @@ (library - (name serlib_btauto) + (name serlib_ltac2_ltac1) (public_name coq-lsp.serlib.ltac2_ltac1) (synopsis "Serialization Library for Coq Ltac2_ltac1 Plugin") (preprocess From af3b722f0e7506b0c2a36072df96d9f3f74d1052 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sun, 22 Sep 2024 13:13:36 +0200 Subject: [PATCH 12/38] [coq] Understand rewrite rules and symbols on document outline Fixes: #824 --- CHANGES.md | 2 ++ coq/ast.ml | 19 ++++++++++++++++++- examples/rewrite/_CoqProject | 3 +++ examples/rewrite/simple.v | 26 ++++++++++++++++++++++++++ 4 files changed, 49 insertions(+), 1 deletion(-) create mode 100644 examples/rewrite/_CoqProject create mode 100644 examples/rewrite/simple.v diff --git a/CHANGES.md b/CHANGES.md index fe00cd85..ad0f8e96 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -10,6 +10,8 @@ - [serlib] Support for ltac2_ltac1 plugin (@ejgallego, #820) - [serlib] Fix Ltac2 AST piercing bug, add test case that should help in the future (@ejgallego, jim-portegies, #821) + - [fleche] [8.20] understand rewrite rules and symbols on document + outline (@ejgallego, @Alizter, #82x, fixes: #824) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/coq/ast.ml b/coq/ast.ml index e260ccd3..9ff98c97 100644 --- a/coq/ast.ml +++ b/coq/ast.ml @@ -128,7 +128,7 @@ module Kinds = struct let _interface = 11 let function_ = 12 let variable = 13 - let _constant = 14 + let constant = 14 let _string = 15 let _number = 16 let _boolean = 17 @@ -278,6 +278,16 @@ let fixpoint_info ~lines ~range { fname; _ } = let detail = "Fixpoint" in Lang.Ast.Info.make ~range ~name ~detail ~kind:Kinds.function_ () +let symbol_info ~lines ~range + ((_, (idents, _typs)) : + (Constrexpr.ident_decl list * Constrexpr.constr_expr) with_coercion) = + let detail = "Rewrite Symbol" in + let mk_info (id, _) = + let name = mk_id ~lines id in + Lang.Ast.Info.make ~range ~name ~detail ~kind:Kinds.constant () + in + List.map mk_info idents + let make_info ~st:_ ~lines CAst.{ loc; v } : Lang.Ast.Info.t list option = let open Vernacexpr in match loc with @@ -310,4 +320,11 @@ let make_info ~st:_ ~lines CAst.{ loc; v } : Lang.Ast.Info.t list option = let kind = Kinds.method_ in let detail = "Instance" in Some [ Lang.Ast.Info.make ~range ~name ~kind ~detail () ] + | VernacSynPure (VernacSymbol slist) -> + Some (List.concat_map (symbol_info ~lines ~range) slist) + | VernacSynPure (VernacAddRewRule (name, _)) -> + let name = mk_id ~lines name in + let kind = Kinds.method_ in + let detail = "Rewrite Rule" in + Some [ Lang.Ast.Info.make ~range ~name ~kind ~detail () ] | _ -> None) diff --git a/examples/rewrite/_CoqProject b/examples/rewrite/_CoqProject new file mode 100644 index 00000000..bc0bb094 --- /dev/null +++ b/examples/rewrite/_CoqProject @@ -0,0 +1,3 @@ +-arg -allow-rewrite-rules + +simple.v diff --git a/examples/rewrite/simple.v b/examples/rewrite/simple.v new file mode 100644 index 00000000..db670c91 --- /dev/null +++ b/examples/rewrite/simple.v @@ -0,0 +1,26 @@ +(* test for *) + +Symbols + (pplus : nat -> nat -> nat) + (pmul : nat -> nat -> nat). + +Notation "a ++ b" := (pplus a b). +Notation "a ** b" := (pmul a b) (at level 30). + +Rewrite Rules pplus_rewrite := +| ?n ++ 0 => ?n +| ?n ++ S ?m => S (?n ++ ?m) +| 0 ++ ?n => ?n +| S ?n ++ ?m => S (?n ++ ?m) +| ?n ++ (?m ++ ?o) => (?n ++ ?m) ++ ?o. + +Rewrite Rules pmul_rewrite := +| 0 ** ?n => 0 +| ?n ** 0 => 0 +| S ?n ** ?m => ?n ++ (?n ** ?m) +| ?n ** S ?m => ?m ++ (?n ** ?m) +| ?n ** (?m ** ?o) => (?n ** ?m) ** ?o. + +Lemma foo n m : S n ** m ++ 0 = n ++ (n ** m). +Proof. now reflexivity. Qed. + From 0d9954ab06dffd3c678e421d0e78d3a534cee6e4 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sun, 22 Sep 2024 16:12:52 +0200 Subject: [PATCH 13/38] [examples] [rewrite] Add example from Ali, tweak the simple one. --- examples/rewrite/alis.v | 53 +++++++++++++++++++++++++++++++++++++++ examples/rewrite/simple.v | 5 ++-- 2 files changed, 55 insertions(+), 3 deletions(-) create mode 100644 examples/rewrite/alis.v diff --git a/examples/rewrite/alis.v b/examples/rewrite/alis.v new file mode 100644 index 00000000..1398856f --- /dev/null +++ b/examples/rewrite/alis.v @@ -0,0 +1,53 @@ +From Coq Require Import Prelude. + +Inductive paths {A : Type} (a : A) : A -> Type := + idpath : paths a a. + +Notation "x = y :> A" := (@paths A x y) : type_scope. +Notation "x = y" := (x = y :>_) : type_scope. + +Symbol Interval : Set. +Symbol i0 : Interval. +Symbol i1 : Interval. +Symbol seg : i0 = i1. + +Definition transport {A : Type} (P : A -> Type) {x y : A} (p : x = y) (u : P x) : P y + := match p with idpath _ => u end. + + +Unset Universe Polymorphism. +Symbol ap@{u v} : forall {A : Type@{u}}{B : Type@{v}} (f : A -> B) {x y : A} + (p : x = y), f x = f y. +Rewrite Rule ap_comp := +| @ap ?A ?P ?f _ _ (@idpath@{u} _ ?a) => @idpath ?P (?f ?a). +Symbol apD@{u v} : forall {A : Type@{u}} {P : A -> Type@{v}} + (f : forall x, P x) {x y : A} (p : x = y), transport P p (f x) = f y. +Rewrite Rule apD_comp := +| @apD ?A ?P ?f _ _ (@idpath _ ?a) => @idpath (?P ?a) (?f ?a). +Set Universe Polymorphism. + +Symbol Interval_ind + : forall (P : Interval -> Type) + (a : P i0) (b : P i1) (p : transport P seg a = b), + forall x, P x. + +Symbol Interval_rec : forall (P : Type) (a b : P) (p : a = b), Interval -> P. + +Rewrite Rule interval_rewrite := +| Interval_ind ?P ?a ?b ?p i0 => ?a +| Interval_ind ?P ?a ?b ?p i1 => ?b +| apD (Interval_ind ?P ?a ?b ?p) seg => ?p +| ap (Interval_rec ?P ?a ?b ?p) seg => ?p +. + +Definition funext {A : Type} {P : A -> Type} {f g : forall x, P x} + : (forall x, f x = g x) -> f = g. +Proof. + intros p. + simple refine (let r := _ in _). + 1: exact (Interval -> forall x, P x). + { intros i x; revert i. + exact (Interval_rec _ (f x) (g x) (p x)). } + (* Coq can't rewrite under eta :'( *) + Fail exact (ap r seg). +Abort. diff --git a/examples/rewrite/simple.v b/examples/rewrite/simple.v index db670c91..b22831cb 100644 --- a/examples/rewrite/simple.v +++ b/examples/rewrite/simple.v @@ -5,7 +5,7 @@ Symbols (pmul : nat -> nat -> nat). Notation "a ++ b" := (pplus a b). -Notation "a ** b" := (pmul a b) (at level 30). +Notation "a ** b" := (pmul a b) (at level 50). Rewrite Rules pplus_rewrite := | ?n ++ 0 => ?n @@ -21,6 +21,5 @@ Rewrite Rules pmul_rewrite := | ?n ** S ?m => ?m ++ (?n ** ?m) | ?n ** (?m ** ?o) => (?n ** ?m) ** ?o. -Lemma foo n m : S n ** m ++ 0 = n ++ (n ** m). +Lemma foo n m : S n ** m ++ 0 = n ++ n ** m. Proof. now reflexivity. Qed. - From 32d3cbe29b8c80e853b5f932da1a90e0a53dcf6f Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Tue, 24 Sep 2024 16:42:09 +0200 Subject: [PATCH 14/38] [coq] [fleche] Support `Restart` command. Thanks to Ali for pointing this out. Fixes #827 --- CHANGES.md | 4 +++- coq/ast.ml | 12 ++++++++---- coq/ast.mli | 5 +++-- examples/MetaCommands.v | 7 +++++++ fleche/doc.ml | 12 ++++++++++++ 5 files changed, 33 insertions(+), 7 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index ad0f8e96..a5f2ba03 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,7 +11,9 @@ - [serlib] Fix Ltac2 AST piercing bug, add test case that should help in the future (@ejgallego, jim-portegies, #821) - [fleche] [8.20] understand rewrite rules and symbols on document - outline (@ejgallego, @Alizter, #82x, fixes: #824) + outline (@ejgallego, @Alizter, #825, fixes: #824) + - [fleche] [coq] support `Restart` meta command (@ejgallego, + @Alizter, #829, fixes #828) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/coq/ast.ml b/coq/ast.ml index 9ff98c97..8f0692c7 100644 --- a/coq/ast.ml +++ b/coq/ast.ml @@ -74,12 +74,13 @@ module Meta = struct module Command = struct type t = + | AbortAll | Back of int - | ResetName of Names.lident | ResetInitial - | AbortAll - (* Not supported, but actually easy if we want | VernacRestart | VernacUndo - _ | VernacUndoTo _ *) + | ResetName of Names.lident + | Restart + (* Not supported, but actually easy if we want | VernacUndo _ | VernacUndoTo + _ *) [@@deriving hash, compare] end @@ -104,6 +105,9 @@ module Meta = struct | { expr = VernacSynPure VernacResetInitial; control; attrs } -> let command = Command.ResetInitial in Some { command; loc; attrs; control } + | { expr = VernacSynPure VernacRestart; control; attrs } -> + let command = Command.Restart in + Some { command; loc; attrs; control } | { expr = VernacSynPure (VernacBack num); control; attrs } -> let command = Command.Back num in Some { command; loc; attrs; control } diff --git a/coq/ast.mli b/coq/ast.mli index 950afeb1..e68be82a 100644 --- a/coq/ast.mli +++ b/coq/ast.mli @@ -37,10 +37,11 @@ module Meta : sig module Command : sig type t = + | AbortAll | Back of int - | ResetName of Names.lident | ResetInitial - | AbortAll + | ResetName of Names.lident + | Restart end type t = diff --git a/examples/MetaCommands.v b/examples/MetaCommands.v index a352ed8c..d56da43f 100644 --- a/examples/MetaCommands.v +++ b/examples/MetaCommands.v @@ -42,5 +42,12 @@ Lemma foo : True. now auto. Qed. Print foo. +(* testing restart *) +Goal nat -> nat. +intro x. +Restart. +intros x. exact x. +Qed. + diff --git a/fleche/doc.ml b/fleche/doc.ml index 9a01c900..21c58f39 100644 --- a/fleche/doc.ml +++ b/fleche/doc.ml @@ -552,6 +552,13 @@ end (* This is not in its own module because we don't want to move the definition of [Node.t] out (yet) *) module Recovery : sig + (** [find_proof_start nodes] returns [Some (node, pnode)] where [node] is the + node that contains the start of the proof, and [pnode] is the previous + node, if exists. [nodes] is the list of document nodes, in _reverse + order_. *) + val find_proof_start : Node.t list -> (Node.t * Node.t option) option + (* This is useful in meta-commands, and other plugins actually! *) + val handle : token:Coq.Limits.Token.t -> context:Recovery_context.t @@ -672,6 +679,11 @@ let search_node ~command ~doc ~st = in (Coq.Protect.E.error message, nstats None) | Some node -> (Coq.Protect.E.ok node.state, nstats (Some node))) + | Restart -> ( + match Recovery.find_proof_start doc.nodes with + | None -> + (Coq.Protect.E.error Pp.(str "no proof to restart"), Memo.Stats.zero) + | Some (node, _) -> (Coq.Protect.E.ok node.state, nstats None)) | ResetName id -> ( let toc = doc.toc in let id = Names.Id.to_string id.v in From 472fc108b7158dcb9e59289d5428fd9836ca6ab9 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Thu, 26 Sep 2024 15:59:58 +0200 Subject: [PATCH 15/38] [vendor] [deps] bump Coq --- vendor/coq | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vendor/coq b/vendor/coq index 7fec4bd9..b6805232 160000 --- a/vendor/coq +++ b/vendor/coq @@ -1 +1 @@ -Subproject commit 7fec4bd91f2873f98541b5ecf640e83369768c99 +Subproject commit b68052328b65a3e85cd48a4718713fdd0c24f08d From 040aca3910ce9a26cec7119d52441d3e577d677b Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Thu, 26 Sep 2024 17:55:32 +0200 Subject: [PATCH 16/38] [nits] Minor refactorings and tweaks from the JS branch. --- controller/coq_lsp.ml | 34 +--------------------------------- controller/lsp_core.ml | 38 +++++++++++++++++++++++++++++++++++++- controller/lsp_core.mli | 7 +++++++ coq/workspace.mli | 1 + editor/code/src/goals.ts | 10 +--------- examples/documentSymbol.v | 4 ++-- 6 files changed, 49 insertions(+), 45 deletions(-) diff --git a/controller/coq_lsp.ml b/controller/coq_lsp.ml index 3d7746cb..fe410bd2 100644 --- a/controller/coq_lsp.ml +++ b/controller/coq_lsp.ml @@ -60,38 +60,6 @@ let concise_cb ofn = } (* Main loop *) -module CB (O : sig - val ofn : Lsp.Base.Notification.t -> unit -end) = -struct - let ofn = O.ofn - let trace _hdr ?extra message = Lsp.Io.logTrace ~message ~extra - let message ~lvl ~message = Lsp.Io.logMessage ~lvl ~message - - let diagnostics ~uri ~version diags = - Lsp.Core.mk_diagnostics ~uri ~version diags |> ofn - - let fileProgress ~uri ~version progress = - Lsp.JFleche.mk_progress ~uri ~version progress |> ofn - - let perfData ~uri ~version perf = - Lsp.JFleche.mk_perf ~uri ~version perf |> ofn - - let serverVersion vi = Lsp.JFleche.mk_serverVersion vi |> ofn - let serverStatus st = Lsp.JFleche.mk_serverStatus st |> ofn - - let cb = - Fleche.Io.CallBack. - { trace - ; message - ; diagnostics - ; fileProgress - ; perfData - ; serverVersion - ; serverStatus - } -end - let coq_init ~debug = let load_module = Dynlink.loadfile in let load_plugin = Coq.Loader.plugin_handler None in @@ -130,7 +98,7 @@ let lsp_main bt coqcorelib coqlib ocamlpath vo_load_path ml_include_path Lsp.Io.set_log_fn ofn_ntn; - let module CB = CB (struct + let module CB = Lsp_core.CB (struct let ofn = ofn_ntn end) in let io = CB.cb in diff --git a/controller/lsp_core.ml b/controller/lsp_core.ml index 62963a07..102afbf9 100644 --- a/controller/lsp_core.ml +++ b/controller/lsp_core.ml @@ -23,7 +23,11 @@ module F = Format module J = Yojson.Safe module U = Yojson.Safe.Util -let field name dict = List.(assoc name dict) +let field name dict = + try List.(assoc name dict) + with Not_found -> + raise (U.Type_error ("field " ^ name ^ " not found", `Assoc dict)) + let int_field name dict = U.to_int (field name dict) let list_field name dict = U.to_list (field name dict) let string_field name dict = U.to_string (field name dict) @@ -710,3 +714,35 @@ let enqueue_message (com : LSP.Message.t) = general, to perform queue optimizations *) LspQueue.push_and_optimize com; set_current_token () + +module CB (O : sig + val ofn : Lsp.Base.Notification.t -> unit +end) = +struct + let ofn = O.ofn + let trace _hdr ?extra message = Lsp.Io.logTrace ~message ~extra + let message ~lvl ~message = Lsp.Io.logMessage ~lvl ~message + + let diagnostics ~uri ~version diags = + Lsp.Core.mk_diagnostics ~uri ~version diags |> ofn + + let fileProgress ~uri ~version progress = + Lsp.JFleche.mk_progress ~uri ~version progress |> ofn + + let perfData ~uri ~version perf = + Lsp.JFleche.mk_perf ~uri ~version perf |> ofn + + let serverVersion vi = Lsp.JFleche.mk_serverVersion vi |> ofn + let serverStatus st = Lsp.JFleche.mk_serverStatus st |> ofn + + let cb = + Fleche.Io.CallBack. + { trace + ; message + ; diagnostics + ; fileProgress + ; perfData + ; serverVersion + ; serverStatus + } +end diff --git a/controller/lsp_core.mli b/controller/lsp_core.mli index 0b9368a3..eb3aac4b 100644 --- a/controller/lsp_core.mli +++ b/controller/lsp_core.mli @@ -63,3 +63,10 @@ val dispatch_or_resume_check : (** Add a message to the queue *) val enqueue_message : Lsp.Base.Message.t -> unit + +(** Generic output handler *) +module CB (O : sig + val ofn : Lsp.Base.Notification.t -> unit +end) : sig + val cb : Fleche.Io.CallBack.t +end diff --git a/coq/workspace.mli b/coq/workspace.mli index 74670083..fe66abbc 100644 --- a/coq/workspace.mli +++ b/coq/workspace.mli @@ -42,6 +42,7 @@ module Require : sig } end +(* Generated from a _CoqProject, dune (in the future) or command line args *) type t = private { coqlib : string ; coqcorelib : string diff --git a/editor/code/src/goals.ts b/editor/code/src/goals.ts index 87aec4db..bb6cd544 100644 --- a/editor/code/src/goals.ts +++ b/editor/code/src/goals.ts @@ -1,12 +1,4 @@ -import { - Uri, - WebviewPanel, - window, - ViewColumn, - extensions, - commands, - TextDocument, -} from "vscode"; +import { Uri, WebviewPanel, window, ViewColumn } from "vscode"; import { BaseLanguageClient, RequestType, diff --git a/examples/documentSymbol.v b/examples/documentSymbol.v index 06cf6e4f..a0149e94 100644 --- a/examples/documentSymbol.v +++ b/examples/documentSymbol.v @@ -8,7 +8,7 @@ Inductive foo := A | B : a -> foo. Inductive eh1 := Ah1 : eh2 -> eh1 with eh2 := Bh1 : eh1 -> eh2. -Variable (j : nat). +Axiom (j : nat). Axiom test : False. @@ -34,7 +34,7 @@ End Moo. Module Bar. - Variable (u : nat). + Parameter (u : nat). Parameter (v : nat). From 0afa5fb3c7db7ac17ee254350202b894143f609f Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Wed, 25 Sep 2024 15:07:29 +0200 Subject: [PATCH 17/38] [plugins] Example for error explaining plugin. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Inspired from the comments on Coq's issue 19601. For example, for this file: ```coq Definition a := 3. Lemma foo (n : nat) (f : nat -> nat) : True = False. Proof. now reflexivity. set (g := 3). Qed. ``` ẁe get: ``` Error: In environment n : nat f : nat -> nat Unable to unify "False" with "True". when trying to apply now reflexivity. for goals: 1 goal n : nat f : nat -> nat ============================ True = False [message] [explain errors plugin] Error: (in proof foo): Attempt to save an incomplete proof (there are remaining open goals). when trying to apply Qed. for goals: 1 goal n : nat f : nat -> nat g := 3 : nat ============================ True = False ``` --- CHANGES.md | 7 ++-- coq/print.ml | 8 +++++ coq/print.mli | 3 ++ plugins/explain_errors/dune | 4 +++ plugins/explain_errors/main.ml | 58 +++++++++++++++++++++++++++++++++ plugins/explain_errors/main.mli | 1 + 6 files changed, 79 insertions(+), 2 deletions(-) create mode 100644 plugins/explain_errors/dune create mode 100644 plugins/explain_errors/main.ml create mode 100644 plugins/explain_errors/main.mli diff --git a/CHANGES.md b/CHANGES.md index a5f2ba03..87b0133b 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -9,11 +9,14 @@ `-allow-rewrite-rules` (for 8.20) (@ejgallego, #819) - [serlib] Support for ltac2_ltac1 plugin (@ejgallego, #820) - [serlib] Fix Ltac2 AST piercing bug, add test case that should help - in the future (@ejgallego, jim-portegies, #821) + in the future (@ejgallego, @jim-portegies, #821) - [fleche] [8.20] understand rewrite rules and symbols on document outline (@ejgallego, @Alizter, #825, fixes: #824) - [fleche] [coq] support `Restart` meta command (@ejgallego, - @Alizter, #829, fixes #828) + @Alizter, #828, fixes #827) + - [fleche] [plugins] New plugin example `explain_errors`, that will + print all errors on a file, with their goal context (@ejgallego, + #829, thanks to @gmalecha for the idea, c.f. Coq issue 19601) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/coq/print.ml b/coq/print.ml index 01f09273..9430200a 100644 --- a/coq/print.ml +++ b/coq/print.ml @@ -4,3 +4,11 @@ let pr_letype_env ~goal_concl_style env sigma x = let pr_letype_env ~token ~goal_concl_style env sigma x = let f = pr_letype_env ~goal_concl_style env sigma in Protect.eval ~token ~f x + +let pr_goals ~token ~proof = + let proof = + State.Proof.to_coq proof |> Vernacstate.LemmaStack.get_top + |> Declare.Proof.get + in + let f = Printer.pr_open_subgoals in + Protect.eval ~token ~f proof diff --git a/coq/print.mli b/coq/print.mli index e6a4dda4..98d18d10 100644 --- a/coq/print.mli +++ b/coq/print.mli @@ -5,3 +5,6 @@ val pr_letype_env : -> Evd.evar_map -> EConstr.t -> (Pp.t, Loc.t) Protect.E.t + +val pr_goals : + token:Limits.Token.t -> proof:State.Proof.t -> (Pp.t, Loc.t) Protect.E.t diff --git a/plugins/explain_errors/dune b/plugins/explain_errors/dune new file mode 100644 index 00000000..4f4fc5f2 --- /dev/null +++ b/plugins/explain_errors/dune @@ -0,0 +1,4 @@ +(library + (name Explain_errors) + (public_name coq-lsp.plugin.explain_errors) + (libraries coq-lsp.fleche)) diff --git a/plugins/explain_errors/main.ml b/plugins/explain_errors/main.ml new file mode 100644 index 00000000..599a856e --- /dev/null +++ b/plugins/explain_errors/main.ml @@ -0,0 +1,58 @@ +(* Example plugin to print errors with goals *) +(* c.f. https://github.com/coq/coq/issues/19601 *) +open Fleche + +let msg_info ~io = Io.(Report.msg ~io ~lvl:Info) + +let pp_goals ~token ~st = + match Coq.State.lemmas ~st with + | None -> Pp.str "no goals" + | Some proof -> ( + match Coq.Print.pr_goals ~token ~proof with + | { Coq.Protect.E.r = Completed (Ok goals); _ } -> goals + | { Coq.Protect.E.r = Completed (Error (User msg | Anomaly msg)); _ } -> + Pp.(str "error when printing goals: " ++ snd msg) + | { Coq.Protect.E.r = Interrupted; _ } -> + Pp.str "goal printing was interrupted") + +module Error_info = struct + type t = + { error : Pp.t + ; command : string + ; goals : Pp.t + } + + let print ~io { error; command; goals } = + msg_info ~io + "[explain errors plugin]@\n\ + Error:@\n\ + \ @[%a@]@\n\ + @\n\ + when trying to apply@\n\ + @\n\ + \ @[%s@]@\n\ + for goals:@\n\ + \ @[%a@]" Pp.pp_with error command Pp.pp_with goals +end + +let extract_errors ~token ~root ~contents (node : Doc.Node.t) = + let errors = List.filter Lang.Diagnostic.is_error node.diags in + let st = Option.cata Doc.Node.state root node.prev in + let command = Contents.extract_raw ~contents ~range:node.range in + let goals = pp_goals ~token ~st in + List.map + (fun { Lang.Diagnostic.message; _ } -> + { Error_info.error = message; command; goals }) + errors + +let explain_error ~io ~token ~(doc : Doc.t) = + let root = doc.root in + let contents = doc.contents in + let errors = + List.(map (extract_errors ~token ~root ~contents) doc.nodes |> concat) + in + msg_info ~io "[explain errors plugin] we got %d errors" (List.length errors); + List.iter (Error_info.print ~io) errors + +let main () = Theory.Register.Completed.add explain_error +let () = main () diff --git a/plugins/explain_errors/main.mli b/plugins/explain_errors/main.mli new file mode 100644 index 00000000..948db8fa --- /dev/null +++ b/plugins/explain_errors/main.mli @@ -0,0 +1 @@ +(* *) From 010da4970b9eeca45036e11dd4c6500a717c5de3 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Mon, 10 Jun 2024 01:13:03 +0200 Subject: [PATCH 18/38] [doc] Some tweaks to PROTOCOL.md documentation. --- etc/doc/PROTOCOL.md | 160 ++++++++++++++++++++++++++++++++------------ 1 file changed, 118 insertions(+), 42 deletions(-) diff --git a/etc/doc/PROTOCOL.md b/etc/doc/PROTOCOL.md index e802371d..a9d3322b 100644 --- a/etc/doc/PROTOCOL.md +++ b/etc/doc/PROTOCOL.md @@ -15,66 +15,142 @@ See also the upstream LSP issue on generic support for Proof Assistants https://github.com/microsoft/language-server-protocol/issues/1414 +### coq-lsp basic operating model + +`coq-lsp` is a bit different from other servers in that checking the +file is often very expensive, so the continuous LSP model can be too +heavy. The philosophy of `coq-lsp` is to treat a Coq document as a +build task, and then check the document under user-request. + +Thus, for example when the user requests goals at a given point, +`coq-lsp` will check if the goals are known, otherwise try to check +the required document parts to return answers to the user ASAP. + +`coq-lsp` has three main functioning modes (controlled by a regular +parameter): + +- _continuous mode_: in this mode, `coq-lsp` will try to complete + checking of all open files when idle. This mode has shown to be very + useful in many contexts, for example educational, as it provides + very low latency. + +- _on-demand mode_: in this mode, `coq-lsp` will do nothing when + idle. This mode for example can be used to simulate the traditional + "step-based" Coq interaction mode, just have your client request + goals as the desired step position, `coq-lsp` will execute the + document up to that point. + +- _on-demand mode, with viewport hints_: in this mode, inspired by + Isabelle, the `coq-lsp` client will inform the server about the + user's viewport. This mode provides a comfortable compromise between + latency and CPU usage. + +Note that on-demand mode often implies that some requests that require +the full document to be checked, like `documentSymbols`, will return +less complete information. + +Also note that it has been hard for us to design an interaction mode +that would fit well all client editors; for example VSCode doesn't +implement progress on some requests that would be very useful for us. + +However, the underlying checking engine (`Flèche`) is very flexible, +so don't hesitate to contact with us if your client would want things +in a different way. + +### coq-lsp workspace configuration + +See the manual for the exact details, but indeed, coq-lsp will try to +auto-configure Coq projects looking for `_CoqProject` files in the LSP +workspace folders sent by the client. + +### A minimal client implementation: + +In order to implement a minimal, but working `coq-lsp` client, you need to: + +- setup a regular LSP client on your side, +- setup the right parameters for `initializationOptions` on `initialize`, +- implement the `coq/goals` request + +And that should be it! We recommend next supporting the +`coq/serverStatus` notification, and maybe `coq/viewport` too. + ## Language server protocol support table If a feature doesn't appear here it usually means it is not planned in the short term: -| Method | Support | Notes | -|---------------------------------------|---------|---------------------------------------------------------------| -| `initialize` | Partial | We don't obey the advertised client capabilities | -| `client/registerCapability` | No | Not planned ATM | -| `$/setTrace` | Yes | | -| `$/logTrace` | Yes | | -| `window/logMessage` | Yes | | -|---------------------------------------|---------|---------------------------------------------------------------| -| `textDocument/didOpen` | Yes | We can't reuse Memo tables yet | -| `textDocument/didChange` | Yes | We only support `TextDocumentSyncKind.Full` for now | -| `textDocument/didClose` | Partial | We'd likely want to save a `.vo` file on close if possible | -| `textDocument/didSave` | Partial | Undergoing behavior refinement | -|---------------------------------------|---------|---------------------------------------------------------------| -| `notebookDocument/didOpen` | No | Planned | -|---------------------------------------|---------|---------------------------------------------------------------| -| `textDocument/declaration` | No | Planned, blocked on upstream issues | -| `textDocument/definition` | Yes (*) | Uses .glob information which is often incomplete | -| `textDocument/references` | No | Planned, blocked on upstream issues | -| `textDocument/hover` | Yes | Shows stats and type info of identifiers at point, extensible | -| `textDocument/codeLens` | No | | -| `textDocument/foldingRange` | No | | -| `textDocument/documentSymbol` | Yes | Sections and modules missing (#322) | -| `textDocument/semanticTokens` | No | Planned | -| `textDocument/inlineValue` | No | Planned | -| `textDocument/inlayHint` | No | Planned | -| `textDocument/completion` | Partial | Needs more work locally and upstream (#50) | -| `textDocument/publishDiagnostics` | Yes | | -| `textDocument/diagnostic` | No | Planned, issue #49 | -| `textDocument/codeAction` | No | Planned | -| `textDocument/selectionRange` | Partial | Selection for a point is its span; no parents | -|---------------------------------------|---------|---------------------------------------------------------------| -| `workspace/workspaceFolders` | Yes | Each folder should have a `_CoqProject` file at the root. | -| `workspace/didChangeWorkspaceFolders` | Yes | | -| `workspace/didChangeConfiguration` | Yes (*) | We still do a client -> server push, instead of pull | -|---------------------------------------|---------|---------------------------------------------------------------| +| Method | Support | Notes | +|---------------------------------------|---------|--------------------------------------------------------------------------| +| `initialize` | Partial | We don't obey the advertised client capabilities | +| `client/registerCapability` | No | Not planned ATM | +| `$/setTrace` | Yes | | +| `$/logTrace` | Yes | | +| `window/logMessage` | Yes | | +|---------------------------------------|---------|--------------------------------------------------------------------------| +| `textDocument/didOpen` | Yes | We can't reuse Memo tables yet | +| `textDocument/didChange` | Yes | We only support `TextDocumentSyncKind.Full` for now | +| `textDocument/didClose` | Partial | We'd likely want to save a `.vo` file on close if possible | +| `textDocument/didSave` | Partial | Undergoing behavior refinement | +|---------------------------------------|---------|--------------------------------------------------------------------------| +| `notebookDocument/didOpen` | No | Planned | +|---------------------------------------|---------|--------------------------------------------------------------------------| +| `textDocument/declaration` | No | Planned, blocked on upstream issues | +| `textDocument/definition` | Yes (*) | Uses .glob information which is often incomplete | +| `textDocument/references` | No | Planned, blocked on upstream issues | +| `textDocument/hover` | Yes | Shows stats, type info, and location of identifiers at point, extensible | +| `textDocument/codeLens` | No | | +| `textDocument/foldingRange` | No | | +| `textDocument/documentSymbol` | Yes | Sections and modules missing (#322) | +| `textDocument/semanticTokens` | No | Planned | +| `textDocument/inlineValue` | No | Planned | +| `textDocument/inlayHint` | No | Planned | +| `textDocument/completion` | Partial | Needs more work locally and upstream (#50) | +| `textDocument/publishDiagnostics` | Yes | | +| `textDocument/diagnostic` | No | Planned, issue #49 | +| `textDocument/codeAction` | No | Planned | +| `textDocument/selectionRange` | Partial | Selection for a point is its span; no parents | +|---------------------------------------|---------|--------------------------------------------------------------------------| +| `workspace/diagnostic` | No | Planned | +| `workspace/workspaceFolders` | Yes | Each folder should have a `_CoqProject` file at the root. | +| `workspace/didChangeWorkspaceFolders` | Yes | | +| `workspace/didChangeConfiguration` | Yes (*) | We still do a client -> server push, instead of pull | +|---------------------------------------|---------|--------------------------------------------------------------------------| ### URIs accepted by coq-lsp -`coq-lsp` only accepts `file:///` URIs; moreover, the URIs sent to the -server must be able to be mapped back to a Coq library name, so a -fully-checked file can be saved to a `.vo` for example. +The `coq-lsp` server only accepts `file:///` URIs; moreover, the URIs +sent to the server must be able to be mapped back to a Coq library +name, so a fully-checked file can be saved to a `.vo` for example. Don't hesitate to open an issue if you need support for different kind -of URIs in your application / client. +of URIs in your application / client. The client does support +`vsls:///` URIs. Additionally, `coq-lsp` will use the extension of the file in the URI to determine the content type. Supported extensions are: - `.v`: File will be interpreted as a regular Coq vernacular file, -- `.mv`: File will be interpreted as a markdown file, and code +- `.mv`: File will be interpreted as a markdown file. Code snippets between `coq` markdown code blocks will be interpreted as Coq code. +- `.v.tex` or `.lv`: File will be interpreted as a LaTeX file. Code + snippets between `\begin{coq}/\end{coq}` LaTeX environments will be + interpreted as Coq code. ## Extensions to the LSP specification -As of today, `coq-lsp` implements two extensions to the LSP spec. Note -that none of them are stable yet: +As of today, `coq-lsp` implements several extensions to the LSP +spec. Note that none of them are stable yet. + +- [Extra diagnostics data](#extra-diagnostics-data) +- [Goal display](#goal-display) +- [File checking progress](#file-checking-progress) +- [Document Ast](#document-ast-request) +- [.vo file saving](#vo-file-saving) +- [Performance data notification](#performance-data-notification) +- [Trim cache notification](#trim-cache-notification) +- [Viewport notification](#viewport-notification) +- [Server configuration parameters](#did-change-configuration-and-server-configuration-parameters) +- [Server version notification](#server-version-notification) +- [Server status notification](#server-status-notification) ### Extra diagnostics data From e9e9f800e378854419569e1186562c1f44722dfe Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Thu, 26 Sep 2024 21:24:19 +0200 Subject: [PATCH 19/38] [ci] Bump some actions to remove CI warnings. --- .github/workflows/build.yml | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index e45be040..21416bab 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -58,7 +58,7 @@ jobs: steps: - name: 🔭 Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: submodules: recursive @@ -92,7 +92,7 @@ jobs: runs-on: ubuntu-latest steps: - name: 🔭 Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: submodules: recursive @@ -128,7 +128,7 @@ jobs: steps: - name: 🔭 Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: submodules: recursive @@ -145,9 +145,9 @@ jobs: working-directory: ./editor/code steps: - name: 🔭 Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 - name: 🚀 Setup node - uses: actions/setup-node@v3 + uses: actions/setup-node@v4 with: node-version: 18 - run: npm ci @@ -158,7 +158,7 @@ jobs: runs-on: ubuntu-latest steps: - name: 🔭 Checkout code - uses: actions/checkout@v3 + uses: actions/checkout@v4 with: submodules: recursive - name: ❄️ Setup Nix From 87997c30f5440ff4354062dc91eabb4ab1083694 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Fri, 27 Sep 2024 13:06:18 +0200 Subject: [PATCH 20/38] [fleche] Highlight the full first line of the document on initialization error. --- CHANGES.md | 2 ++ fleche/doc.ml | 6 ++++-- 2 files changed, 6 insertions(+), 2 deletions(-) diff --git a/CHANGES.md b/CHANGES.md index 87b0133b..a3cb25b6 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -17,6 +17,8 @@ - [fleche] [plugins] New plugin example `explain_errors`, that will print all errors on a file, with their goal context (@ejgallego, #829, thanks to @gmalecha for the idea, c.f. Coq issue 19601) + - [fleche] Highlight the full first line of the document on + initialization error (@ejgallego, #832) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/fleche/doc.ml b/fleche/doc.ml index 21c58f39..fbde2b1e 100644 --- a/fleche/doc.ml +++ b/fleche/doc.ml @@ -318,15 +318,17 @@ let init_fname ~uri = let init_loc ~uri = Loc.initial (init_fname ~uri) (* default range for the node that contains the init feedback errors *) -let drange = +let drange ~lines = let open Lang in + let llen = if Array.length lines > 0 then String.length lines.(0) else 1 in let start = Point.{ line = 0; character = 0; offset = 0 } in - let end_ = Point.{ line = 0; character = 1; offset = 1 } in + let end_ = Point.{ line = 0; character = llen; offset = llen } in Range.{ start; end_ } let process_init_feedback ~lines ~stats ~global_stats state feedback = let messages = List.map (Node.Message.feedback_to_message ~lines) feedback in if not (CList.is_empty messages) then + let drange = drange ~lines in let diags, messages = Diags.of_messages ~drange messages in let parsing_time = 0.0 in let info = Node.Info.make ~parsing_time ?stats ~global_stats () in From ae232f84368a286ae9a59b5817554b99fd58092f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ga=C3=ABtan=20Gilbert?= Date: Fri, 27 Sep 2024 16:03:13 +0200 Subject: [PATCH 21/38] [coq] Utils.with_control use VernacControl (adapt to coq/coq#19517 adding a control flag) --- coq/utils.ml | 55 ++++++++++++---------------------------------------- 1 file changed, 12 insertions(+), 43 deletions(-) diff --git a/coq/utils.ml b/coq/utils.ml index 0e6aa7eb..624d4352 100644 --- a/coq/utils.ml +++ b/coq/utils.ml @@ -45,47 +45,16 @@ let to_range ~lines (p : Loc.t) : Lang.Range.t = let to_orange ~lines = Option.map (to_range ~lines) -(* Separation of parsing and execution made upstream API hard to use for us - :/ *) -let pmeasure (measure, print) fn = - match measure fn () with - | Ok _ as r -> Feedback.msg_notice @@ print r - | Error (exn, _) as r -> - Feedback.msg_notice @@ print r; - Exninfo.iraise exn - -let with_fail fn = - try - fn (); - CErrors.user_err (Pp.str "The command has not failed!") - with exn when CErrors.noncritical exn -> - let exn = Exninfo.capture exn in - let msg = CErrors.iprint exn in - Feedback.msg_notice ?loc:None - Pp.(str "The command has indeed failed with message:" ++ fnl () ++ msg) - -let with_ctrl ctrl ~st ~fn = - let st = State.to_coq st in - match ctrl with - | Vernacexpr.ControlTime -> - pmeasure System.(measure_duration, fmt_transaction_result) fn - | Vernacexpr.ControlInstructions -> - pmeasure System.(count_instructions, fmt_instructions_result) fn - | Vernacexpr.ControlTimeout n -> ( - match Control.timeout (float_of_int n) fn () with - | None -> Exninfo.iraise (Exninfo.capture CErrors.Timeout) - | Some x -> x) - (* fail and succeed *) - | Vernacexpr.ControlFail -> - with_fail fn; - Vernacstate.Interp.invalidate_cache (); - Vernacstate.unfreeze_full_state st - | Vernacexpr.ControlSucceed -> - fn (); - Vernacstate.Interp.invalidate_cache (); - Vernacstate.unfreeze_full_state st - (* Unsupported by coq-lsp, maybe deprecate upstream *) - | Vernacexpr.ControlRedirect _ -> fn () - let with_control ~fn ~control ~st = - List.fold_right (fun ctrl fn () -> with_ctrl ctrl ~st ~fn) control fn () + let open VernacControl in + let control = from_syntax control in + let control, () = + under_control ~loc:None ~with_local_state:trivial_state control ~noop:() fn + in + let noop = after_last_phase ~loc:None control in + let () = + if noop then ( + Vernacstate.Interp.invalidate_cache (); + Vernacstate.unfreeze_full_state (State.to_coq st)) + in + () From 0143f792c5bce821f501f494753dd807f4f76ed3 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sat, 28 Sep 2024 16:21:53 +0200 Subject: [PATCH 22/38] [args] [coq] Allow to set ocamlpath and findlib init file separately. This is needed for example in the JS case, likely this will help with the Coq Platform Windows Installer. --- compiler/fcc.ml | 9 +++++---- controller/coq_lsp.ml | 9 +++++---- coq/args.ml | 11 +++++++++-- coq/args.mli | 3 ++- coq/workspace.ml | 28 +++++++++++++--------------- coq/workspace.mli | 8 ++++++-- petanque/json_shell/shell.ml | 3 ++- test/compiler/basic/run.t | 26 +++++++++++++------------- test/compiler/exit_code/run.t | 2 +- test/compiler/long_file/run.t | 2 +- 10 files changed, 57 insertions(+), 44 deletions(-) diff --git a/compiler/fcc.ml b/compiler/fcc.ml index dd990ad3..55c77d4b 100644 --- a/compiler/fcc.ml +++ b/compiler/fcc.ml @@ -3,14 +3,15 @@ open Cmdliner open Fcc_lib let fcc_main int_backend roots display debug plugins files coqlib coqcorelib - ocamlpath rload_path load_path require_libraries no_vo max_errors - coq_diags_level = + findlib_config ocamlpath rload_path load_path require_libraries no_vo + max_errors coq_diags_level = let vo_load_path = rload_path @ load_path in let ml_include_path = [] in let args = [] in let cmdline = { Coq.Workspace.CmdLine.coqlib ; coqcorelib + ; findlib_config ; ocamlpath ; vo_load_path ; ml_include_path @@ -100,8 +101,8 @@ let fcc_cmd : int Cmd.t = let open Coq.Args in Term.( const fcc_main $ int_backend $ roots $ display $ debug $ plugins $ file - $ coqlib $ coqcorelib $ ocamlpath $ rload_paths $ qload_paths $ ri_from - $ no_vo $ max_errors $ coq_diags_level) + $ coqlib $ coqcorelib $ findlib_config $ ocamlpath $ rload_paths + $ qload_paths $ ri_from $ no_vo $ max_errors $ coq_diags_level) in let exits = Exit_codes.[ fatal; stopped; scheduled; uri_failed ] in Cmd.(v (Cmd.info "fcc" ~exits ~version ~doc ~man) fcc_term) diff --git a/controller/coq_lsp.ml b/controller/coq_lsp.ml index fe410bd2..6f2909ab 100644 --- a/controller/coq_lsp.ml +++ b/controller/coq_lsp.ml @@ -80,8 +80,8 @@ let rec lsp_init_loop ~io ~ifn ~ofn ~cmdline ~debug = L.trace "read_request" "error: %s" err; lsp_init_loop ~io ~ifn ~ofn ~cmdline ~debug -let lsp_main bt coqcorelib coqlib ocamlpath vo_load_path ml_include_path - require_libraries delay int_backend = +let lsp_main bt coqcorelib coqlib findlib_config ocamlpath vo_load_path + ml_include_path require_libraries delay int_backend = Coq.Limits.select_best int_backend; Coq.Limits.start (); @@ -113,6 +113,7 @@ let lsp_main bt coqcorelib coqlib ocamlpath vo_load_path ml_include_path let cmdline = { Coq.Workspace.CmdLine.coqcorelib ; coqlib + ; findlib_config ; ocamlpath ; vo_load_path ; ml_include_path @@ -199,8 +200,8 @@ let lsp_cmd : unit Cmd.t = v (Cmd.info "coq-lsp" ~version:Fleche.Version.server ~doc ~man) Term.( - const lsp_main $ bt $ coqcorelib $ coqlib $ ocamlpath $ vo_load_path - $ ml_include_path $ ri_from $ delay $ int_backend)) + const lsp_main $ bt $ coqcorelib $ coqlib $ findlib_config $ ocamlpath + $ vo_load_path $ ml_include_path $ ri_from $ delay $ int_backend)) let main () = let ecode = Cmd.eval lsp_cmd in diff --git a/coq/args.ml b/coq/args.ml index 0d7ddd99..d118ef13 100644 --- a/coq/args.ml +++ b/coq/args.ml @@ -24,10 +24,17 @@ let coqcorelib = & opt string (Filename.concat Coq_config.coqlib "../coq-core/") & info [ "coqcorelib" ] ~docv:"COQCORELIB" ~doc) +let findlib_config = + let doc = "Override findlib's config file" in + Arg.( + value + & opt (some string) None + & info [ "findlib_config" ] ~docv:"OCAMLFIND_CONF" ~doc) + let ocamlpath = - let doc = "Path to OCaml's lib" in + let doc = "Extra Paths to OCaml's libraries" in Arg.( - value & opt (some string) None & info [ "ocamlpath" ] ~docv:"OCAMLPATH" ~doc) + value & opt (list string) [] & info [ "ocamlpath" ] ~docv:"OCAMLPATH" ~doc) let coq_lp_conv ~implicit (unix_path, lp) = { Loadpath.coq_path = Libnames.dirpath_of_string lp diff --git a/coq/args.mli b/coq/args.mli index 0181d2e8..821148ab 100644 --- a/coq/args.mli +++ b/coq/args.mli @@ -9,7 +9,8 @@ open Cmdliner val coqlib : String.t Term.t val coqcorelib : String.t Term.t -val ocamlpath : String.t option Term.t +val findlib_config : String.t option Term.t +val ocamlpath : String.t list Term.t val rload_paths : Loadpath.vo_path List.t Term.t val qload_paths : Loadpath.vo_path List.t Term.t val debug : Bool.t Term.t diff --git a/coq/workspace.ml b/coq/workspace.ml index 3aa2b62a..365e29d7 100644 --- a/coq/workspace.ml +++ b/coq/workspace.ml @@ -68,7 +68,8 @@ end type t = { coqlib : string ; coqcorelib : string - ; ocamlpath : string option + ; findlib_config : string option + ; ocamlpath : string list ; vo_load_path : Loadpath.vo_path list ; ml_include_path : string list ; require_libs : Require.t list @@ -125,7 +126,8 @@ module CmdLine = struct type t = { coqlib : string ; coqcorelib : string - ; ocamlpath : string option + ; findlib_config : string option + ; ocamlpath : string list ; vo_load_path : Loadpath.vo_path list ; ml_include_path : string list ; args : string list @@ -140,6 +142,7 @@ let mk_require_from (from, library) = let make ~cmdline ~implicit ~kind ~debug = let { CmdLine.coqcorelib ; coqlib + ; findlib_config ; ocamlpath ; args ; ml_include_path @@ -178,6 +181,7 @@ let make ~cmdline ~implicit ~kind ~debug = let ml_include_path = dft_ml_include_path @ ml_include_path in { coqlib ; coqcorelib + ; findlib_config ; ocamlpath ; vo_load_path ; ml_include_path @@ -196,12 +200,8 @@ let pp_load_path fmt (* This is a bit messy upstream, as -I both extends Coq loadpath and OCAMLPATH loadpath *) -let findlib_init ~ml_include_path ~ocamlpath = - let config, ocamlpath = - match ocamlpath with - | None -> (None, []) - | Some dir -> (Some (Filename.concat dir "findlib.conf"), [ dir ]) - in +let findlib_init ~ml_include_path ?findlib_config ~ocamlpath () = + let config = findlib_config in let env_ocamlpath = try [ Sys.getenv "OCAMLPATH" ] with Not_found -> [] in let env_ocamlpath = ml_include_path @ env_ocamlpath @ ocamlpath in let ocamlpathsep = if Sys.unix then ":" else ";" in @@ -211,6 +211,7 @@ let findlib_init ~ml_include_path ~ocamlpath = let describe { coqlib ; coqcorelib + ; findlib_config ; ocamlpath ; kind ; vo_load_path @@ -226,14 +227,10 @@ let describe in let n_vo = List.length vo_load_path in let n_ml = List.length ml_include_path in - let ocamlpath_msg = - Option.cata - (fun op -> "was overrident to " ^ op) - "wasn't overriden" ocamlpath - in + let ocamlpath_msg = "added paths: [" ^ String.concat "|" ocamlpath ^ "]" in (* We need to do this in order for the calls to Findlib to make sense, but really need to modify this *) - findlib_init ~ml_include_path ~ocamlpath; + findlib_init ~ml_include_path ?findlib_config ~ocamlpath (); let fl_packages = Findlib.list_packages' () in let fl_config = Findlib.config_file () in let fl_location = Findlib.default_location () in @@ -311,6 +308,7 @@ let dirpath_of_uri ~uri = let apply ~intern ~uri { coqlib = _ ; coqcorelib = _ + ; findlib_config ; ocamlpath ; vo_load_path ; ml_include_path @@ -324,7 +322,7 @@ let apply ~intern ~uri Flags.apply flags; Warning.apply warnings; List.iter Mltop.add_ml_dir ml_include_path; - findlib_init ~ml_include_path ~ocamlpath; + findlib_init ~ml_include_path ?findlib_config ~ocamlpath (); List.iter Loadpath.add_vo_path vo_load_path; Declaremods.start_library (dirpath_of_uri ~uri); load_objs ~intern require_libs diff --git a/coq/workspace.mli b/coq/workspace.mli index fe66abbc..4495ff07 100644 --- a/coq/workspace.mli +++ b/coq/workspace.mli @@ -46,7 +46,10 @@ end type t = private { coqlib : string ; coqcorelib : string - ; ocamlpath : string option + ; findlib_config : + string option (* Path to findlib config file, if [None], default *) + ; ocamlpath : + string list (* extra ocamlpath paths, for example for local plugins *) ; vo_load_path : Loadpath.vo_path list (** List of -R / -Q flags passed to Coq, usually theories we depend on *) ; ml_include_path : string list @@ -78,7 +81,8 @@ module CmdLine : sig type t = { coqlib : string ; coqcorelib : string - ; ocamlpath : string option + ; findlib_config : string option + ; ocamlpath : string list ; vo_load_path : Loadpath.vo_path list ; ml_include_path : string list ; args : string list diff --git a/petanque/json_shell/shell.ml b/petanque/json_shell/shell.ml index 3d4324b4..eb9f71b5 100644 --- a/petanque/json_shell/shell.ml +++ b/petanque/json_shell/shell.ml @@ -6,7 +6,8 @@ let init_coq ~debug = let cmdline : Coq.Workspace.CmdLine.t = { coqlib = Coq_config.coqlib ; coqcorelib = Filename.concat Coq_config.coqlib "../coq-core" - ; ocamlpath = None + ; findlib_config = None + ; ocamlpath = [] ; vo_load_path = [] ; ml_include_path = [] ; args = [] diff --git a/test/compiler/basic/run.t b/test/compiler/basic/run.t index 7f39aa5c..53db111d 100644 --- a/test/compiler/basic/run.t +++ b/test/compiler/basic/run.t @@ -8,7 +8,7 @@ Describe the project + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] @@ -19,7 +19,7 @@ Compile a single file, don't generate a `.vo` file: + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/a.v @@ -35,7 +35,7 @@ Compile a single file, generate a .vo file + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/a.v @@ -55,7 +55,7 @@ Compile a dependent file + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/b.v @@ -75,7 +75,7 @@ Compile both files + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/a.v @@ -96,7 +96,7 @@ Compile a dependent file without the dep being built + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/b.v @@ -133,7 +133,7 @@ Compile a file with all messages: + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/a.v @@ -144,7 +144,7 @@ Compile a file with all messages: + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/a.v @@ -174,7 +174,7 @@ Use two workspaces + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] Configuration loaded from Command-line arguments @@ -182,7 +182,7 @@ Use two workspaces + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/a.v @@ -199,7 +199,7 @@ Load the example plugin + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/a.v @@ -212,7 +212,7 @@ Load the astdump plugin + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/a.v @@ -237,7 +237,7 @@ We do the same for the goaldump plugin: + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file proj1/a.v diff --git a/test/compiler/exit_code/run.t b/test/compiler/exit_code/run.t index d27c7722..1c4fd420 100644 --- a/test/compiler/exit_code/run.t +++ b/test/compiler/exit_code/run.t @@ -9,7 +9,7 @@ Describe the environment: + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 3 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] diff --git a/test/compiler/long_file/run.t b/test/compiler/long_file/run.t index 83302ca7..d7e0a468 100644 --- a/test/compiler/long_file/run.t +++ b/test/compiler/long_file/run.t @@ -12,7 +12,7 @@ We now compile the challenging file: + coqcorelib is at: [TEST_PATH] - Modules [Stdlib.Init.Prelude] will be loaded by default - 2 Coq path directory bindings in scope; 27 Coq plugin directory bindings in scope - - ocamlpath wasn't overriden + - ocamlpath added paths: [] + findlib config: [TEST_PATH] + findlib default location: [TEST_PATH] [message] compiling file ./test.v From 97602487f1c56ccc95c8e2c5d0aa056f8dfbb1d3 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Fri, 27 Sep 2024 00:43:19 +0200 Subject: [PATCH 23/38] [coq] [init] Allow init to tweak VM mode and warnings. Taken from #433, it is very useful there to run with a disabled VM. --- compiler/driver.ml | 3 ++- controller/coq_lsp.ml | 3 ++- coq/init.ml | 7 ++++++- coq/init.mli | 2 ++ petanque/json_shell/shell.ml | 3 ++- 5 files changed, 14 insertions(+), 4 deletions(-) diff --git a/compiler/driver.ml b/compiler/driver.ml index 08bd8e18..fb2da9de 100644 --- a/compiler/driver.ml +++ b/compiler/driver.ml @@ -2,7 +2,8 @@ let coq_init ~debug = let load_module = Dynlink.loadfile in let load_plugin = Coq.Loader.plugin_handler None in - Coq.Init.(coq_init { debug; load_module; load_plugin }) + let vm, warnings = (true, None) in + Coq.Init.(coq_init { debug; load_module; load_plugin; vm; warnings }) let replace_test_path exp message = let home_re = Str.regexp (exp ^ ".*$") in diff --git a/controller/coq_lsp.ml b/controller/coq_lsp.ml index 6f2909ab..aeaebb46 100644 --- a/controller/coq_lsp.ml +++ b/controller/coq_lsp.ml @@ -63,7 +63,8 @@ let concise_cb ofn = let coq_init ~debug = let load_module = Dynlink.loadfile in let load_plugin = Coq.Loader.plugin_handler None in - Coq.Init.(coq_init { debug; load_module; load_plugin }) + let vm, warnings = (true, None) in + Coq.Init.(coq_init { debug; load_module; load_plugin; vm; warnings }) let exit_notification = Lsp.Base.Message.(Notification { method_ = "exit"; params = [] }) diff --git a/coq/init.ml b/coq/init.ml index b91c47c1..3eaeaf4f 100644 --- a/coq/init.ml +++ b/coq/init.ml @@ -23,6 +23,8 @@ type coq_opts = ; load_plugin : Mltop.PluginSpec.t -> unit (** callback to load findlib packages *) ; debug : bool (** Enable Coq Debug mode *) + ; vm : bool (** Enable Coq's VM *) + ; warnings : string option (** Coq's Warnings *) } let coq_lvl_to_severity (lvl : Feedback.level) = @@ -46,7 +48,7 @@ let mk_fb_handler q Feedback.{ contents; _ } = let coq_init opts = (* Core Coq initialization *) Lib.init (); - Global.set_impredicative_set false; + Global.set_VM opts.vm; Global.set_native_compiler false; if opts.debug then CDebug.set_flags "backtrace"; @@ -70,6 +72,9 @@ let coq_init opts = in Mltop.set_top ser_mltop; + (* Maybe set warnings *) + Option.iter CWarnings.set_flags opts.warnings; + (* This should go away in Coq itself *) Safe_typing.allow_delayed_constants := true; diff --git a/coq/init.mli b/coq/init.mli index a0720aea..e9822255 100644 --- a/coq/init.mli +++ b/coq/init.mli @@ -23,6 +23,8 @@ type coq_opts = ; load_plugin : Mltop.PluginSpec.t -> unit (** callback to load findlib packages *) ; debug : bool (** Enable Coq Debug mode *) + ; vm : bool (** Enable Coq's VM *) + ; warnings : string option (** Coq's Warnings *) } val coq_init : coq_opts -> State.t diff --git a/petanque/json_shell/shell.ml b/petanque/json_shell/shell.ml index eb9f71b5..a9dccdb4 100644 --- a/petanque/json_shell/shell.ml +++ b/petanque/json_shell/shell.ml @@ -1,7 +1,8 @@ let init_coq ~debug = let load_module = Dynlink.loadfile in let load_plugin = Coq.Loader.plugin_handler None in - Coq.Init.(coq_init { debug; load_module; load_plugin }) + let vm, warnings = (true, None) in + Coq.Init.(coq_init { debug; load_module; load_plugin; vm; warnings }) let cmdline : Coq.Workspace.CmdLine.t = { coqlib = Coq_config.coqlib From c9c974ed1dfc01890611dbdc7dcb19142df93871 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Tue, 31 Jan 2023 16:58:27 +0100 Subject: [PATCH 24/38] [controller] [js] Initial javascript JSSO coq-lsp controller Bootstrapped and working! DONE: - interrupt support - 32bit compilation without hacks - CI + artifact TODO: minimal package manager: + try to load .vo files + hand write dune files for cma and coq-pkg for the prelude + bind jszip or some other zip lib + fetch package prelude.coq-pkg, unzip and register TODOS: - WASM - Package manager (v3) - jsCoq SDK (v2) --- CONTRIBUTING.md | 5 + Makefile | 10 + controller-js/README.md | 10 + controller-js/coq_lsp_worker.ml | 181 +++++++++++ controller-js/coq_lsp_worker.mli | 0 controller-js/dune | 59 ++++ controller-js/js_stub/coq_perf.js | 17 + controller-js/js_stub/coq_vm.js | 296 +++++++++++++++++ controller-js/js_stub/interrupt.js | 27 ++ controller-js/js_stub/marshal32.js | 4 + controller-js/js_stub/marshal64.js | 206 ++++++++++++ controller-js/js_stub/mutex.js | 93 ++++++ controller-js/js_stub/unix.js | 502 +++++++++++++++++++++++++++++ editor/code/src/browser.ts | 72 ++++- examples/documentSymbol.v | 2 +- flake.nix | 2 +- 16 files changed, 1479 insertions(+), 7 deletions(-) create mode 100644 controller-js/README.md create mode 100644 controller-js/coq_lsp_worker.ml create mode 100644 controller-js/coq_lsp_worker.mli create mode 100644 controller-js/dune create mode 100644 controller-js/js_stub/coq_perf.js create mode 100644 controller-js/js_stub/coq_vm.js create mode 100644 controller-js/js_stub/interrupt.js create mode 100644 controller-js/js_stub/marshal32.js create mode 100644 controller-js/js_stub/marshal64.js create mode 100644 controller-js/js_stub/mutex.js create mode 100644 controller-js/js_stub/unix.js diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index d49232c5..8255adc7 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -255,6 +255,11 @@ ideal would be for LSP clients to catch up and allow UTF-8 encodings (so no conversion is needed, at least for Coq), but it seems that we will take a while to get to this point. +## Worker version (and debugging tips) + +See https://github.com/ocsigen/js_of_ocaml/issues/410 for debugging +tips with `js_of_ocaml`. + ## Client guide (VS Code Extension) The VS Code extension is setup as a standard `npm` Typescript + React package diff --git a/Makefile b/Makefile index 90201847..ec08903c 100644 --- a/Makefile +++ b/Makefile @@ -47,6 +47,8 @@ build-all: coq_boot vendor/coq: $(error Submodules not initialized, please do "make submodules-init") +COQVM=yes + # We set -libdir due to a Coq bug on win32, see # https://github.com/coq/coq/pull/17289 , this can be removed once we # drop support for Coq 8.16 @@ -55,6 +57,7 @@ vendor/coq/config/coq_config.ml: vendor/coq && cd vendor/coq \ && ./configure -no-ask -prefix "$$EPATH/_build/install/default/" \ -libdir "$$EPATH/_build/install/default/lib/coq" \ + -bytecode-compiler $(COQVM) \ -native-compiler no \ && cp theories/dune.disabled theories/dune \ && cp user-contrib/Ltac2/dune.disabled user-contrib/Ltac2/dune @@ -72,6 +75,13 @@ winconfig: && cp theories/dune.disabled theories/dune \ && cp user-contrib/Ltac2/dune.disabled user-contrib/Ltac2/dune + +.PHONY: js +js: COQVM = no +js: coq_boot + dune build --profile=release controller-js/coq_lsp_worker.bc.cjs + mkdir -p editor/code/out/ && cp -a controller-js/coq_lsp_worker.bc.cjs editor/code/out/coq_lsp_worker.bc.js + .PHONY: coq_boot coq_boot: vendor/coq/config/coq_config.ml diff --git a/controller-js/README.md b/controller-js/README.md new file mode 100644 index 00000000..6b2ec291 --- /dev/null +++ b/controller-js/README.md @@ -0,0 +1,10 @@ +## coq-lsp Web Worker README + +This directory contains the implementation of our LSP-compliant web +worker for Coq / coq-lsp. + +As you can see the implementation is minimal, thanks to proper +abstraction of the core of the controller. + +For now it is only safe to use the worker in 32bit OCaml mode. + diff --git a/controller-js/coq_lsp_worker.ml b/controller-js/coq_lsp_worker.ml new file mode 100644 index 00000000..91e19577 --- /dev/null +++ b/controller-js/coq_lsp_worker.ml @@ -0,0 +1,181 @@ +(* Coq JavaScript API. + * + * Copyright (C) 2016-2019 Emilio J. Gallego Arias, Mines ParisTech, Paris. + * Copyright (C) 2018-2023 Shachar Itzhaky, Technion + * Copyright (C) 2019-2023 Emilio J. Gallego Arias, INRIA + * LICENSE: GPLv3+ + * + * We provide a message-based asynchronous API for communication with + * Coq. + *) + +module U = Yojson.Safe.Util +module LSP = Lsp.Base +open Js_of_ocaml +open Controller + +let rec obj_to_json (cobj : < .. > Js.t) : Yojson.Safe.t = + let open Js in + let open Js.Unsafe in + let typeof_cobj = to_string (typeof cobj) in + match typeof_cobj with + | "string" -> `String (to_string @@ coerce cobj) + | "boolean" -> `Bool (to_bool @@ coerce cobj) + | "number" -> `Int (int_of_float @@ float_of_number @@ coerce cobj) + | _ -> + if instanceof cobj array_empty then + `List Array.(to_list @@ map obj_to_json @@ to_array @@ coerce cobj) + else if instanceof cobj Typed_array.arrayBuffer then + `String (Typed_array.String.of_arrayBuffer @@ coerce cobj) + else if instanceof cobj Typed_array.uint8Array then + `String (Typed_array.String.of_uint8Array @@ coerce cobj) + else + let json_string = Js.to_string (Json.output cobj) in + Yojson.Safe.from_string json_string + +let rec json_to_obj (cobj : < .. > Js.t) (json : Yojson.Safe.t) : < .. > Js.t = + let open Js.Unsafe in + let ofresh j = json_to_obj (obj [||]) j in + match json with + | `Bool b -> coerce @@ Js.bool b + | `Null -> pure_js_expr "null" + | `Assoc l -> + List.iter (fun (p, js) -> set cobj p (ofresh js)) l; + cobj + | `List l -> Array.(Js.array @@ map ofresh (of_list l)) + | `Float f -> coerce @@ Js.number_of_float f + | `String s -> coerce @@ Js.string s + | `Int m -> coerce @@ Js.number_of_float (float_of_int m) + | `Intlit s -> coerce @@ Js.number_of_float (float_of_string s) + | `Tuple t -> Array.(Js.array @@ map ofresh (of_list t)) + | `Variant (_, _) -> pure_js_expr "undefined" + +let findlib_conf = "\ndestdir=\"/static/lib\"path=\"/static/lib\"" +let findlib_path = "/static/lib/findlib.conf" + +let setup_pseudo_fs () = + (* '/static' is the default working directory of jsoo *) + Sys_js.create_file ~name:findlib_path ~content:findlib_conf; + () + +let setup_std_printers () = + Sys_js.set_channel_flusher stdout (Fleche.Io.Log.trace "stdout" "%s"); + Sys_js.set_channel_flusher stderr (Fleche.Io.Log.trace "stderr" "%s"); + () + +let post_message (msg : Lsp.Base.Message.t) = + let json = Lsp.Base.Message.to_yojson msg in + let js = json_to_obj (Js.Unsafe.obj [||]) json in + Worker.post_message js + +type opaque + +external interrupt_setup : opaque (* Uint32Array *) -> unit = "interrupt_setup" + +let interrupt_is_setup = ref false + +let parse_msg msg = + if Js.instanceof msg Js.array_length then ( + let _method_ = Js.array_get msg 0 in + let handle = Js.array_get msg 1 |> Obj.magic in + interrupt_setup handle; + interrupt_is_setup := true; + Error "processed interrupt_setup") + else obj_to_json msg |> Lsp.Base.Message.of_yojson + +let on_msg msg = + match parse_msg msg with + | Error _ -> + Lsp.Io.logMessage ~lvl:Lsp.Io.Lvl.Error + ~message:"Error in JSON RPC Message Parsing" + | Ok msg -> + (* Lsp.Io.trace "interrupt_setup" (string_of_bool !interrupt_is_setup); *) + Lsp_core.enqueue_message msg + +let setTimeout cb d = Dom_html.setTimeout cb d + +module CB = Controller.Lsp_core.CB (struct + let ofn n = Lsp.Base.Message.notification n |> post_message +end) + +let rec process_queue ~state () = + match + Lsp_core.dispatch_or_resume_check ~io:CB.cb ~ofn:post_message ~state + with + | None -> + Fleche.Io.Log.trace "proccess queue" "ended"; + () + | Some (Yield state) -> ignore (setTimeout (process_queue ~state) 0.1) + (* We need to yield so [on_msg] above has the chance to run and add the + command(s) to the queue. *) + | Some (Cont state) -> ignore (setTimeout (process_queue ~state) 0.) + +let on_init ~io ~root_state ~cmdline ~debug msg = + match parse_msg msg with + | Error _ -> () + | Ok msg -> ( + match + Lsp_core.lsp_init_process ~ofn:post_message ~io ~cmdline ~debug msg + with + | Lsp_core.Init_effect.Exit -> (* XXX: bind to worker.close () *) () + | Lsp_core.Init_effect.Loop -> () + | Lsp_core.Init_effect.Success workspaces -> + Worker.set_onmessage on_msg; + let default_workspace = Coq.Workspace.default ~debug ~cmdline in + let state = + { Lsp_core.State.root_state; cmdline; workspaces; default_workspace } + in + ignore (setTimeout (process_queue ~state) 0.1)) + +let coq_init ~debug = + let load_module = Dynlink.loadfile in + let load_plugin = Coq.Loader.plugin_handler None in + (* XXX: Fixme at some point? *) + let vm, warnings = (false, Some "-vm-compute-disabled") in + Coq.Init.(coq_init { debug; load_module; load_plugin; vm; warnings }) + +external coq_vm_trap : unit -> unit = "coq_vm_trap" + +(* This code is executed on Worker initialization *) +let main () = + (* This is needed if dynlink is enabled in 4.03.0 *) + Sys.interactive := false; + + Coq.Limits.(select Coq); + Coq.Limits.start (); + + setup_pseudo_fs (); + setup_std_printers (); + + (* setup_interp (); *) + coq_vm_trap (); + + Lsp.Io.set_log_fn (fun n -> Lsp.Base.Message.notification n |> post_message); + let io = CB.cb in + Fleche.Io.CallBack.set io; + + let stdlib = + let unix_path = "/static/coq/theories/" in + let coq_path = Names.(DirPath.make [ Id.of_string "Coq" ]) in + Loadpath. + { unix_path; coq_path; implicit = true; has_ml = false; recursive = true } + in + + let cmdline = + Coq.Workspace.CmdLine. + { coqlib = "/static/coqlib" + ; coqcorelib = "/static/lib/coq-core" + ; findlib_config = Some findlib_path + ; ocamlpath = [] + ; vo_load_path = [ stdlib ] + ; ml_include_path = [] + ; require_libraries = [] + ; args = [ "-noinit" ] + } + in + let debug = true in + let root_state = coq_init ~debug in + Worker.set_onmessage (on_init ~io ~root_state ~cmdline ~debug); + () + +let () = main () diff --git a/controller-js/coq_lsp_worker.mli b/controller-js/coq_lsp_worker.mli new file mode 100644 index 00000000..e69de29b diff --git a/controller-js/dune b/controller-js/dune new file mode 100644 index 00000000..af7826f5 --- /dev/null +++ b/controller-js/dune @@ -0,0 +1,59 @@ +(executable + (name coq_lsp_worker) + (modes js) + (preprocess + (pps js_of_ocaml-ppx)) + (js_of_ocaml + (javascript_files + js_stub/mutex.js + js_stub/unix.js + js_stub/coq_vm.js + js_stub/coq_perf.js + js_stub/interrupt.js + marshal-arch.js) + (flags + :standard + --dynlink + +dynlink.js + ; (:include .extraflags) + ; +toplevel.js + ; --enable + ; with-js-error + ; --enable + ; debuginfo + ; --no-inline + ; --debug-info + ; --source-map + ; no coq-fs yet + ; --file=coq-fs + --setenv + PATH=/bin)) + (link_flags -linkall -no-check-prims) + ; The old makefile set: -noautolink -no-check-prims + (libraries zarith_stubs_js yojson controller)) + +(rule + (target coq_lsp_worker.bc.cjs) + (mode promote) + (action + (copy coq_lsp_worker.bc.js coq_lsp_worker.bc.cjs))) + +(rule + (targets marshal-arch.js) + ; This is to inject the dep of a FS on the executable if we want. + ; (deps coq-fs) + (action + (copy js_stub/marshal%{ocaml-config:word_size}.js %{targets}))) + +; Set debug flags if JSCOQ_DEBUG environment variable is set. +; (ugly, but there are no conditional expressions in Dune) + +(rule + (targets .extraflags) + (deps + (env_var JSCOQ_DEBUG)) + (action + (with-stdout-to + %{targets} + (bash + "echo '(' ${JSCOQ_DEBUG+ --pretty --noinline --disable shortvar --debug-info} ')'")))) diff --git a/controller-js/js_stub/coq_perf.js b/controller-js/js_stub/coq_perf.js new file mode 100644 index 00000000..41ba8c4c --- /dev/null +++ b/controller-js/js_stub/coq_perf.js @@ -0,0 +1,17 @@ +//Provides: CAML_init +function CAML_init() { + return; +} + +//Provides: CAML_peek +//Requires: caml_int64_of_int32 +function CAML_peek() { + return caml_int64_of_int32(0); +} + + +//Provides: CAML_drop +function CAML_drop() { + return; +} + diff --git a/controller-js/js_stub/coq_vm.js b/controller-js/js_stub/coq_vm.js new file mode 100644 index 00000000..cf86e905 --- /dev/null +++ b/controller-js/js_stub/coq_vm.js @@ -0,0 +1,296 @@ +// Provides: vm_ll +function vm_ll(s, args) { + if (vm_ll.log) joo_global_object.console.warn(s, args); + if (vm_ll.trap) throw new Error("vm trap: '"+ s + "' not implemented"); +} + +vm_ll.log = false; // whether to log calls +vm_ll.trap = false; // whether to halt on calls + +// Provides: init_coq_vm +// Requires: vm_ll +function init_coq_vm() { + vm_ll('init_coq_vm', arguments); + return; +} + +// EG: Coq VM's code is evil and performs static initialization... the +// best option would be to disable the VM code entirely as before. + +// Provides: coq_vm_trap +// Requires: vm_ll +function coq_vm_trap() { // will cause future calls to vm code to fault + vm_ll.log = vm_ll.trap = true; // (called after initialization) +} + +// Provides: accumulate_code +// Requires: vm_ll +function accumulate_code() { + // EG: Where the hell is that called from + vm_ll('accumulate_code', arguments); + return []; +} + +// Provides: coq_pushpop +// Requires: vm_ll +function coq_pushpop() { + vm_ll('coq_pushpop', arguments); + return []; +} + +// Provides: coq_closure_arity +// Requires: vm_ll +function coq_closure_arity() { + vm_ll('coq_closure_arity', arguments); + return []; +} + +// Provides: coq_eval_tcode +// Requires: vm_ll +function coq_eval_tcode() { + vm_ll('coq_eval_tcode', arguments); + return []; +} + +// Provides: coq_int_tcode +// Requires: vm_ll +function coq_int_tcode() { + vm_ll('coq_int_tcode', arguments); + return []; +} + +// Provides: coq_interprete_ml +// Requires: vm_ll +function coq_interprete_ml() { + vm_ll('coq_interprete_ml', arguments); + return []; +} + +// Provides: coq_is_accumulate_code +// Requires: vm_ll +function coq_is_accumulate_code() { + vm_ll('coq_is_accumulate_code', arguments); + return []; +} + +// Provides: coq_kind_of_closure +// Requires: vm_ll +function coq_kind_of_closure() { + vm_ll('coq_kind_of_closure', arguments); + return []; +} + +// Provides: coq_makeaccu +// Requires: vm_ll +function coq_makeaccu() { + vm_ll('coq_makeaccu', arguments); + return []; +} + +// Provides: coq_offset +// Requires: vm_ll +function coq_offset() { + vm_ll('coq_offset', arguments); + return []; +} + +// Provides: coq_offset_closure +// Requires: vm_ll +function coq_offset_closure() { + vm_ll('coq_offset_closure', arguments); + return []; +} + +// Provides: coq_offset_tcode +// Requires: vm_ll +function coq_offset_tcode() { + vm_ll('coq_offset_tcode', arguments); + return []; +} + +// Provides: coq_push_arguments +// Requires: vm_ll +function coq_push_arguments() { + vm_ll('coq_push_arguments', arguments); + return []; +} + +// Provides: coq_push_ra +// Requires: vm_ll +function coq_push_ra() { + vm_ll('coq_push_ra', arguments); + return []; +} + +// Provides: coq_push_val +// Requires: vm_ll +function coq_push_val() { + vm_ll('coq_push_val', arguments); + return []; +} + +// Provides: coq_push_vstack +// Requires: vm_ll +function coq_push_vstack() { + vm_ll('coq_push_vstack', arguments); + return []; +} + +// Provides: coq_set_transp_value +// Requires: vm_ll +function coq_set_transp_value() { + vm_ll('coq_set_transp_value', arguments); + return []; +} + +// Provides: coq_set_bytecode_field +// Requires: vm_ll +function coq_set_bytecode_field() { + vm_ll('coq_set_bytecode_field', arguments); + return [0]; +} + +// Provides: coq_tcode_of_code +// Requires: vm_ll +function coq_tcode_of_code() { + vm_ll('coq_tcode_of_code', arguments); + return []; +} + +// Provides: coq_accumulate +// Requires: vm_ll +function coq_accumulate() { + // This is called on init, so let's be more lenient + // vm_ll('coq_accumulate', arguments); + return []; +} + +// Provides: coq_obj_set_tag +// Requires: vm_ll +function coq_obj_set_tag() { + vm_ll('coq_obj_set_tag', arguments); + return []; +} + +// Provides: coq_uint63_to_float_byte +// Requires: vm_ll +function coq_uint63_to_float_byte() { + // First element of the array is the length! + vm_ll('coq_uint63_to_float_byte', arguments); + return [0]; +} + +// Provides: get_coq_atom_tbl +// Requires: vm_ll +function get_coq_atom_tbl() { + // First element of the array is the length! + vm_ll('get_coq_atom_tbl', arguments); + return [0]; +} + +// Provides: get_coq_global_data +// Requires: vm_ll +function get_coq_global_data() { + vm_ll('get_coq_global_data', arguments); + return []; +} + +// Provides: get_coq_transp_value +// Requires: vm_ll +function get_coq_transp_value() { + vm_ll('get_coq_transp_value', arguments); + return []; +} + +// Provides: realloc_coq_atom_tbl +// Requires: vm_ll +function realloc_coq_atom_tbl() { + vm_ll('realloc_coq_atom_tbl', arguments); + return; +} + +// Provides: realloc_coq_global_data +// Requires: vm_ll +function realloc_coq_global_data() { + vm_ll('realloc_coq_global_data', arguments); + return; +} + +// Provides: coq_interprete_byte +// Requires: vm_ll +function coq_interprete_byte() { vm_ll('coq_interprete_byte', arguments); } +// Provides: coq_set_drawinstr +// Requires: vm_ll +function coq_set_drawinstr() { vm_ll('coq_set_drawinstr', arguments); } +// Provides: coq_tcode_array +// Requires: vm_ll +function coq_tcode_array() { vm_ll('coq_tcode_array', arguments); } + +// Provides: coq_fadd_byte +function coq_fadd_byte(r1, r2) { + return r1 + r2; +} + +// Provides: coq_fsub_byte +function coq_fsub_byte(r1, r2) { + return r1 - r2; +} + +// Provides: coq_fmul_byte +function coq_fmul_byte(r1, r2) { + return r1 * r2; +} + +// Provides: coq_fdiv_byte +function coq_fdiv_byte(r1, r2) { + return r1 / r2; +} + +// Provides: coq_fsqrt_byte +// Requires: vm_ll +function coq_fsqrt_byte() { + vm_ll('coq_fsqrt_byte', arguments); + return; +} + +// Provides: coq_is_double +// Requires: vm_ll + function coq_is_double() { + vm_ll('coq_is_double', arguments); + return; +} + +// Provides: coq_next_down_byte +// Requires: vm_ll + function coq_next_down_byte() { + vm_ll('coq_next_down_byte', arguments); + return; +} + +// Provides: coq_next_up_byte +// Requires: vm_ll + function coq_next_up_byte() { + vm_ll('coq_next_up_byte', arguments); + return; +} + +// Provides: coq_current_fix +// Requires: vm_ll +function coq_current_fix() { + vm_ll('coq_current_fix', arguments); + return []; +} + +// Provides: coq_last_fix +// Requires: vm_ll +function coq_last_fix() { + vm_ll('coq_last_fix', arguments); + return []; +} + +// Provides: coq_shift_fix +// Requires: vm_ll +function coq_shift_fix() { + vm_ll('coq_shift_fix', arguments); + return []; +} diff --git a/controller-js/js_stub/interrupt.js b/controller-js/js_stub/interrupt.js new file mode 100644 index 00000000..6b14c1ce --- /dev/null +++ b/controller-js/js_stub/interrupt.js @@ -0,0 +1,27 @@ +// Provides: interrupt_setup +function interrupt_setup(shmem) { + var Int32Array = joo_global_object.Int32Array, + SharedArrayBuffer = joo_global_object.SharedArrayBuffer; + + if (Int32Array && SharedArrayBuffer) { + shmem = shmem || new Int32Array(new SharedArrayBuffer(4)); + interrupt_setup.vec = shmem; + interrupt_setup.checkpoint = 0; + return shmem; + } +} + +// Provides: interrupt_pending +// Requires: interrupt_setup +function interrupt_pending() { + var Atomics = joo_global_object.Atomics; + + if (Atomics && interrupt_setup.vec) { + var ld = Atomics.load(interrupt_setup.vec, 0); + if (ld > interrupt_setup.checkpoint) { + interrupt_setup.checkpoint = ld; + return true; + } + } + return false; +} diff --git a/controller-js/js_stub/marshal32.js b/controller-js/js_stub/marshal32.js new file mode 100644 index 00000000..93a769d0 --- /dev/null +++ b/controller-js/js_stub/marshal32.js @@ -0,0 +1,4 @@ +/* (Blank) + * For 64-bit compilation, marshal64.js is selected. + * For 32-bit compilation, nothing further is required. + */ diff --git a/controller-js/js_stub/marshal64.js b/controller-js/js_stub/marshal64.js new file mode 100644 index 00000000..90b368a1 --- /dev/null +++ b/controller-js/js_stub/marshal64.js @@ -0,0 +1,206 @@ +/** + * This is a hack to circumvent a discrepancy arising when Coq is compiled + * as a 64-bit library and then passed through js_of_ocaml, resulting in + * 32-bit JavaScript code. + * As a whole, the Coq codebase makes little use of integer arithmetic and + * does not create huge arrays of more than 2^31-1 elements. An exception + * to this is hash values calculated for storing various Coq types in maps + * and hash tables and to speed up comparisons. + * Though the values themselves are meaningless, they are unfortunately + * stored in .vo files through use of the Marshal module, and lead to files + * that cannot be read back via 32-bit code. + * + * As 32-bit support is declining (e.g. the following issue relating to + * macOS builds of OCaml: https://github.com/ocaml/ocaml/issues/6900), + * there may be no escape from building 64-bit Coq, both core and libraries. + * This requires a patch to jsoo's Marshal primitive that will not throw + * when encountering a 64-bit integer. The version below truncates such + * values. It may be extremely fragile, but so far, seems to work. + */ + + +//Provides: caml_input_value_from_reader mutable +//Requires: caml_failwith +//Requires: caml_float_of_bytes, caml_custom_ops + +/*** !!! This overrides the implementation from js_of_ocaml !!! ***/ + +function caml_input_value_from_reader(reader, ofs) { + var _magic = reader.read32u () + var _block_len = reader.read32u (); + var num_objects = reader.read32u (); + var _size_32 = reader.read32u (); + var _size_64 = reader.read32u (); + var stack = []; + var intern_obj_table = (num_objects > 0)?[]:null; + var obj_counter = 0; + function intern_rec () { + var code = reader.read8u (); + if (code >= 0x40 /*cst.PREFIX_SMALL_INT*/) { + if (code >= 0x80 /*cst.PREFIX_SMALL_BLOCK*/) { + var tag = code & 0xF; + var size = (code >> 4) & 0x7; + var v = [tag]; + if (size == 0) return v; + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + stack.push(v, size); + return v; + } else + return (code & 0x3F); + } else { + if (code >= 0x20/*cst.PREFIX_SMALL_STRING */) { + var len = code & 0x1F; + var v = reader.readstr (len); + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + return v; + } else { + switch(code) { + case 0x00: //cst.CODE_INT8: + return reader.read8s (); + case 0x01: //cst.CODE_INT16: + return reader.read16s (); + case 0x02: //cst.CODE_INT32: + return reader.read32s (); + case 0x03: //cst.CODE_INT64: + reader.read32s (); return reader.read32s (); // <------------ HERE + //caml_failwith("input_value: integer too large"); // (ouch) + break; + case 0x04: //cst.CODE_SHARED8: + var offset = reader.read8u (); + return intern_obj_table[obj_counter - offset]; + case 0x05: //cst.CODE_SHARED16: + var offset = reader.read16u (); + return intern_obj_table[obj_counter - offset]; + case 0x06: //cst.CODE_SHARED32: + var offset = reader.read32u (); + return intern_obj_table[obj_counter - offset]; + case 0x08: //cst.CODE_BLOCK32: + var header = reader.read32u (); + var tag = header & 0xFF; + var size = header >> 10; + var v = [tag]; + if (size == 0) return v; + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + stack.push(v, size); + return v; + case 0x13: //cst.CODE_BLOCK64: + caml_failwith ("input_value: data block too large"); + break; + case 0x09: //cst.CODE_STRING8: + var len = reader.read8u(); + var v = reader.readstr (len); + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + return v; + case 0x0A: //cst.CODE_STRING32: + var len = reader.read32u(); + var v = reader.readstr (len); + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + return v; + case 0x0C: //cst.CODE_DOUBLE_LITTLE: + var t = new Array(8);; + for (var i = 0;i < 8;i++) t[7 - i] = reader.read8u (); + var v = caml_float_of_bytes (t); + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + return v; + case 0x0B: //cst.CODE_DOUBLE_BIG: + var t = new Array(8);; + for (var i = 0;i < 8;i++) t[i] = reader.read8u (); + var v = caml_float_of_bytes (t); + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + return v; + case 0x0E: //cst.CODE_DOUBLE_ARRAY8_LITTLE: + var len = reader.read8u(); + var v = new Array(len+1); + v[0] = 254; + var t = new Array(8);; + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + for (var i = 1;i <= len;i++) { + for (var j = 0;j < 8;j++) t[7 - j] = reader.read8u(); + v[i] = caml_float_of_bytes (t); + } + return v; + case 0x0D: //cst.CODE_DOUBLE_ARRAY8_BIG: + var len = reader.read8u(); + var v = new Array(len+1); + v[0] = 254; + var t = new Array(8);; + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + for (var i = 1;i <= len;i++) { + for (var j = 0;j < 8;j++) t[j] = reader.read8u(); + v [i] = caml_float_of_bytes (t); + } + return v; + case 0x07: //cst.CODE_DOUBLE_ARRAY32_LITTLE: + var len = reader.read32u(); + var v = new Array(len+1); + v[0] = 254; + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + var t = new Array(8);; + for (var i = 1;i <= len;i++) { + for (var j = 0;j < 8;j++) t[7 - j] = reader.read8u(); + v[i] = caml_float_of_bytes (t); + } + return v; + case 0x0F: //cst.CODE_DOUBLE_ARRAY32_BIG: + var len = reader.read32u(); + var v = new Array(len+1); + v[0] = 254; + var t = new Array(8);; + for (var i = 1;i <= len;i++) { + for (var j = 0;j < 8;j++) t[j] = reader.read8u(); + v [i] = caml_float_of_bytes (t); + } + return v; + case 0x10: //cst.CODE_CODEPOINTER: + case 0x11: //cst.CODE_INFIXPOINTER: + caml_failwith ("input_value: code pointer"); + break; + case 0x12: //cst.CODE_CUSTOM: + case 0x18: //cst.CODE_CUSTOM_LEN: + case 0x19: //cst.CODE_CUSTOM_FIXED: + var c, s = ""; + while ((c = reader.read8u ()) != 0) s += String.fromCharCode (c); + var ops = caml_custom_ops[s]; + var expected_size; + if(!ops) + caml_failwith("input_value: unknown custom block identifier"); + switch(code){ + case 0x12: // cst.CODE_CUSTOM (deprecated) + break; + case 0x19: // cst.CODE_CUSTOM_FIXED + if(!ops.fixed_length) + caml_failwith("input_value: expected a fixed-size custom block"); + expected_size = ops.fixed_length; + break; + case 0x18: // cst.CODE_CUSTOM_LEN + expected_size = reader.read32u (); + // Skip size64 + reader.read32s(); reader.read32s(); + break; + } + var old_pos = reader.i; + var size = [0]; + var v = ops.deserialize(reader, size); + if(expected_size != undefined){ + if(expected_size != size[0]) + caml_failwith("input_value: incorrect length of serialized custom block"); + } + if (intern_obj_table) intern_obj_table[obj_counter++] = v; + return v; + default: + caml_failwith ("input_value: ill-formed message"); + } + } + } + } + var res = intern_rec (); + while (stack.length > 0) { + var size = stack.pop(); + var v = stack.pop(); + var d = v.length; + if (d < size) stack.push(v, size); + v[d] = intern_rec (); + } + if (typeof ofs!="number") ofs[0] = reader.i; + return res; +} diff --git a/controller-js/js_stub/mutex.js b/controller-js/js_stub/mutex.js new file mode 100644 index 00000000..d4a9acb6 --- /dev/null +++ b/controller-js/js_stub/mutex.js @@ -0,0 +1,93 @@ +// Whether to log. +var v_log = false; +function ll(s) { if (v_log) console.log(s); } + +//Provides: caml_condition_broadcast +function caml_condition_broadcast() { + // ll("***caml_condition_broadcast"); + return 0; +} + +//Provides: caml_condition_new +function caml_condition_new() { + // ll("***caml_condition_new"); + return 0; +} + +//Provides: caml_condition_signal +function caml_condition_signal() { + // ll("***caml_condition_signal"); + return 0; +} + +//Provides: caml_condition_wait +function caml_condition_wait() { + // ll("***caml_condition_wait"); + return 0; +} + +//Provides: caml_thread_initialize +function caml_thread_initialize() { + // ll("***caml_thread_initialize"); + return 0; +} + +//Provides: caml_thread_new +function caml_thread_new() { + // ll("***caml_thread_new"); + return 0; +} + +//Provides: caml_thread_self +function caml_thread_self() { + // ll("***caml_thread_self"); + return [0,0]; +} + +//Provides: caml_thread_uncaught_exception +function caml_thread_uncaught_exception() { + // ll("***caml_thread_uncaught_exception"); + return 0; +} + +//Provides: caml_thread_yield +function caml_thread_yield() { + // ll("***caml_thread_yield"); + return 0; +} + +//Provides: caml_mutex_lock +function caml_mutex_lock() { + // ll("***caml_mutex_lock"); + return 0; +} + +//Provides: caml_mutex_new +function caml_mutex_new() { + // ll("***caml_mutex_new"); + return 0; +} + +//Provides: caml_mutex_unlock +function caml_mutex_unlock() { + // ll("***caml_mutex_unlock"); + return 0; +} + +//Provides: caml_thread_cleanup +function caml_thread_cleanup() { + // ll("***caml_thread_cleanup"); + return 0; +} + +//Provides: caml_thread_exit +function caml_thread_exit() { + // ll("***caml_thread_exit"); + return 0; +} + +//Provides: caml_thread_id +function caml_thread_id() { + // ll("***caml_thread_id"); + return 0; +} diff --git a/controller-js/js_stub/unix.js b/controller-js/js_stub/unix.js new file mode 100644 index 00000000..a606d9bb --- /dev/null +++ b/controller-js/js_stub/unix.js @@ -0,0 +1,502 @@ +//Provides: unix_ll +function unix_ll(s, args) { + if (unix_ll.log) joo_global_object.console.warn(s, args); + if (unix_ll.trap) throw new Error("unix trap: '"+ s + "' not implemented"); +} +unix_ll.log = true; // whether to log calls +unix_ll.trap = false; // whether to halt on calls + +//Provides: caml_raise_unix_error +//Requires: caml_named_value, caml_raise_with_arg, caml_new_string +function caml_raise_unix_error(msg) { + var tag = caml_named_value("Unix.Unix_error"); + // var util = require('util'); + // console.log(util.inspect(chan, {showHidden: false, depth: null})); + caml_raise_with_arg (tag, caml_new_string (msg)); +} + +//Provides: unix_access +//Requires: unix_ll +function unix_access() { + unix_ll("unix_access", arguments); + return 0; +} + +//Provides: unix_alarm +//Requires: unix_ll +function unix_alarm() { + unix_ll("unix_alarm", arguments); + return 0; +} + +//Provides: unix_bind +//Requires: unix_ll +function unix_bind() { + unix_ll("unix_bind", arguments); + return 0; +} + +//Provides: unix_close +//Requires: unix_ll +function unix_close() { + unix_ll("unix_close", arguments); + return 0; +} + +//Provides: unix_connect +//Requires: unix_ll +function unix_connect() { + unix_ll("unix_connect", arguments); + return 0; +} + +//Provides: unix_dup +//Requires: unix_ll +function unix_dup() { + unix_ll("unix_dup", arguments); + return 0; +} + +//Provides: unix_dup2 +//Requires: unix_ll +function unix_dup2() { + unix_ll("unix_dup2", arguments); + return 0; +} + +//Provides: unix_environment +//Requires: unix_ll +function unix_environment() { + unix_ll("unix_environment", arguments); + return 0; +} + +//Provides: unix_error_message +//Requires: unix_ll +function unix_error_message() { + unix_ll("unix_error_message", arguments); + return 0; +} + +//Provides: unix_execve +//Requires: unix_ll +function unix_execve() { + unix_ll("unix_execve", arguments); + return 0; +} + +//Provides: unix_execvp +//Requires: unix_ll +function unix_execvp() { + unix_ll("unix_execvp", arguments); + return 0; +} + +//Provides: unix_execvpe +//Requires: unix_ll +function unix_execvpe() { + unix_ll("unix_execvpe", arguments); + return 0; +} + +//Provides: unix_getcwd +//Requires: unix_ll +function unix_getcwd() { + unix_ll("unix_getcwd", arguments); + return 0; +} + +//Provides: unix_fork +//Requires: unix_ll +function unix_fork() { + unix_ll("unix_fork", arguments); + return 0; +} + +//Provides: unix_getpid +//Requires: unix_ll +function unix_getpid() { + unix_ll("unix_getpid", arguments); + return 0; +} + +//Provides: unix_getpwnam +//Requires: unix_ll +function unix_getpwnam() { + unix_ll("unix_getpwnam", arguments); + return 0; +} + +//Provides: unix_getsockname +//Requires: unix_ll +function unix_getsockname() { + unix_ll("unix_getsockname", arguments); + return 0; +} + +//Provides: unix_kill +//Requires: unix_ll +function unix_kill() { + unix_ll("unix_kill", arguments); + return 0; +} + +//Provides: unix_listen +//Requires: unix_ll +function unix_listen() { + unix_ll("unix_listen", arguments); + return 0; +} + +//Provides: unix_pipe +//Requires: unix_ll +function unix_pipe() { + unix_ll("unix_pipe", arguments); + return 0; +} + +//Provides: unix_read +//Requires: unix_ll +function unix_read() { + unix_ll("unix_read", arguments); + return 0; +} + +//Provides: unix_opendir +//Requires: unix_ll +function unix_opendir(dir) { + unix_ll("unix_opendir", arguments); + + // caml_raise_unix_error("opendir", arguments); + return []; +} + +//Provides: unix_readdir +//Requires: unix_ll, caml_raise_constant, caml_global_data +function unix_readdir(dir) { + unix_ll("unix_readdir", arguments); + + // caml_raise_unix_error("readdir", arguments); + caml_raise_constant(caml_global_data.End_of_file); + return []; +} + +//Provides: unix_closedir +//Requires: unix_ll +function unix_closedir() { + unix_ll("unix_closedir", arguments); + return []; +} + +//Provides: unix_select +//Requires: unix_ll +function unix_select() { + unix_ll("unix_select", arguments); + return 0; +} + +//Provides: unix_set_close_on_exec +//Requires: unix_ll +function unix_set_close_on_exec() { + unix_ll("unix_set_close_on_exec", arguments); + return 0; +} + +//Provides: unix_set_nonblock +//Requires: unix_ll +function unix_set_nonblock() { + unix_ll("unix_set_nonblock", arguments); + return 0; +} + +//Provides: unix_sleep +//Requires: unix_ll +function unix_sleep() { + unix_ll("unix_sleep", arguments); + return 0; +} + +//Provides: unix_socket +//Requires: unix_ll +function unix_socket() { + unix_ll("unix_socket", arguments); + return 0; +} + +//Provides: unix_string_of_inet_addr +//Requires: unix_ll +function unix_string_of_inet_addr() { + unix_ll("unix_string_of_inet_addr", arguments); + return 0; +} + +//Provides: unix_times +//Requires: unix_ll +function unix_times() { + unix_ll("unix_times", arguments); + return 0; +} + +//Provides: unix_wait +//Requires: unix_ll +function unix_wait() { + unix_ll("unix_wait", arguments); + return 0; +} + +//Provides: unix_waitpid +//Requires: unix_ll +function unix_waitpid() { + unix_ll("unix_waitpid", arguments); + return 0; +} + +// Provides: unix_accept +// Requires: unix_ll +function unix_accept() { unix_ll("unix_accept", arguments); } +// Provides: unix_chdir +// Requires: unix_ll +function unix_chdir() { unix_ll("unix_chdir", arguments); } +// Provides: unix_chmod +// Requires: unix_ll +function unix_chmod() { unix_ll("unix_chmod", arguments); } +// Provides: unix_chown +// Requires: unix_ll +function unix_chown() { unix_ll("unix_chown", arguments); } +// Provides: unix_chroot +// Requires: unix_ll +function unix_chroot() { unix_ll("unix_chroot", arguments); } +// Provides: unix_clear_close_on_exec +// Requires: unix_ll +function unix_clear_close_on_exec() { unix_ll("unix_clear_close_on_exec", arguments); } +// Provides: unix_clear_nonblock +// Requires: unix_ll +function unix_clear_nonblock() { unix_ll("unix_clear_nonblock", arguments); } +// Provides: unix_environment_unsafe +// Requires: unix_ll +function unix_environment_unsafe() { unix_ll("unix_environment_unsafe", arguments); } +// Provides: unix_execv +// Requires: unix_ll +function unix_execv() { unix_ll("unix_execv", arguments); } +// Provides: unix_fchmod +// Requires: unix_ll +function unix_fchmod() { unix_ll("unix_fchmod", arguments); } +// Provides: unix_fchown +// Requires: unix_ll +function unix_fchown() { unix_ll("unix_fchown", arguments); } +// Provides: unix_fstat +// Requires: unix_ll +function unix_fstat() { unix_ll("unix_fstat", arguments); } +// Provides: unix_fstat_64 +// Requires: unix_ll +function unix_fstat_64() { unix_ll("unix_fstat_64", arguments); } +// Provides: unix_ftruncate +// Requires: unix_ll +function unix_ftruncate() { unix_ll("unix_ftruncate", arguments); } +// Provides: unix_ftruncate_64 +// Requires: unix_ll +function unix_ftruncate_64() { unix_ll("unix_ftruncate_64", arguments); } +// Provides: unix_getaddrinfo +// Requires: unix_ll +function unix_getaddrinfo() { unix_ll("unix_getaddrinfo", arguments); } +// Provides: unix_getegid +// Requires: unix_ll +function unix_getegid() { unix_ll("unix_getegid", arguments); } +// Provides: unix_geteuid +// Requires: unix_ll +function unix_geteuid() { unix_ll("unix_geteuid", arguments); } +// Provides: unix_getgid +// Requires: unix_ll +function unix_getgid() { unix_ll("unix_getgid", arguments); } +// Provides: unix_getgrgid +// Requires: unix_ll +function unix_getgrgid() { unix_ll("unix_getgrgid", arguments); } +// Provides: unix_getgrnam +// Requires: unix_ll +function unix_getgrnam() { unix_ll("unix_getgrnam", arguments); } +// Provides: unix_getgroups +// Requires: unix_ll +function unix_getgroups() { unix_ll("unix_getgroups", arguments); } +// Provides: unix_gethostbyaddr +// Requires: unix_ll +function unix_gethostbyaddr() { unix_ll("unix_gethostbyaddr", arguments); } +// Provides: unix_gethostbyname +// Requires: unix_ll +function unix_gethostbyname() { unix_ll("unix_gethostbyname", arguments); } +// Provides: unix_gethostname +// Requires: unix_ll +function unix_gethostname() { unix_ll("unix_gethostname", arguments); } +// Provides: unix_getitimer +// Requires: unix_ll +function unix_getitimer() { unix_ll("unix_getitimer", arguments); } +// Provides: unix_getlogin +// Requires: unix_ll +function unix_getlogin() { unix_ll("unix_getlogin", arguments); } +// Provides: unix_getnameinfo +// Requires: unix_ll +function unix_getnameinfo() { unix_ll("unix_getnameinfo", arguments); } +// Provides: unix_getpeername +// Requires: unix_ll +function unix_getpeername() { unix_ll("unix_getpeername", arguments); } +// Provides: unix_getppid +// Requires: unix_ll +function unix_getppid() { unix_ll("unix_getppid", arguments); } +// Provides: unix_getprotobyname +// Requires: unix_ll +function unix_getprotobyname() { unix_ll("unix_getprotobyname", arguments); } +// Provides: unix_getprotobynumber +// Requires: unix_ll +function unix_getprotobynumber() { unix_ll("unix_getprotobynumber", arguments); } +// Provides: unix_getservbyname +// Requires: unix_ll +function unix_getservbyname() { unix_ll("unix_getservbyname", arguments); } +// Provides: unix_getservbyport +// Requires: unix_ll +function unix_getservbyport() { unix_ll("unix_getservbyport", arguments); } +// Provides: unix_getsockopt +// Requires: unix_ll +function unix_getsockopt() { unix_ll("unix_getsockopt", arguments); } +// Provides: unix_initgroups +// Requires: unix_ll +function unix_initgroups() { unix_ll("unix_initgroups", arguments); } +// Provides: unix_link +// Requires: unix_ll +function unix_link() { unix_ll("unix_link", arguments); } +// Provides: unix_lockf +// Requires: unix_ll +function unix_lockf() { unix_ll("unix_lockf", arguments); } +// Provides: unix_lseek +// Requires: unix_ll +function unix_lseek() { unix_ll("unix_lseek", arguments); } +// Provides: unix_lseek_64 +// Requires: unix_ll +function unix_lseek_64() { unix_ll("unix_lseek_64", arguments); } +// Provides: unix_mkfifo +// Requires: unix_ll +function unix_mkfifo() { unix_ll("unix_mkfifo", arguments); } +// Provides: unix_nice +// Requires: unix_ll +function unix_nice() { unix_ll("unix_nice", arguments); } +// Provides: unix_open +// Requires: unix_ll +function unix_open() { unix_ll("unix_open", arguments); } +// Provides: unix_putenv +// Requires: unix_ll +function unix_putenv() { unix_ll("unix_putenv", arguments); } +// Provides: unix_recv +// Requires: unix_ll +function unix_recv() { unix_ll("unix_recv", arguments); } +// Provides: unix_recvfrom +// Requires: unix_ll +function unix_recvfrom() { unix_ll("unix_recvfrom", arguments); } +// Provides: unix_rename +// Requires: unix_ll +function unix_rename() { unix_ll("unix_rename", arguments); } +// Provides: unix_rewinddir +// Requires: unix_ll +function unix_rewinddir() { unix_ll("unix_rewinddir", arguments); } +// Provides: unix_send +// Requires: unix_ll +function unix_send() { unix_ll("unix_send", arguments); } +// Provides: unix_sendto +// Requires: unix_ll +function unix_sendto() { unix_ll("unix_sendto", arguments); } +// Provides: unix_setgid +// Requires: unix_ll +function unix_setgid() { unix_ll("unix_setgid", arguments); } +// Provides: unix_setgroups +// Requires: unix_ll +function unix_setgroups() { unix_ll("unix_setgroups", arguments); } +// Provides: unix_setitimer +// Requires: unix_ll +function unix_setitimer() { unix_ll("unix_setitimer", arguments); } +// Provides: unix_setsid +// Requires: unix_ll +function unix_setsid() { unix_ll("unix_setsid", arguments); } +// Provides: unix_setsockopt +// Requires: unix_ll +function unix_setsockopt() { unix_ll("unix_setsockopt", arguments); } +// Provides: unix_setuid +// Requires: unix_ll +function unix_setuid() { unix_ll("unix_setuid", arguments); } +// Provides: unix_shutdown +// Requires: unix_ll +function unix_shutdown() { unix_ll("unix_shutdown", arguments); } +// Provides: unix_sigpending +// Requires: unix_ll +function unix_sigpending() { unix_ll("unix_sigpending", arguments); } +// Provides: unix_sigprocmask +// Requires: unix_ll +function unix_sigprocmask() { unix_ll("unix_sigprocmask", arguments); } +// Provides: unix_sigsuspend +// Requires: unix_ll +function unix_sigsuspend() { unix_ll("unix_sigsuspend", arguments); } +// Provides: unix_single_write +// Requires: unix_ll +function unix_single_write() { unix_ll("unix_single_write", arguments); } +// Provides: unix_socketpair +// Requires: unix_ll +function unix_socketpair() { unix_ll("unix_socketpair", arguments); } +// Provides: unix_tcdrain +// Requires: unix_ll +function unix_tcdrain() { unix_ll("unix_tcdrain", arguments); } +// Provides: unix_tcflow +// Requires: unix_ll +function unix_tcflow() { unix_ll("unix_tcflow", arguments); } +// Provides: unix_tcflush +// Requires: unix_ll +function unix_tcflush() { unix_ll("unix_tcflush", arguments); } +// Provides: unix_tcgetattr +// Requires: unix_ll +function unix_tcgetattr() { unix_ll("unix_tcgetattr", arguments); } +// Provides: unix_tcsendbreak +// Requires: unix_ll +function unix_tcsendbreak() { unix_ll("unix_tcsendbreak", arguments); } +// Provides: unix_tcsetattr +// Requires: unix_ll +function unix_tcsetattr() { unix_ll("unix_tcsetattr", arguments); } +// Provides: unix_truncate +// Requires: unix_ll +function unix_truncate() { unix_ll("unix_truncate", arguments); } +// Provides: unix_truncate_64 +// Requires: unix_ll +function unix_truncate_64() { unix_ll("unix_truncate_64", arguments); } +// Provides: unix_umask +// Requires: unix_ll +function unix_umask() { unix_ll("unix_umask", arguments); } +// Provides: unix_utimes +// Requires: unix_ll +function unix_utimes() { unix_ll("unix_utimes", arguments); } +// Provides: unix_write +// Requires: unix_ll +function unix_write() { unix_ll("unix_write", arguments); } +// Provides: unix_exit +// Requires: unix_ll +function unix_exit() { unix_ll("unix_exit", arguments); } +// Provides: unix_spawn +// Requires: unix_ll +function unix_spawn() { unix_ll("unix_spawn", arguments); } +// Provides: unix_fsync +// Requires: unix_ll +function unix_fsync() { unix_ll("unix_fsync", arguments); } +// Provides: unix_inchannel_of_filedescr +// Requires: unix_ll +function unix_inchannel_of_filedescr() { unix_ll("unix_inchannel_of_filedescr", arguments); } +// Provides: unix_outchannel_of_filedescr +// Requires: unix_ll +function unix_outchannel_of_filedescr() { unix_ll("unix_outchannel_of_filedescr", arguments); } +// Provides: caml_mutex_try_lock +// Requires: unix_ll +function caml_mutex_try_lock() { unix_ll("caml_mutex_try_lock", arguments); } +// Provides: caml_thread_join +// Requires: unix_ll +function caml_thread_join() { unix_ll("caml_thread_join", arguments); } +// Provides: caml_thread_sigmask +// Requires: unix_ll +function caml_thread_sigmask() { unix_ll("caml_thread_sigmask", arguments); } +// Provides: caml_unix_map_file_bytecode +// Requires: unix_ll +function caml_unix_map_file_bytecode() { unix_ll("caml_unix_map_file_bytecode", arguments); } +// Provides: caml_wait_signal +// Requires: unix_ll +function caml_wait_signal() { unix_ll("caml_wait_signal", arguments); } diff --git a/editor/code/src/browser.ts b/editor/code/src/browser.ts index 3164eb48..0b45263e 100644 --- a/editor/code/src/browser.ts +++ b/editor/code/src/browser.ts @@ -1,19 +1,81 @@ -import { ExtensionContext } from "vscode"; -import { LanguageClient } from "vscode-languageclient/browser"; +import { ExtensionContext, Uri } from "vscode"; +import { + LanguageClient, + LanguageClientOptions, +} from "vscode-languageclient/browser"; import { activateCoqLSP, ClientFactoryType, deactivateCoqLSP } from "./client"; +import { workspace } from "vscode"; + +class InterruptibleLC extends LanguageClient { + private readonly interrupt_vec?: Int32Array; + + constructor( + id: string, + name: string, + clientOptions: LanguageClientOptions, + worker: Worker + ) { + super(id, name, clientOptions, worker); + + // We don't fail if COI is not enabled, as of Feb 2023 you must either: + // - pass --enable-coi to vscode + // - use `?enable-coi= in the vscode dev setup + // See https://code.visualstudio.com/updates/v1_72#_towards-cross-origin-isolation + // See https://github.com/microsoft/vscode-wasm + if (typeof SharedArrayBuffer !== "undefined") { + this.interrupt_vec = new Int32Array(new SharedArrayBuffer(4)); + worker.postMessage(["SetupInterrupt", this.interrupt_vec]); + } + + this.middleware.sendRequest = (type, param, token, next) => { + this.interrupt(); + return next(type, param, token); + }; + this.middleware.sendNotification = (type, next, params) => { + this.interrupt(); + return next(type, params); + }; + + this.middleware.didChange = (data, next) => { + this.interrupt(); + return next(data); + }; + } + + public interrupt() { + if (this.interrupt_vec) { + Atomics.add(this.interrupt_vec, 0, 1); + } + } +} export function activate(context: ExtensionContext): void { const cf: ClientFactoryType = (context, clientOptions, wsConfig) => { // Pending on having the API to fetch the worker file. - throw "Worker not found"; - let worker = new Worker(""); - return new LanguageClient( + // throw "Worker not found"; + const coqWorker = Uri.joinPath( + context.extensionUri, + "out/coq_lsp_worker.bc.js" + ); + console.log(coqWorker); + + let worker = new Worker(coqWorker.toString(true)); + let client = new InterruptibleLC( "coq-lsp", "Coq LSP Worker", clientOptions, worker ); + return client; }; + + // let files = Uri.joinPath(context.extensionUri, "out/files.json"); + + // workspace.fs.readFile(files).then((content) => { + // let s = new TextDecoder().decode(content); + // console.log(`files: `, JSON.parse(s)); + // }); + activateCoqLSP(context, cf); } diff --git a/examples/documentSymbol.v b/examples/documentSymbol.v index a0149e94..78044a02 100644 --- a/examples/documentSymbol.v +++ b/examples/documentSymbol.v @@ -42,4 +42,4 @@ Module Bar. Theorem not : False. Qed. -End Bar. \ No newline at end of file +End Bar. diff --git a/flake.nix b/flake.nix index 0b4f98d6..5e130af7 100644 --- a/flake.nix +++ b/flake.nix @@ -75,7 +75,7 @@ flakeFormatter = true; - settings.global.excludes = ["./vendor/**"]; + settings.global.excludes = ["./vendor/**" "controller-js/js_stub/**"]; programs.alejandra.enable = true; programs.ocamlformat = { From 81b490c6b910350cdb8f999fbe82f7fff7fa05a5 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Thu, 26 Sep 2024 17:38:37 +0200 Subject: [PATCH 25/38] [ci] [js] Build JS worker on CI. --- .github/workflows/build.yml | 46 +++++++++++++++ Makefile | 5 ++ etc/0001-coq-lsp-patch.patch | 59 +++++++++++++++++++ ...001-jscoq-lib-system.ml-de-unix-stat.patch | 31 ++++++++++ 4 files changed, 141 insertions(+) create mode 100644 etc/0001-coq-lsp-patch.patch create mode 100644 etc/0001-jscoq-lib-system.ml-de-unix-stat.patch diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 21416bab..3d1bd616 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -85,6 +85,52 @@ jobs: - name: 🐛 Test fcc run: opam exec -- make test-compiler + build-js: + name: Web Worker Build + strategy: + fail-fast: false + runs-on: ubuntu-latest + + steps: + # OPAM figures out everything but the libgmp-dev:i386 + # dependency, maybe worth fixing this upstream in the opam + # repository + - name: Install apt dependencies + run: | + sudo apt-get install aptitude + sudo dpkg --add-architecture i386 + sudo aptitude -o Acquire::Retries=30 update -q + sudo aptitude -o Acquire::Retries=30 install gcc-multilib g++-multilib pkg-config libgmp-dev libgmp-dev:i386 -y + + - name: 🔭 Checkout code + uses: actions/checkout@v4 + with: + submodules: recursive + + - name: 🐫 Setup OCaml + uses: ocaml/setup-ocaml@v2 + with: + ocaml-compiler: "ocaml-variants.4.14.2+options,ocaml-option-32bit" + dune-cache: true + + - name: 🐫🐪🐫 Get dependencies + run: | + opam exec -- make opam-deps + opam pin add js_of_ocaml --dev -y + opam pin add js_of_ocaml-compiler --dev -y + opam install zarith_stubs_js js_of_ocaml-ppx -y + + - name: 💉💉💉 Patch Coq + run: make patch-for-js + + - name: 🦏🧱🦏 Build coq-lsp JS version 🦏🦏🦏 + run: opam exec -- make js + + - name: Upload artifact + uses: actions/upload-artifact@v4 + with: + name: coq-lsp_worker and front-end + path: editor/code/out/ build-opam: name: Opam dev install strategy: diff --git a/Makefile b/Makefile index ec08903c..030891c7 100644 --- a/Makefile +++ b/Makefile @@ -144,3 +144,8 @@ opam-update-and-reinstall: git pull --recurse-submodules for pkg in coq-core coq-stdlib coqide-server coq; do opam install -y vendor/coq/$$pkg.opam; done opam install . + +.PHONY: patch-for-js +patch-for-js: + cd vendor/coq && patch -p1 < ../../etc/0001-coq-lsp-patch.patch + cd vendor/coq && patch -p1 < ../../etc/0001-jscoq-lib-system.ml-de-unix-stat.patch diff --git a/etc/0001-coq-lsp-patch.patch b/etc/0001-coq-lsp-patch.patch new file mode 100644 index 00000000..f42d9cd4 --- /dev/null +++ b/etc/0001-coq-lsp-patch.patch @@ -0,0 +1,59 @@ +From aa1c239f64a703785d9c4a520eee3aa4f97fa3ba Mon Sep 17 00:00:00 2001 +From: Emilio Jesus Gallego Arias +Date: Thu, 26 Sep 2024 21:46:55 +0200 +Subject: [PATCH] coq-lsp patch + +--- + lib/control.ml | 7 +++++++ + lib/dune | 4 ++++ + lib/jscoq_extern.c | 4 ++++ + 3 files changed, 15 insertions(+) + create mode 100644 lib/jscoq_extern.c + +diff --git a/lib/control.ml b/lib/control.ml +index 2480821c61..49ddb6e7e3 100644 +--- a/lib/control.ml ++++ b/lib/control.ml +@@ -18,7 +18,14 @@ let enable_thread_delay = ref false + + exception Timeout + ++(* implemented in backend/jsoo/js_stub/interrupt.js *) ++external interrupt_pending : unit -> bool = "interrupt_pending" ++ ++let jscoq_event_yield () = ++ if interrupt_pending () then interrupt := true ++ + let check_for_interrupt () = ++ jscoq_event_yield (); + if !interrupt then begin interrupt := false; raise Sys.Break end; + if !enable_thread_delay then begin + incr steps; +diff --git a/lib/dune b/lib/dune +index e7b1418c9b..f23338c03c 100644 +--- a/lib/dune ++++ b/lib/dune +@@ -4,6 +4,10 @@ + (public_name coq-core.lib) + (wrapped false) + (modules_without_implementation xml_datatype) ++ (foreign_stubs ++ (language c) ++ (names jscoq_extern) ++ (flags :standard (:include %{project_root}/config/dune.c_flags))) + (libraries + coq-core.boot coq-core.clib coq-core.config + (select instr.ml from +diff --git a/lib/jscoq_extern.c b/lib/jscoq_extern.c +new file mode 100644 +index 0000000000..7d0bb8c8bc +--- /dev/null ++++ b/lib/jscoq_extern.c +@@ -0,0 +1,4 @@ ++#include ++ ++// jsCoq Stub; actual implementation is in backend/jsoo/js_stub/interrupt.js ++value interrupt_pending() { return Val_false; } +-- +2.43.0 + diff --git a/etc/0001-jscoq-lib-system.ml-de-unix-stat.patch b/etc/0001-jscoq-lib-system.ml-de-unix-stat.patch new file mode 100644 index 00000000..49e45b9d --- /dev/null +++ b/etc/0001-jscoq-lib-system.ml-de-unix-stat.patch @@ -0,0 +1,31 @@ +From 389853f5b1cfd0d9af413f52a8a766dc15107806 Mon Sep 17 00:00:00 2001 +From: Emilio Jesus Gallego Arias +Date: Fri, 27 Sep 2024 16:39:19 +0200 +Subject: [PATCH] [jscoq] [lib/system.ml] de-unix-stat + +--- + lib/system.ml | 8 ++++---- + 1 file changed, 4 insertions(+), 4 deletions(-) + +diff --git a/lib/system.ml b/lib/system.ml +index 8f1315c159..a2473c11c9 100644 +--- a/lib/system.ml ++++ b/lib/system.ml +@@ -69,10 +69,10 @@ let apply_subdir f path name = + let base = try Filename.chop_extension name with Invalid_argument _ -> name in + if ok_dirname base then + let path = if path = "." then name else path//name in +- match try (Unix.stat path).Unix.st_kind with Unix.Unix_error _ -> Unix.S_BLK with +- | Unix.S_DIR when name = base -> f (FileDir (path,name)) +- | Unix.S_REG -> f (FileRegular name) +- | _ -> () ++ if Sys.is_directory path && name = base then ++ f (FileDir (path,name)) ++ else ++ f (FileRegular name) + + let readdir dir = try Sys.readdir dir with Sys_error _ -> [||] + +-- +2.43.0 + From d7e543c49a4a240826f0af2acee5e0d163c17a15 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Fri, 27 Sep 2024 00:43:19 +0200 Subject: [PATCH 26/38] [js] Build working filesystem for findlib-based worker. We hook `loadfile` to use precompiled `.cma.js` files, using our copy of findlib. The build is very rustical, but works. We also tweak the VM options so they are correct. --- .github/workflows/build.yml | 27 ++++++++++--- Makefile | 50 ++++++++++++++++++++++- controller-js/README.md | 70 ++++++++++++++++++++++++++++++++- controller-js/coq_lsp_worker.ml | 63 +++++++++++++++++++++++------ controller-js/dune | 40 +++++++++++++++---- controller-js/js_stub/unix.js | 3 ++ controller-js/my_dynload.ml | 42 ++++++++++++++++++++ controller-js/my_dynload.mli | 2 + etc/META.threads | 37 +++++++++++++++++ 9 files changed, 308 insertions(+), 26 deletions(-) create mode 100644 controller-js/my_dynload.ml create mode 100644 controller-js/my_dynload.mli create mode 100755 etc/META.threads diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 3d1bd616..e8ea7dd5 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -116,21 +116,38 @@ jobs: - name: 🐫🐪🐫 Get dependencies run: | opam exec -- make opam-deps - opam pin add js_of_ocaml --dev -y - opam pin add js_of_ocaml-compiler --dev -y + opam pin add js_of_ocaml-compiler https://github.com/ejgallego/js_of_ocaml.git#fix_build_fs_target -y + opam pin add js_of_ocaml https://github.com/ejgallego/js_of_ocaml.git#fix_build_fs_target -y opam install zarith_stubs_js js_of_ocaml-ppx -y - name: 💉💉💉 Patch Coq run: make patch-for-js - name: 🦏🧱🦏 Build coq-lsp JS version 🦏🦏🦏 - run: opam exec -- make js + run: | + opam exec -- make controller-js/coq-fs-core.js + opam exec -- make js + + - name: 🚀 Setup node + uses: actions/setup-node@v4 + with: + node-version: 22 + + - name: 🦏🧱🦏 Build coq-lsp VSCode extension 🦏🦏🦏 + run: opam exec -- make extension - name: Upload artifact uses: actions/upload-artifact@v4 with: name: coq-lsp_worker and front-end - path: editor/code/out/ + path: | + editor/code/package.json + editor/code/README.md + editor/code/CHANGELOG.md + editor/code/syntaxes + editor/code/out/ + editor/code/coq.configuration.json + compression-level: 9 build-opam: name: Opam dev install strategy: @@ -195,7 +212,7 @@ jobs: - name: 🚀 Setup node uses: actions/setup-node@v4 with: - node-version: 18 + node-version: 22 - run: npm ci - run: npx --yes @vscode/vsce ls diff --git a/Makefile b/Makefile index 030891c7..aadf72e4 100644 --- a/Makefile +++ b/Makefile @@ -1,3 +1,5 @@ +SHELL := /usr/bin/env bash + COQ_BUILD_CONTEXT=../_build/default/coq PKG_SET= \ @@ -79,7 +81,7 @@ winconfig: .PHONY: js js: COQVM = no js: coq_boot - dune build --profile=release controller-js/coq_lsp_worker.bc.cjs + dune build --profile=release --display=quiet $(PKG_SET) controller-js/coq_lsp_worker.bc.cjs mkdir -p editor/code/out/ && cp -a controller-js/coq_lsp_worker.bc.cjs editor/code/out/coq_lsp_worker.bc.js .PHONY: coq_boot @@ -149,3 +151,49 @@ opam-update-and-reinstall: patch-for-js: cd vendor/coq && patch -p1 < ../../etc/0001-coq-lsp-patch.patch cd vendor/coq && patch -p1 < ../../etc/0001-jscoq-lib-system.ml-de-unix-stat.patch + +_LIBROOT=$(shell opam var lib) + +# Super-hack +controller-js/coq-fs-core.js: COQVM = no +controller-js/coq-fs-core.js: coq_boot + dune build --profile=release --display=quiet $(PKG_SET) etc/META.threads + for i in $$(find _build/install/default/lib/coq-core/plugins -name *.cma); do js_of_ocaml --dynlink $$i; done + for i in $$(find _build/install/default/lib/coq-lsp/serlib -wholename */*.cma); do js_of_ocaml --dynlink $$i; done + cd _build/install/default/lib && \ + js_of_ocaml build-fs -o coq-fs-core.js \ + $$(find coq-core/ \( -wholename '*/plugins/*/*.js' -or -wholename '*/META' \) -printf "%p:/static/lib/%p ") \ + $$(find coq-lsp/ \( -wholename '*/serlib/*/*.js' -or -wholename '*/META' \) -printf "%p:/static/lib/%p ") \ + ../../../../etc/META.threads:/static/lib/threads/META \ + $$(find $(_LIBROOT) -wholename '*/str/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/seq/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/uri/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/base/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/unix/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/zarith/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/yojson/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/findlib/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/dynlink/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/parsexp/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/sexplib/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/sexplib0/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/bigarray/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/cmdliner/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/ppx_hash/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/angstrom/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/stringext/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/ppx_compare/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/ppx_deriving/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/ppx_sexp_conv/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/memprof-limits/META' -printf "%p:/static/lib/%P ") \ + $$(find $(_LIBROOT) -wholename '*/ppx_deriving_yojson/META' -printf "%p:/static/lib/%P ") + # These libs are actually linked, so no cma is needed. + # $$(find $(_LIBROOT) -wholename '*/zarith/*.cma' -printf "%p:/static/lib/%P " -or -wholename '*/zarith/META' -printf "%p:/static/lib/%P ") + cp _build/install/default/lib/coq-fs-core.js controller-js + +# Serlib plugins require: +# ppx_compare.runtime-lib +# ppx_deriving.runtime +# ppx_deriving_yojson.runtime +# ppx_hash.runtime-lib +# ppx_sexp_conv.runtime-lib diff --git a/controller-js/README.md b/controller-js/README.md index 6b2ec291..cd1c4659 100644 --- a/controller-js/README.md +++ b/controller-js/README.md @@ -1,10 +1,78 @@ ## coq-lsp Web Worker README This directory contains the implementation of our LSP-compliant web -worker for Coq / coq-lsp. +worker for Coq, based on jsCoq. As you can see the implementation is minimal, thanks to proper abstraction of the core of the controller. For now it is only safe to use the worker in 32bit OCaml mode. +Support for this build is still experimental. See [the javascript +compilation +meta-issue](https://github.com/ejgallego/coq-lsp/issues/833) for more +information. + +## Building the Worker + +The worker needs two parts to work: + +- the worker binary +- the worker filesystem + +which are then bundled in a single `.js` file. + +Type + +``` +make controller-js/coq-fs-core.js && make js +``` +to build the worker filesystem and the worker, which will be placed under `editor/code/out`. + +As of now the build is very artisanal and not flexible at all, we hope to improve it soon. + +## Testing the worker + +You can test the server using any of the [official methods](https://code.visualstudio.com/api/extension-guides/web-extensions#test-your-web-extension). + +Using the regular setup `dune exec -- code editor/code` and then +selecting "Web Extension" in the run menu works out of the box. + +A quick recipe from the manual is: + +``` +$ make controller-js/coq-fs-core.js && make js +$ npx @vscode/test-web --browser chromium --extensionDevelopmentPath=editor/code +$ chrome localhost:3000 +``` + +you can also download the artifacts from the CI build, and point +`--extensionDevelopmentPath=` to the path you have downloaded the +extension + Coq build. + +## COI + +As of Feb 2023, due to security restrictions, you may need to either: + + - pass `--enable-coi` to `code` + - use ``?enable-coi=` in the vscode dev setup + +in order to have interruptions (`SharedBufferArray`) working. + +See https://code.visualstudio.com/updates/v1_72#_towards-cross-origin-isolation + +## WASM + +We hope to have a WASM backend working soon, based on waCoq, see +https://github.com/microsoft/vscode-wasm + +## Filesystem layout + +We need to have most `META` files in findlib, plus the Coq and +`coq-lsp.serlib.*` plugins. These should be precompiled. + +- `/static/lib`: OCaml findlib root +- `/static/coqlib`: Coq root, with regular paths + + `/static/coqlib/theories` + + `/static/coqlib/user-contrib` + diff --git a/controller-js/coq_lsp_worker.ml b/controller-js/coq_lsp_worker.ml index 91e19577..2fabd2f7 100644 --- a/controller-js/coq_lsp_worker.ml +++ b/controller-js/coq_lsp_worker.ml @@ -127,9 +127,31 @@ let on_init ~io ~root_state ~cmdline ~debug msg = in ignore (setTimeout (process_queue ~state) 0.1)) +let time f x = + let time = Sys.time () in + let res = f x in + let time_new = Sys.time () in + Format.eprintf "loadfile [dynlink] took: %f seconds%!" (time_new -. time); + res + +let loadfile file = + let file_js = Filename.remove_extension file ^ ".js" in + if Sys.file_exists file_js then ( + Format.eprintf "loadfile [eval_js]: %s%!" file; + let js_code = Sys_js.read_file ~name:file_js in + let js_code = + Format.asprintf "(function (globalThis) { @[%s@] })" js_code + in + Js.Unsafe.((eval_string js_code : < .. > Js.t -> unit) global)) + else ( + (* Not precompiled *) + Format.eprintf "loadfile [dynlink]: %s%!" file; + time Dynlink.loadfile file) + let coq_init ~debug = - let load_module = Dynlink.loadfile in - let load_plugin = Coq.Loader.plugin_handler None in + let loader = My_dynload.load_packages ~debug:false ~loadfile in + let load_module = loadfile in + let load_plugin = Coq.Loader.plugin_handler (Some loader) in (* XXX: Fixme at some point? *) let vm, warnings = (false, Some "-vm-compute-disabled") in Coq.Init.(coq_init { debug; load_module; load_plugin; vm; warnings }) @@ -154,25 +176,42 @@ let main () = let io = CB.cb in Fleche.Io.CallBack.set io; - let stdlib = - let unix_path = "/static/coq/theories/" in - let coq_path = Names.(DirPath.make [ Id.of_string "Coq" ]) in + let stdlib coqlib = + let unix_path = Filename.concat coqlib "theories" in + let coq_path = Names.(DirPath.make [ Id.of_string "Stdlib" ]) in Loadpath. { unix_path; coq_path; implicit = true; has_ml = false; recursive = true } in + let user_contrib coqlib = + let unix_path = Filename.concat coqlib "user-contrib" in + let coq_path = Names.DirPath.empty in + Loadpath. + { unix_path + ; coq_path + ; implicit = false + ; has_ml = false + ; recursive = true + } + in + let cmdline = + let coqlib = "/static/coqlib" in + let findlib_config = Some findlib_path in + let ocamlpath = [] in + let vo_load_path = List.map (fun f -> f coqlib) [ stdlib; user_contrib ] in Coq.Workspace.CmdLine. - { coqlib = "/static/coqlib" - ; coqcorelib = "/static/lib/coq-core" - ; findlib_config = Some findlib_path - ; ocamlpath = [] - ; vo_load_path = [ stdlib ] + { coqlib + ; coqcorelib = "/static/lib/coq-core" (* deprecated upstream *) + ; findlib_config + ; ocamlpath + ; vo_load_path ; ml_include_path = [] - ; require_libraries = [] - ; args = [ "-noinit" ] + ; require_libraries = [ (None, "Stdlib.Init.Prelude") ] + ; args = [ "-noinit"; "-boot" ] } in + let debug = true in let root_state = coq_init ~debug in Worker.set_onmessage (on_init ~io ~root_state ~cmdline ~debug); diff --git a/controller-js/dune b/controller-js/dune index af7826f5..123b03de 100644 --- a/controller-js/dune +++ b/controller-js/dune @@ -10,12 +10,15 @@ js_stub/coq_vm.js js_stub/coq_perf.js js_stub/interrupt.js + coq-fs-core.js + coq-fs.js marshal-arch.js) (flags :standard + --linkall --dynlink - +dynlink.js - ; (:include .extraflags) + ; --toplevel + (:include .extraflags) ; +toplevel.js ; --enable ; with-js-error @@ -24,13 +27,19 @@ ; --no-inline ; --debug-info ; --source-map - ; no coq-fs yet - ; --file=coq-fs + ; --file=%{dep:coq-fs} --setenv PATH=/bin)) (link_flags -linkall -no-check-prims) ; The old makefile set: -noautolink -no-check-prims - (libraries zarith_stubs_js yojson controller)) + (libraries + zarith_stubs_js + yojson + controller + ; js_of_ocaml-toplevel + ; js_of_ocaml-compiler.dynlink + ; js_of_ocaml-compiler.findlib-support + )) (rule (target coq_lsp_worker.bc.cjs) @@ -40,11 +49,28 @@ (rule (targets marshal-arch.js) - ; This is to inject the dep of a FS on the executable if we want. - ; (deps coq-fs) (action (copy js_stub/marshal%{ocaml-config:word_size}.js %{targets}))) +(rule + (targets coq-fs.js) + (deps + (package coq-stdlib)) + (action + (bash + "cd ../vendor/coq && js_of_ocaml build-fs -o ../../controller-js/coq-fs.js $(find theories user-contrib \\( -wholename 'theories/*.vo' -or -wholename 'theories/*.glob' -or -wholename 'theories/*.v' -or -wholename 'user-contrib/*.vo' -or -wholename 'user-contrib/*.v' -or -wholename 'user-contrib/*.glob' \\) -printf '%p:/static/coqlib/%p ')"))) + +; for coq-fs-core.js +; js_of_ocaml build-fs -o coq-fs-core.js $(find coq-core/ -wholename '*/plugins/*/*.cma' -or -wholename '*/META' -printf "%p:/lib/%p") + +; (rule +; (targets coq-fs-core.js) +; (deps +; (package coq-core)) +; (action +; (bash +; "cd ../vendor/coq && js_of_ocaml build-fs -o ../../controller-js/coq-fs.js $(find theories -wholename 'theories/Init/*.vo' -printf '%p:/static/%p '"))) + ; Set debug flags if JSCOQ_DEBUG environment variable is set. ; (ugly, but there are no conditional expressions in Dune) diff --git a/controller-js/js_stub/unix.js b/controller-js/js_stub/unix.js index a606d9bb..07dbbb7c 100644 --- a/controller-js/js_stub/unix.js +++ b/controller-js/js_stub/unix.js @@ -383,6 +383,9 @@ function unix_open() { unix_ll("unix_open", arguments); } // Provides: unix_putenv // Requires: unix_ll function unix_putenv() { unix_ll("unix_putenv", arguments); } +// Provides: unix_realpath +// Requires: unix_ll +function unix_realpath() { unix_ll("unix_realpath", arguments); } // Provides: unix_recv // Requires: unix_ll function unix_recv() { unix_ll("unix_recv", arguments); } diff --git a/controller-js/my_dynload.ml b/controller-js/my_dynload.ml new file mode 100644 index 00000000..bcec1a3d --- /dev/null +++ b/controller-js/my_dynload.ml @@ -0,0 +1,42 @@ +(* Utilities for loading dynamically packages, adapted from ocamlfind, until + upstream merges this patch *) + +open Printf + +let load_pkg ~debug ~loadfile pkg = + if not (Findlib.is_recorded_package pkg) then ( + if debug then eprintf "[DEBUG] Fl_dynload: about to load: %s\n%!" pkg; + (* Determine the package directory: *) + let d = Findlib.package_directory pkg in + (* First try the new "plugin" variable: *) + let preds = Findlib.recorded_predicates () in + let archive = + try Findlib.package_property preds pkg "plugin" + with Not_found -> ( + (* Legacy: use "archive" but require that the predicate "plugin" is + mentioned in the definition *) + try + let v, fpreds = + Findlib.package_property_2 ("plugin" :: preds) pkg "archive" + in + let need_plugin = List.mem "native" preds in + if need_plugin && not (List.mem (`Pred "plugin") fpreds) then "" + else v + with Not_found -> "") + in + (* Split the plugin/archive property and resolve the files: *) + let files = Fl_split.in_words archive in + if debug then eprintf "[DEBUG] Fl_dynload: files=%S\n%!" archive; + List.iter + (fun file -> + if debug then eprintf "[DEBUG] Fl_dynload: loading %S\n%!" file; + let file = Findlib.resolve_path ~base:d file in + loadfile file) + files; + Findlib.record_package Findlib.Record_load pkg) + else if debug then eprintf "[DEBUG] Fl_dynload: not loading: %s\n%!" pkg + +let load_packages ?(debug = false) ?(loadfile = Dynlink.loadfile) pkgs = + let preds = Findlib.recorded_predicates () in + let eff_pkglist = Findlib.package_deep_ancestors preds pkgs in + List.iter (load_pkg ~debug ~loadfile) eff_pkglist diff --git a/controller-js/my_dynload.mli b/controller-js/my_dynload.mli new file mode 100644 index 00000000..f29c74f1 --- /dev/null +++ b/controller-js/my_dynload.mli @@ -0,0 +1,2 @@ +val load_packages : + ?debug:bool -> ?loadfile:(string -> unit) -> string list -> unit diff --git a/etc/META.threads b/etc/META.threads new file mode 100755 index 00000000..6e01dec9 --- /dev/null +++ b/etc/META.threads @@ -0,0 +1,37 @@ +# Specifications for the "threads" library: +version = "[distributed with Ocaml]" +description = "Multi-threading" +requires(mt,mt_vm) = "threads.vm" +# requires(mt,mt_posix) = "threads.posix" +directory = "^" +type_of_threads = "posix" + +browse_interfaces = "" + +warning(-mt) = "Linking problems may arise because of the missing -thread or -vmthread switch" +warning(-mt_vm,-mt_posix) = "Linking problems may arise because of the missing -thread or -vmthread switch" + +package "vm" ( + # --- Bytecode-only threads: + requires = "unix" + directory = "+vmthreads" + exists_if = "threads.cma" + archive(byte,mt,mt_vm) = "threads.cma" + version = "[internal]" +) + +package "posix" ( + # --- POSIX-threads: + requires = "unix" + directory = "+threads" + exists_if = "threads.cma" + archive(byte,mt,mt_posix) = "threads.cma" + archive(native,mt,mt_posix) = "threads.cmxa" + version = "[internal]" +) + +package "none" ( + error = "threading is not supported on this platform" + version = "[internal]" +) + From a304994b1e9fce8f94301bc5c1799cd3658b6a71 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sat, 28 Sep 2024 16:28:55 +0200 Subject: [PATCH 27/38] [js] [doc] [changes] Changes for javascript support. --- CHANGES.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGES.md b/CHANGES.md index a3cb25b6..a225207f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -19,6 +19,10 @@ #829, thanks to @gmalecha for the idea, c.f. Coq issue 19601) - [fleche] Highlight the full first line of the document on initialization error (@ejgallego, #832) + - [fleche] [jscoq] [js] Build worker version of `coq-lsp`. This + provides a full working Coq enviroment in `vscode.dev`. The web + worker version is build as an artifact on CI (@ejgallego + @corwin-of-amber, #433) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- From 9fa6a0f45005e96fff2520aa71fe48541dca676e Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sat, 28 Sep 2024 16:32:17 +0200 Subject: [PATCH 28/38] [doc] [js] More docs on our JS setup. --- controller-js/README.md | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/controller-js/README.md b/controller-js/README.md index cd1c4659..244cc00c 100644 --- a/controller-js/README.md +++ b/controller-js/README.md @@ -18,16 +18,23 @@ information. The worker needs two parts to work: - the worker binary -- the worker filesystem +- the worker OCaml filesystem (`controller-js/coq-fs-core.js`) +- the worker Coq filesystem (`controller-js/coq-fs.js`) which are then bundled in a single `.js` file. -Type +The worker OCaml filesystem includes: +- `META` files for anything used by Coq +- transpiled `.cma` to `.js` files for plugins that will be loaded by Coq + +Type: ``` -make controller-js/coq-fs-core.js && make js +make patch-for-js # (only once, patch Coq for JS build) +make controller-js/coq-fs-core.js # build the OCaml filesystem, needed when plugins change +make js # build the worker and link with the FS. ``` -to build the worker filesystem and the worker, which will be placed under `editor/code/out`. +to get a working build in `editor/code/out`. As of now the build is very artisanal and not flexible at all, we hope to improve it soon. @@ -75,4 +82,3 @@ We need to have most `META` files in findlib, plus the Coq and - `/static/coqlib`: Coq root, with regular paths + `/static/coqlib/theories` + `/static/coqlib/user-contrib` - From ba069246fedcdb7a66852afa770c9de3f117344d Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sat, 28 Sep 2024 18:44:22 +0200 Subject: [PATCH 29/38] [gitignore] Update for the JS build --- .gitignore | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/.gitignore b/.gitignore index 84104728..b0a73c4e 100644 --- a/.gitignore +++ b/.gitignore @@ -14,3 +14,8 @@ nix/profiles/ # examples config, ignore for now examples/.vscode + +# Related to the JS build and testing +/controller-js/coq-fs-core.js +/controller-js/coq_lsp_worker.bc.cjs +/.vscode-test-web/ From 0ae1e563e6e24589746c1d78b93b27c925002861 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sat, 28 Sep 2024 22:03:30 +0200 Subject: [PATCH 30/38] [hover] Fix universe printing in hover. Our code was incomplete. The API here could be really improved Coq-side. About is too verbose for hover, hence our code. We could opt for the version in `prettyp.ml` tho. Fixes #835 --- CHANGES.md | 4 ++- controller/rq_hover.ml | 71 +++++++++++++++++++++++++++++++++++------- examples/print_univs.v | 14 +++++++++ 3 files changed, 76 insertions(+), 13 deletions(-) create mode 100644 examples/print_univs.v diff --git a/CHANGES.md b/CHANGES.md index a225207f..e8038419 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -11,7 +11,7 @@ - [serlib] Fix Ltac2 AST piercing bug, add test case that should help in the future (@ejgallego, @jim-portegies, #821) - [fleche] [8.20] understand rewrite rules and symbols on document - outline (@ejgallego, @Alizter, #825, fixes: #824) + outline (@ejgallego, @Alizter, #825, fixes #824) - [fleche] [coq] support `Restart` meta command (@ejgallego, @Alizter, #828, fixes #827) - [fleche] [plugins] New plugin example `explain_errors`, that will @@ -23,6 +23,8 @@ provides a full working Coq enviroment in `vscode.dev`. The web worker version is build as an artifact on CI (@ejgallego @corwin-of-amber, #433) + - [hover] Fix universe and level printing in hover (#839, fixes #835 + , @ejgallego , @Alizter) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/controller/rq_hover.ml b/controller/rq_hover.ml index 903bfc56..ad41e9bf 100644 --- a/controller/rq_hover.ml +++ b/controller/rq_hover.ml @@ -12,10 +12,28 @@ let build_ind_type mip = Inductive.type_of_inductive mip type id_info = | Notation of Pp.t - | Def of (Pp.t * Names.Constant.t option * string option) - -let info_of_ind env sigma ((sp, i) : Names.Ind.t) = + | Def of + { typ : Pp.t (** type of the ide *) + ; params : Pp.t (** params that need display next to the name *) + ; full_path : Names.Constant.t option + (** full path of the constant, if any, for example + [Stdlib.Lists.map] *) + ; file : string option (** filename where the constant is located *) + } + +let print_params env sigma params = + if CList.is_empty params then Pp.mt () + else Pp.(spc () ++ Printer.pr_rel_context env sigma params ++ brk (1, 2)) + +let info_of_ind env ((sp, i) : Names.Ind.t) = + let udecl = None in let mib = Environ.lookup_mind sp env in + let bl = + Printer.universe_binders_with_opt_names + (Declareops.inductive_polymorphic_context mib) + udecl + in + let sigma = Evd.from_ctx (UState.of_names bl) in let u = UVars.make_abstract_instance (Declareops.inductive_polymorphic_context mib) in @@ -37,17 +55,34 @@ let info_of_ind env sigma ((sp, i) : Names.Ind.t) = (Impargs.implicits_of_global (Names.GlobRef.IndRef (sp, i))) in let impargs = List.map Impargs.binding_kind_of_status impargs in - Def (Printer.pr_ltype_env ~impargs env_params sigma arity, None, None) + let inst = + if Declareops.inductive_is_polymorphic mib then + Printer.pr_universe_instance sigma u + else Pp.mt () + in + let params = EConstr.Unsafe.to_rel_context params in + let typ = Printer.pr_ltype_env ~impargs env_params sigma arity in + let params = Pp.(inst ++ print_params env sigma params) in + Def { typ; params; full_path = None; file = None } let type_of_constant cb = cb.Declarations.const_type -let info_of_const env sigma cr = +let info_of_const env cr = + let udecl = None in let cdef = Environ.lookup_constant cr env in + let bl = + Printer.universe_binders_with_opt_names + (Environ.constant_context env cr) + udecl + in + let sigma = Evd.from_ctx (UState.of_names bl) in (* This prints the definition *) (* let cb = Environ.lookup_constant cr env in *) (* Option.cata (fun (cb,_univs,_uctx) -> Some cb ) None *) (* (Global.body_of_constant_body Library.indirect_accessor cb), *) let typ = type_of_constant cdef in + let univs = Declareops.constant_polymorphic_context cdef in + let inst = UVars.make_abstract_instance univs in let impargs = Impargs.select_stronger_impargs (Impargs.implicits_of_global (Names.GlobRef.ConstRef cr)) @@ -56,7 +91,12 @@ let info_of_const env sigma cr = let typ = Printer.pr_ltype_env env sigma ~impargs typ in let dp = Names.Constant.modpath cr |> Names.ModPath.dp in let source = Coq.Module.(make dp |> Result.to_option |> Option.map source) in - Def (typ, Some cr, source) + let inst = + if Environ.polymorphic_constant cr env then + Printer.pr_universe_instance sigma inst + else Pp.mt () + in + Def { typ; params = inst; full_path = Some cr; file = source } let info_of_var env vr = let vdef = Environ.lookup_named vr env in @@ -73,7 +113,13 @@ let info_of_constructor env cr = in ctype -let print_type env sigma x = Def (Printer.pr_ltype_env env sigma x, None, None) +let print_type env sigma x = + Def + { typ = Printer.pr_ltype_env env sigma x + ; params = Pp.mt () + ; full_path = None + ; file = None + } let info_of_id env sigma id = let qid = Libnames.qualid_of_string id in @@ -89,8 +135,8 @@ let info_of_id env sigma id = let open Names.GlobRef in (match lid with | VarRef vr -> info_of_var env vr |> print_type env sigma - | ConstRef cr -> info_of_const env sigma cr - | IndRef ir -> info_of_ind env sigma ir + | ConstRef cr -> info_of_const env cr + | IndRef ir -> info_of_ind env ir | ConstructRef cr -> info_of_constructor env cr |> print_type env sigma) |> fun x -> Some x | Abbrev kn -> @@ -128,11 +174,12 @@ let pp_file fmt = function | Some file -> Format.fprintf fmt " - **in file**: `%s`" file let pp_typ id = function - | Def (typ, cr, file) -> + | Def { typ; params; full_path; file } -> let typ = Pp.string_of_ppcmds typ in + let param = Pp.string_of_ppcmds params in Format.( - asprintf "@[```coq\n%s : %s@\n```@\n@[%a@]@[%a@]@]" id typ pp_cr cr - pp_file file) + asprintf "@[```coq\n%s%s: %s@\n```@\n@[%a@]@[%a@]@]" id param typ pp_cr + full_path pp_file file) | Notation nt -> let nt = Pp.string_of_ppcmds nt in Format.(asprintf "```coq\n%s\n```" nt) diff --git a/examples/print_univs.v b/examples/print_univs.v new file mode 100644 index 00000000..f6a24025 --- /dev/null +++ b/examples/print_univs.v @@ -0,0 +1,14 @@ +From Coq Require Import Prelude. +Set Printing Universes. +Set Universe Polymorphism. + +Definition arr (S: Type) : Type := S. + +Print arr. + +Inductive foo (M : Type) : Type -> Type := + bar : M -> Type -> foo M nat. + +Print foo. + +About foo. From a4c9172d3f7cf3bf80ec64ba3051ad5d597ffcdd Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sat, 28 Sep 2024 22:55:45 +0200 Subject: [PATCH 31/38] [hover] Print full paths and source files for inductives too. --- controller/rq_hover.ml | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/controller/rq_hover.ml b/controller/rq_hover.ml index ad41e9bf..bd78386f 100644 --- a/controller/rq_hover.ml +++ b/controller/rq_hover.ml @@ -15,7 +15,7 @@ type id_info = | Def of { typ : Pp.t (** type of the ide *) ; params : Pp.t (** params that need display next to the name *) - ; full_path : Names.Constant.t option + ; full_path : Pp.t option (** full path of the constant, if any, for example [Stdlib.Lists.map] *) ; file : string option (** filename where the constant is located *) @@ -63,7 +63,10 @@ let info_of_ind env ((sp, i) : Names.Ind.t) = let params = EConstr.Unsafe.to_rel_context params in let typ = Printer.pr_ltype_env ~impargs env_params sigma arity in let params = Pp.(inst ++ print_params env sigma params) in - Def { typ; params; full_path = None; file = None } + let dp = Names.MutInd.modpath sp |> Names.ModPath.dp in + let source = Coq.Module.(make dp |> Result.to_option |> Option.map source) in + let full_path = Some (Names.MutInd.print sp) in + Def { typ; params; full_path; file = source } let type_of_constant cb = cb.Declarations.const_type @@ -90,13 +93,14 @@ let info_of_const env cr = let impargs = List.map Impargs.binding_kind_of_status impargs in let typ = Printer.pr_ltype_env env sigma ~impargs typ in let dp = Names.Constant.modpath cr |> Names.ModPath.dp in + let full_path = Some (Names.Constant.print cr) in let source = Coq.Module.(make dp |> Result.to_option |> Option.map source) in let inst = if Environ.polymorphic_constant cr env then Printer.pr_universe_instance sigma inst else Pp.mt () in - Def { typ; params = inst; full_path = Some cr; file = source } + Def { typ; params = inst; full_path; file = source } let info_of_var env vr = let vdef = Environ.lookup_named vr env in @@ -165,9 +169,7 @@ let info_of_id_at_point ~token ~node id = let pp_cr fmt = function | None -> () - | Some cr -> - Format.fprintf fmt " - **full path**: `%a`@\n" Pp.pp_with - (Names.Constant.print cr) + | Some cr -> Format.fprintf fmt " - **full path**: `%a`@\n" Pp.pp_with cr let pp_file fmt = function | None -> () From 12bcda690f4ee2f4ebf933d4d846fa977f2dcf10 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sat, 28 Sep 2024 22:59:19 +0200 Subject: [PATCH 32/38] [hover] Minor refactoring. --- controller/rq_hover.ml | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) diff --git a/controller/rq_hover.ml b/controller/rq_hover.ml index bd78386f..5c11f6f6 100644 --- a/controller/rq_hover.ml +++ b/controller/rq_hover.ml @@ -18,7 +18,7 @@ type id_info = ; full_path : Pp.t option (** full path of the constant, if any, for example [Stdlib.Lists.map] *) - ; file : string option (** filename where the constant is located *) + ; source : string option (** filename where the constant is located *) } let print_params env sigma params = @@ -63,10 +63,12 @@ let info_of_ind env ((sp, i) : Names.Ind.t) = let params = EConstr.Unsafe.to_rel_context params in let typ = Printer.pr_ltype_env ~impargs env_params sigma arity in let params = Pp.(inst ++ print_params env sigma params) in - let dp = Names.MutInd.modpath sp |> Names.ModPath.dp in - let source = Coq.Module.(make dp |> Result.to_option |> Option.map source) in let full_path = Some (Names.MutInd.print sp) in - Def { typ; params; full_path; file = source } + let source = + let dp = Names.MutInd.modpath sp |> Names.ModPath.dp in + Coq.Module.(make dp |> Result.to_option |> Option.map source) + in + Def { typ; params; full_path; source } let type_of_constant cb = cb.Declarations.const_type @@ -92,15 +94,17 @@ let info_of_const env cr = in let impargs = List.map Impargs.binding_kind_of_status impargs in let typ = Printer.pr_ltype_env env sigma ~impargs typ in - let dp = Names.Constant.modpath cr |> Names.ModPath.dp in - let full_path = Some (Names.Constant.print cr) in - let source = Coq.Module.(make dp |> Result.to_option |> Option.map source) in let inst = if Environ.polymorphic_constant cr env then Printer.pr_universe_instance sigma inst else Pp.mt () in - Def { typ; params = inst; full_path; file = source } + let full_path = Some (Names.Constant.print cr) in + let source = + let dp = Names.Constant.modpath cr |> Names.ModPath.dp in + Coq.Module.(make dp |> Result.to_option |> Option.map source) + in + Def { typ; params = inst; full_path; source } let info_of_var env vr = let vdef = Environ.lookup_named vr env in @@ -122,7 +126,7 @@ let print_type env sigma x = { typ = Printer.pr_ltype_env env sigma x ; params = Pp.mt () ; full_path = None - ; file = None + ; source = None } let info_of_id env sigma id = @@ -176,12 +180,12 @@ let pp_file fmt = function | Some file -> Format.fprintf fmt " - **in file**: `%s`" file let pp_typ id = function - | Def { typ; params; full_path; file } -> + | Def { typ; params; full_path; source } -> let typ = Pp.string_of_ppcmds typ in let param = Pp.string_of_ppcmds params in Format.( asprintf "@[```coq\n%s%s: %s@\n```@\n@[%a@]@[%a@]@]" id param typ pp_cr - full_path pp_file file) + full_path pp_file source) | Notation nt -> let nt = Pp.string_of_ppcmds nt in Format.(asprintf "```coq\n%s\n```" nt) From 6259a7954c58db3c79edc5a9b8b05d88de51bf14 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sun, 29 Sep 2024 17:27:29 +0200 Subject: [PATCH 33/38] [hover] Disable show notation prototype plugin. It is not of any use yet, just a nuisance for everyone. --- controller/rq_hover.ml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/controller/rq_hover.ml b/controller/rq_hover.ml index 5c11f6f6..c48fd46f 100644 --- a/controller/rq_hover.ml +++ b/controller/rq_hover.ml @@ -227,8 +227,10 @@ let info_notation ~point (ast : Fleche.Doc.Node.Ast.t) = Some (ntn_key_info key) | _ -> None +(* Disabled until it is more useful and doesn't pre-empt other stuff. *) let info_notation ~token:_ ~contents:_ ~point ~node : string option = - Option.bind node.Fleche.Doc.Node.ast (info_notation ~point) + if false then Option.bind node.Fleche.Doc.Node.ast (info_notation ~point) + else None open Fleche From b9d7777dd5e8b10028aee68d7f708e735054ab7b Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sun, 29 Sep 2024 17:38:52 +0200 Subject: [PATCH 34/38] [fleche] New immediate request serving mode. In this mode, requests are served with whatever document state we have. This is very useful when we are not in continuous mode, and we don't have a good reference as to what to build, for example in `documentSymbols` (cc: #816) The mode actually works pretty well in practice as often language requests will come after goals requests, so the info that is needed is at hand. It could also be tried to set the build target for immediate requests to the view hint, but we should see some motivation for that. This commit switches `documentSymbols` to the immediate mode, when in lazy checking mode. --- CHANGES.md | 9 +++++++++ controller/lsp_core.ml | 11 ++++++++++- controller/request.ml | 8 ++++++++ controller/request.mli | 4 ++++ fleche/theory.ml | 3 +++ fleche/theory.mli | 1 + 6 files changed, 35 insertions(+), 1 deletion(-) diff --git a/CHANGES.md b/CHANGES.md index e8038419..de4884e1 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -25,6 +25,15 @@ @corwin-of-amber, #433) - [hover] Fix universe and level printing in hover (#839, fixes #835 , @ejgallego , @Alizter) + - [fleche] New immediate request serving mode. In this mode, requests + are served with whatever document state we have. This is very + useful when we are not in continuous mode, and we don't have a good + reference as to what to build, for example in + `documentSymbols`. The mode actually works pretty well in practice + as often language requests will come after goals requests, so the + info that is needed is at hand. It could also be tried to set the + build target for immediate requests to the view hint, but we should + see some motivation for that (@ejgallego, #841) # coq-lsp 0.2.0: From Green to Blue ----------------------------------- diff --git a/controller/lsp_core.ml b/controller/lsp_core.ml index 102afbf9..eb33483e 100644 --- a/controller/lsp_core.ml +++ b/controller/lsp_core.ml @@ -402,7 +402,16 @@ let do_document_request_maybe ~params ~handler = let postpone = not !Fleche.Config.v.check_only_on_request in do_document_request ~postpone ~params ~handler -let do_symbols = do_document_request_maybe ~handler:Rq_symbols.symbols +let do_immediate ~params ~handler = + let uri = Helpers.get_uri params in + Rq.Action.Data (Request.Data.Immediate { uri; handler }) + +(* new immediate mode, cc: #816 *) +let do_symbols ~params = + let handler = Rq_symbols.symbols in + if !Fleche.Config.v.check_only_on_request then do_immediate ~params ~handler + else do_document_request ~postpone:true ~params ~handler + let do_document = do_document_request_maybe ~handler:Rq_document.request let do_save_vo = do_document_request_maybe ~handler:Rq_save.request let do_lens = do_document_request_maybe ~handler:Rq_lens.request diff --git a/controller/request.ml b/controller/request.ml index f2acdb11..3ea2fac4 100644 --- a/controller/request.ml +++ b/controller/request.ml @@ -48,6 +48,10 @@ type position = (** Requests that require data access *) module Data = struct type t = + | Immediate of + { uri : Lang.LUri.File.t + ; handler : document + } | DocRequest of { uri : Lang.LUri.File.t ; postpone : bool @@ -63,6 +67,7 @@ module Data = struct (* Debug printing *) let data fmt = function + | Immediate { uri = _; handler = _ } -> Format.fprintf fmt "{k:imm }" | DocRequest { uri = _; postpone; handler = _ } -> Format.fprintf fmt "{k:doc | p: %B}" postpone | PosRequest { uri = _; point; version; postpone; handler = _ } -> @@ -73,6 +78,8 @@ module Data = struct let dm_request pr = match pr with + | Immediate { uri; handler = _ } -> + (uri, false, Fleche.Theory.Request.Immediate) | DocRequest { uri; postpone; handler = _ } -> (uri, postpone, Fleche.Theory.Request.FullDoc) | PosRequest { uri; point; version; postpone; handler = _ } -> @@ -80,6 +87,7 @@ module Data = struct let serve ~token ~doc pr = match pr with + | Immediate { uri = _; handler } -> handler ~token ~doc | DocRequest { uri = _; postpone = _; handler } -> handler ~token ~doc | PosRequest { uri = _; point; version = _; postpone = _; handler } -> handler ~token ~point ~doc diff --git a/controller/request.mli b/controller/request.mli index da4f5b41..d760381d 100644 --- a/controller/request.mli +++ b/controller/request.mli @@ -35,6 +35,10 @@ type position = (** Requests that require data access *) module Data : sig type t = + | Immediate of + { uri : Lang.LUri.File.t + ; handler : document + } | DocRequest of { uri : Lang.LUri.File.t ; postpone : bool diff --git a/fleche/theory.ml b/fleche/theory.ml index d4234974..9c4f710a 100644 --- a/fleche/theory.ml +++ b/fleche/theory.ml @@ -341,6 +341,7 @@ let close ~uri = module Request = struct type request = + | Immediate | FullDoc | PosInDoc of { point : int * int @@ -379,6 +380,7 @@ module Request = struct let default () = Cancel in (* should be Cancelled? *) match request with + | Immediate -> Handle.with_doc ~kind ~default ~uri ~f:(fun _ doc -> Now doc) | FullDoc -> Handle.with_doc ~kind ~default ~uri ~f:(fun _ doc -> match (Doc.Completion.is_completed doc.completed, postpone) with @@ -402,6 +404,7 @@ module Request = struct (** Removes the request from the list of things to wake up *) let remove { id; uri; postpone = _; request } = match request with + | Immediate -> () | FullDoc -> Handle.remove_cp_request ~uri ~id | PosInDoc { point; _ } -> Handle.remove_pt_request ~uri ~id ~point end diff --git a/fleche/theory.mli b/fleche/theory.mli index e20c2cf7..1703875f 100644 --- a/fleche/theory.mli +++ b/fleche/theory.mli @@ -49,6 +49,7 @@ val close : uri:Lang.LUri.File.t -> unit module Request : sig type request = + | Immediate | FullDoc | PosInDoc of { point : int * int From cabe3d496289c6a4b5277b4324549d3615db303b Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sun, 29 Sep 2024 20:37:28 +0200 Subject: [PATCH 35/38] [v8.20] Fixup after merge, due to Coq -> Stdlib --- controller-js/coq_lsp_worker.ml | 2 +- test/serlib/genarg/libTactics.v | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/controller-js/coq_lsp_worker.ml b/controller-js/coq_lsp_worker.ml index e9c703ca..57d82577 100644 --- a/controller-js/coq_lsp_worker.ml +++ b/controller-js/coq_lsp_worker.ml @@ -178,7 +178,7 @@ let main () = let stdlib coqlib = let unix_path = Filename.concat coqlib "theories" in - let coq_path = Names.(DirPath.make [ Id.of_string "Stdlib" ]) in + let coq_path = Names.(DirPath.make [ Id.of_string "Coq" ]) in Loadpath. { unix_path; coq_path; implicit = true; has_ml = false; recursive = true } in diff --git a/test/serlib/genarg/libTactics.v b/test/serlib/genarg/libTactics.v index 5f895f69..d909a7e8 100644 --- a/test/serlib/genarg/libTactics.v +++ b/test/serlib/genarg/libTactics.v @@ -44,7 +44,7 @@ Set Implicit Arguments. -Require Import Stdlib.Lists.List. +Require Import Coq.Lists.List. (* ********************************************************************** *) From 6aba90404e1e3a88c1206fb90ee386f3855b1cd0 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sun, 29 Sep 2024 20:59:29 +0200 Subject: [PATCH 36/38] [v8.19] fixup fmt after merge --- coq/workspace.ml | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/coq/workspace.ml b/coq/workspace.ml index 1e912f92..4aa7e7dd 100644 --- a/coq/workspace.ml +++ b/coq/workspace.ml @@ -32,13 +32,14 @@ module Flags = struct ; rewrite_rules = false } - let apply { impredicative_set; indices_matter; type_in_type; rewrite_rules = _ } = + let apply + { impredicative_set; indices_matter; type_in_type; rewrite_rules = _ } = Global.set_impredicative_set impredicative_set; Global.set_indices_matter indices_matter; Global.set_check_universes (not type_in_type); () - (* V8.20-only *) - (* Global.set_rewrite_rules_allowed rewrite_rules *) + (* V8.20-only *) + (* Global.set_rewrite_rules_allowed rewrite_rules *) end module Warning : sig From e8d1c8be6260e02d44515d27f31055f598703694 Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sun, 29 Sep 2024 21:13:35 +0200 Subject: [PATCH 37/38] [v8.20] Fixup for worker and opam build. --- .github/workflows/build.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/build.yml b/.github/workflows/build.yml index 86062a05..78374037 100644 --- a/.github/workflows/build.yml +++ b/.github/workflows/build.yml @@ -119,6 +119,7 @@ jobs: opam install zarith_stubs_js js_of_ocaml-ppx -y - name: 💉💉💉 Patch Coq + if: false # FIXME, Coq is in opam but needs to be patched for the worker to be functional run: make patch-for-js - name: 🦏🧱🦏 Build coq-lsp JS version 🦏🦏🦏 @@ -167,7 +168,6 @@ jobs: run: | opam install lwt logs # Also build pet-server opam install memprof-limits # We need to do this to avoid coq-lsp rebuilding Coq below due to deptops - opam install vendor/coq/{coq-core,coq-stdlib,coqide-server,coq}.opam - name: Install `coq-lsp` into OPAM switch run: opam install . From 719c726f02aae322e212c9cf48b31c95f3b59a5b Mon Sep 17 00:00:00 2001 From: Emilio Jesus Gallego Arias Date: Sun, 29 Sep 2024 21:17:03 +0200 Subject: [PATCH 38/38] [v8.18] Adapt Ltac2 example to API change. --- examples/ItHolds.v | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/examples/ItHolds.v b/examples/ItHolds.v index e9c32a78..b29953ba 100644 --- a/examples/ItHolds.v +++ b/examples/ItHolds.v @@ -19,7 +19,7 @@ Require Import Ltac2.Ltac2. Require Import Ltac2.Message. Local Ltac2 concat_list (ls : message list) : message := - List.fold_right concat ls (of_string ""). + List.fold_right concat (of_string "") ls. (** Tries to make the assertion [True] with label [label]. Throws an error if this fails, i.e. if the label is already used